文件上传组件：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> 标题<input type="text" name="filename"><br> <input type="submit" value="提交"> </form> </BODY></HTML> uploadfile.asp<!--#include file="upload.asp"--><%if Request.TotalBytes>0 thenset objstream=server.CreateObject("adodb.stream")objstream.Mode=3objstream.Type=1objstream.Openobjstream.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%> 转载请注出处。
评论