程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 網頁編程 >> ASP編程 >> ASP技巧 >> asp無組件文件上傳

asp無組件文件上傳

編輯:ASP技巧
文件上傳組件:upload.ASP
<% 
  Dim stream1,stream2,istart,IEnd,filename
  istart=1
  vbEnter=Chr(13)&#38;Chr(10) 

function getvalue(fstr,foro,paths)'fstr為接收的名稱,foro布爾false為文件上傳,true 為普通字段,path為上傳文件存放路徑
   if foro then
    getvalue=""
    istart=instring(istart,fstr)

    istart=istart+len(fstr)+5
    IEnd=instring(istart,vbenter+"-----------------------------")
    if istart>5+len(fstr) then
    getvalue=substring(istart,IEnd-istart)
   
    else
    getvalue=""
    end if
    else
 
    istart=instring(istart,fstr)
    istart=istart+len(fstr)+13
    IEnd=instring(istart,vbenter)-1
    
    filename=substring(istart,IEnd-istart)
    filename=getfilename(filename)
 'CheckFileExt(fstr)'''''''''''''''''''''''''''''''''''''''''''''''''''''''
    istart=instring(IEnd,vbenter+vbenter)+3
    IEnd=instring(istart,vbenter+"-----------------------------")
    filestart=istart
    filesize=IEnd-istart-1
    obJStream.position=filestart
    Set sf = Server.CreateObject("ADODB.Stream")
    sf.Mode=3 
    sf.Type=1 
    sf.Open 
    obJStream.copyto sf,FileSize 
    
     if filename<>"" then
    Set rf = Server.CreateObject("Scripting.FileSystemObject")
    i=0
    fn=filename
    while rf.FileExists(server.mappath(paths+fn))

      fn=cstr(i)+filename
      i=i+1
      wend
    filename=fn
    sf.SaveToFile server.mappath(paths+filename),2
    end if
    getvalue=filename
    end if   
end function

Private function GetFileName(FullPath) 
  If FullPath <> "" Then 
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) 
  Else 
   GetFileName = "" 
  End If 
End  function 

Function inString(theStart,varStr) 
dim i,j,bt,theLen,str 
InString=0 
Str=toByte(varStr) 
theLen=LenB(Str) 
for i=theStart to obJStream.Size-theLen 
   if i>obJStream.size then exit Function 
   
   obJStream.Position=i-1 
   if AscB(obJStream.Read(1))=AscB(midB(Str,1)) then 
    InString=i 
    for j=2 to theLen 
      if obJStream.EOS then  
        inString=0 
        Exit for 
      end if 
      if AscB(obJStream.Read(1))<>AscB(MidB(Str,j,1)) then 
        InString=0 
        Exit For 
      end if 
    next 
    if InString<>0 then Exit Function 
   end if 
next 
End Function 


function toByte(Str) 
   dim i,iCode,c,iLow,iHigh 
   toByte="" 
   For i=1 To Len(Str) 
   c=mid(Str,i,1) 
   iCode =Asc(c) 
   If iCode<0 Then iCode = iCode + 65535 
   If iCode>255 Then 
     iLow = Left(Hex(Asc(c)),2) 
     iHigh =Right(Hex(Asc(c)),2) 
     toByte = toByte &#38; chrB("&#38;H"&#38;iLow) &#38; chrB("&#38;H"&#38;iHigh) 
   Else 
     toByte = toByte &#38; chrB(AscB(c)) 
   End If 
   Next 
End function 

Function subString(theStart,theLen) 
dim i,c,stemp 
obJStream.Position=theStart-1 
stemp="" 
for i=1 to theLen 
   if obJStream.EOS then Exit for 
   c=ascB(obJStream.Read(1)) 
   If c > 127 Then 
    if obJStream.EOS then Exit for 
    stemp=stemp&#38;Chr(AscW(ChrB(AscB(obJStream.Read(1)))&#38;ChrB(c))) 
    i=i+1 
   else 
    stemp=stemp&#38;Chr(c) 
   End If 
Next 
subString=stemp 
End function 
%>

1.Html
<Html>
 <HEAD>
  <TITLE> 圖片和文本一同上傳 </TITLE>
 </HEAD>
<style>
body {font-size:12px;}
</style>
 <BODY>
    <form action="uploadfile.ASP" method="post" enctype="multipart/form-data" name="form1">
 文件路徑<input type="file" name="filepath"><br>
 &#38;nbsp;&#38;nbsp;標題<input type="text" name="filename"><br>
 <input type="submit" value="提交">
 </form>
 </BODY>
</Html>


uploadfile.ASP
<!--#include file="upload.ASP"-->
<%
if Request.TotalBytes>0 then
set obJStream=server.CreateObject("adodb.stream")
obJStream.Mode=3
obJStream.Type=1
obJStream.Open
obJStream.Write Request.BinaryRead(Request.TotalBytes)

 path=getvalue("filepath",false,"pic/")     'pic為當前目錄下一個文件夾名,也可以改成../pic,即上層目錄中的pic文件夾
 name=getvalue("filename",true,"")
 response.write "文件名:"&#38;path&#38;"  標題:"&#38;name
' response.End

End if
%>
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved