文件上傳組件：upload.ASP
<%
Dim stream1,stream2,istart,IEnd,filename
istart=1
vbEnter=Chr(13)&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 & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & 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&Chr(AscW(ChrB(AscB(obJStream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&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>
&nbsp;&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 "文件名："&path&" 標題:"&name
' response.End
End if
%>
