先上解释代码,后面跟上实用inc代码及调用方法
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> dim upfileStream Class upload '类名 dim Form,File Private Sub Class_Initialize '私有 的子程序 类在初始化的时候调用这个子程序 dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr if Request.TotalBytes<1 then Exit Sub '如无数据上传则退出 set Form=CreateObject("Scripting.Dictionary") '创建两个dictionary对象(类似二维数组) form file和upfilestream ADO对象 set File=CreateObject("Scripting.Dictionary") set upfileStream=CreateObject("Adodb.Stream") '创建流数据对象 upfileStream.mode=3 '对流可以读写权限 upfileStream.type=1 '流为二进制 upfileStream.open '打开流 upfileStream.write Request.BinaryRead(Request.TotalBytes) '向upfileStream中写入从上一页面POST过来的所有数据' vbEnter=Chr(13)&Chr(10) '回车换行分隔符' iDivLen=inString(1,vbEnter)+1 '1为起始位置,返回找到第一个回车换行分隔符的位置+1' strDiv=subString(1,iDivLen) '提取从位置1开始 长度为IDIVLEN长度的数据' iFormStart=iDivLen '表单内容开始的position' iFormEnd=inString(iformStart,strDiv)-1 '内容结束的位置为从第一个换行符结束位置开始找到下一个换行符内容的位置 -源头0位置 while iFormStart < iFormEnd '当有数据存在 iStart=inString(iFormStart,"name=""") '找到name=" 的开始位置 iEnd=inString(iStart+6,"""") '找到name 值之后的 " 的位置 mFormName=subString(iStart+6,iEnd-iStart-6) '提取中间name的值 iFileNameStart=inString(iEnd+1,"filename=""") '同上找到filename=" 的开始位置 if iFileNameStart>0 and iFileNameStart<iFormEnd then '如果找到filename= " iFileNameEnd=inString(iFileNameStart+10,"""") '找结束 " 位置" mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10) '提取filename的值 iStart=inString(iFileNameEnd+1,vbEnter&vbEnter) '+1 表示后面的空格 iEnd=inString(iStart+4,vbEnter&strDiv) '+4表示换行分隔符长度加上 找到下一个结束分隔符的位置 if iEnd>iStart then '如果有文件内容 mFileSize=iEnd-iStart-4 '得到文件大小 为结束position-开始position-换行符长度(因为文件按二进制保存所以长度等于文件大小) else mFileSize=0 '没有文件内容 文件大小为0 end if set theFile=new FileInfo '初始化新的类 theFile.FileName=getFileName(mFileName) '类里面的变量赋值 theFile.FilePath=getFilePath(mFileName) theFile.FileSize=mFileSize theFile.FileStart=iStart+4 theFile.FormName=FormName 'file1 dim inputStart,inputEnd,inputName,inputNameStart,inputNameEnd,inputvalue inputStart=inString(iEnd+iDivLen,"name=""") inputEnd=inString(inputStart+6,"""") theFile.inputName=subString(inputStart+6,inputEnd-inputStart-6) inputNameStart=inputEnd+1 inputNameEnd=inString(inputNameStart+1,vbEnter&strDiv) response.write inputNameStart&inputNameEnd theFile.inputvalue=subString(inputNameStart,inputNameEnd-inputNameStart) file.add mFormName,theFile '给file 这个dictionary增加key mFormName 值item 为theFile else iStart=inString(iEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFormValue=subString(iStart+4,iEnd-iStart-4) else mFormValue="" end if form.Add mFormName,mFormValue '给form 这个dictionary增加key mFormName 值item 为mFormValue空值 end if iFormStart=iformEnd+iDivLen iFormEnd=inString(iformStart,strDiv)-1 wend End Sub Private Function subString(theStart,theLen) '提取从参1位置开始 长度theLen长度的数据 dim i,c,stemp upfileStream.Position=theStart-1 stemp="" for i=1 to theLen if upfileStream.EOS then Exit for c=ascB(upfileStream.Read(1)) If c > 127 Then if upfileStream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(upfileStream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Private Function inString(theStart,varStr) '两个参数 开始position 和直到查询到varStr字符串,返回从参数1到查询到的位置的长度 dim i,j,bt,theLen,str InString=0 '初始化 Str=toByte(varStr) '将varStr转化为二进制格式数据 theLen=LenB(Str) '获取varStr的字节数 for i=theStart to upfileStream.Size-theLen '从参1开始,到 stream流的总大小减去 参2的长度 if i>upfileStream.size then exit Function '如果流为空之类的小于参1 则退出FUN upfileStream.Position=i-1 '因为流的位置从0开始算,所以要从开始位置-1 if AscB(upfileStream.Read(1))=AscB(midB(Str,1)) then 判断如果流中位置1的字元和str中位置1的字元相同, InString=i '则返回值为开始位置参数1加上相同时的位置 for j=2 to theLen if upfileStream.EOS then '判断是否为流结束 inString=0 Exit for end if if AscB(upfileStream.Read(1))<>AscB(MidB(Str,j,1)) then '如果不相同则返回0 InString=0 Exit For end if next if InString<>0 then Exit Function '找到了就退出,不会继续往下找 end if next End Function Private Sub Class_Terminate '当CLASS类被关闭时调用这个子程序 关闭并清空 form.RemoveAll file.RemoveAll set form=nothing set file=nothing upfileStream.close set upfileStream=nothing End Sub Private function GetFilePath(FullPath) '获取上传文件的路径 If FullPath <> "" Then GetFilePath = left(FullPath,InStrRev(FullPath, "")) 'InStrRev 从后往前遍历找到 离最后的位置,也就是数量a ,获取从左往右a个数据 Else GetFilePath = "" End If End function Private function GetFileName(FullPath) If FullPath <> "" Then GetFileName = mid(FullPath,InStrRev(FullPath, "")+1) '先获取 之后的数据 Else GetFileName = "" End If End function Private 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 End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileStart Private Sub Class_Initialize FileName = "" '初始化变量 FilePath = "" FileSize = 0 FileStart= 0 FormName = "" End Sub Public function SaveAs(FullPath) FullPath=upfileStream.inputvalue dim dr,ErrorChar,i SaveAs=1 if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function if FileStart=0 or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open upfileStream.position=FileStart-1 upfileStream.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=0 end function End Class </SCRIPT>
以上代码只为解释可能有错,实用代码如下:
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> dim upfileStream Class upload dim Form,File,inputval Private Sub Class_Initialize dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr if Request.TotalBytes<1 then Exit Sub set Form=CreateObject("Scripting.Dictionary") set File=CreateObject("Scripting.Dictionary") set upfileStream=CreateObject("Adodb.Stream") upfileStream.mode=3 upfileStream.type=1 upfileStream.open upfileStream.write Request.BinaryRead(Request.TotalBytes) vbEnter=Chr(13)&Chr(10) iDivLen=inString(1,vbEnter)+1 strDiv=subString(1,iDivLen) iFormStart=iDivLen iFormEnd=inString(iformStart,strDiv)-1 while iFormStart < iFormEnd iStart=inString(iFormStart,"name=""") iEnd=inString(iStart+6,"""") mFormName=subString(iStart+6,iEnd-iStart-6) iFileNameStart=inString(iEnd+1,"filename=""") if iFileNameStart>0 and iFileNameStart<iFormEnd then iFileNameEnd=inString(iFileNameStart+10,"""") mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10) iStart=inString(iFileNameEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFileSize=iEnd-iStart-4 else mFileSize=0 end if inputStart=inString(iEnd+iDivLen,"name=""") inputEnd=inString(inputStart+6,"""") inputName=subString(inputStart+6,inputEnd-inputStart-6) inputNameStart=inputEnd+1 inputNameEnd=inString(inputNameStart+1,vbEnter&strDiv) inputvalue=subString(inputNameStart+4,inputNameEnd-inputNameStart-4) inputval=inputvalue set theFile=new FileInfo theFile.FileName=getFileName(mFileName) theFile.FilePath=getFilePath(mFileName) theFile.FileSize=mFileSize theFile.FileStart=iStart+4 theFile.FormName=FormName file.add mFormName,theFile else iStart=inString(iEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFormValue=subString(iStart+4,iEnd-iStart-4) else mFormValue="" end if form.Add mFormName,mFormValue end if iFormStart=iformEnd+iDivLen iFormEnd=inString(iformStart,strDiv)-1 wend End Sub Private Function subString(theStart,theLen) dim i,c,stemp upfileStream.Position=theStart-1 stemp="" for i=1 to theLen if upfileStream.EOS then Exit for c=ascB(upfileStream.Read(1)) If c > 127 Then if upfileStream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(upfileStream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Private Function inString(theStart,varStr) dim i,j,bt,theLen,str InString=0 Str=toByte(varStr) theLen=LenB(Str) for i=theStart to upfileStream.Size-theLen if i>upfileStream.size then exit Function upfileStream.Position=i-1 if AscB(upfileStream.Read(1))=AscB(midB(Str,1)) then InString=i for j=2 to theLen if upfileStream.EOS then inString=0 Exit for end if if AscB(upfileStream.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 Private Sub Class_Terminate form.RemoveAll file.RemoveAll set form=nothing set file=nothing upfileStream.close set upfileStream=nothing End Sub Private function GetFilePath(FullPath) If FullPath <> "" Then GetFilePath = left(FullPath,InStrRev(FullPath, "")) Else GetFilePath = "" End If End function Private function GetFileName(FullPath) If FullPath <> "" Then GetFileName = mid(FullPath,InStr(FullPath, "")+1) Else GetFileName = "" End If End function Private 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 End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=1 if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function if FileStart=0 or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open upfileStream.position=FileStart-1 upfileStream.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=0 end function End Class </SCRIPT>
以下为调用页面:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Session.CodePage=65001
Response.CodePage=65001
Response.Charset = "UTF-8"%>
<!-- #include file="upload.inc" -->
<%
set nowupload=new upload
set file=nowupload.file("file1")
if file.fileSize>0 and file.filesize<1000000 then
''获取inPut里面的文件名
filename=nowupload.inputval
filenameend=file.filename
filenameend=split(filenameend,".")
if filenameend(1)="gif" or filenameend(1)="jpg" then
filename1=split(filename,".")(0)&"."&filenameend(1)
file.saveAs Server.mappath(filename1)
''''''somecodes''''''
%>
实现方法:
1在需要上传图片的地方插入一个iframe
<iframe id="addgoodsframe" frameborder="0" scrolling="auto" style="float:left; border:0px dotted #f00; 196px; height:296px; position:absolute; padding:0px;" src="uploadpic_frame.asp?filename=abc">
</iframe>
2在uploadpic_frame.asp里面插入form 如:
<form id="addgoodspicform" class="addgoodspicform" name="addgoodspicform" enctype='multipart/form-data' method="post"
action="uploadmodpic.asp"> <input type=file name="file1" class="upload_file1" size="4" onchange="document.getElementById('upfile_text').value=this.value" />
<input type="hidden" value="" id="uploadpicsrc" />
<input type="text" class="ipt_text" id="upfile_text" disabled="disabled" />
<input name="filename" value="<%=Request.QueryString("filename")%>" type="hidden"/>
<button style="margin-top:0px; margin-left:5px;">选择图片</button><input type=submit name="submit" value="修 改" class="submit"></form>
3在uploadmodpic.asp页面应用inc
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <%Session.CodePage=65001 Response.CodePage=65001 Response.Charset = "UTF-8"%> <!-- #include file="upload.inc" --> <% set nowupload=new upload set file=nowupload.file("file1") if file.fileSize>0 and file.filesize<1000000 then ''获得input里面的文件名 filename=nowupload.inputval filenameend=file.filename filenameend=split(filenameend,".") if filenameend(1)="gif" or filenameend(1)="jpg" then filename1=split(filename,".")(0)&"."&filenameend(1) file.saveAs Server.mappath(filename1) ''''''somecodes连接数据库等'''''' %>