快捷上传文件的脚本与代码

本脚本与代码的功能为：选定几个文件后，通过右键中菜单中可以很方便的将文件上传到服务器。

1、将下面代码修改后（上传密码与默认上传路径）存为myup.asp，通过ftp等工具上传到服务器

<html><head><meta http-equiv="Content-Type" content="text/html; charset=gb2312"><title>Upload</title><style>*{font:12px}</style></head><body> <%if request("act")="upload" then%><%Server.ScriptTimeOut=5000%> <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> dim Data_5xsoft Class upload_5xsoft dim objForm,objFile,Version Public function Form(strForm) strForm=lcase(strForm) if not objForm.exists(strForm) then Form="" else Form=objForm(strForm) end if end function Public function File(strFile) strFile=lcase(strFile) if not objFile.exists(strFile) then set File=new FileInfo else set File=objFile(strFile) end if end function Private Sub Class_Initialize dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile dim iFileSize,sFilePath,sFileType,sFormValue,sFileName dim iFindStart,iFindEnd dim iFormStart,iFormEnd,sFormName set objForm=Server.CreateObject("Scripting.Dictionary") set objFile=Server.CreateObject("Scripting.Dictionary") if Request.TotalBytes<1 then Exit Sub set tStream = Server.CreateObject("adodb.stream") set Data_5xsoft = Server.CreateObject("adodb.stream") Data_5xsoft.Type = 1 Data_5xsoft.Mode =3 Data_5xsoft.Open Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes) Data_5xsoft.Position=0 RequestData =Data_5xsoft.Read iFormStart = 1 iFormEnd = LenB(RequestData) vbCrlf = chrB(13) & chrB(10) sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1) iStart = LenB (sStart) iFormStart=iFormStart+iStart+1 while (iFormStart + 10) < iFormEnd iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3 tStream.Type = 1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iFormStart Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sInfo = tStream.ReadText tStream.Close iFormStart = InStrB(iInfoEnd,RequestData,sStart) iFindStart = InStr(22,sInfo,"name=""",1)+6 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart)) if InStr (45,sInfo,"filename=""",1) > 0 then set theFile=new FileInfo iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileName=getFileName(sFileName) theFile.FilePath=getFilePath(sFileName) iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14 iFindEnd = InStr(iFindStart,sInfo,vbCr) theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart) theFile.FileStart =iInfoEnd theFile.FileSize = iFormStart -iInfoEnd -3 theFile.FormName=sFormName if not objFile.Exists(sFormName) then objFile.add sFormName,theFile end if else tStream.Type =1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iInfoEnd Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3 tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sFormValue = tStream.ReadText tStream.Close if objForm.Exists(sFormName) then objForm(sFormName)=objForm(sFormName)&", "&sFormValue else objForm.Add sFormName,sFormValue end if end if iFormStart=iFormStart+iStart+1 wend RequestData="" set tStream =nothing End Sub Private Sub Class_Terminate if Request.TotalBytes>0 then objForm.RemoveAll objFile.RemoveAll set objForm=nothing set objFile=nothing Data_5xsoft.Close set Data_5xsoft =nothing end if 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,InStrRev(FullPath, "\")+1) Else GetFileName = "" End If End function End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileType,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" FileType = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=true if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open Data_5xsoft.position=FileStart Data_5xsoft.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=false end function End Class </SCRIPT> <% 'http://www.51windows.Net '海娃＠2005-6-9 dim upload,file,formName,formPath,iCount,JscriptBack,uppass,rename JscriptBack = "<a href=""javascript:history.back();"">返回</a>" set upload=new upload_5xsoft formPath=upload.form("filepath") rename=upload.form("rename") uppass=upload.form("uppass") if uppass<>"4832" then response.write "上传密码错误"&JscriptBack set file=nothing set upload=nothing response.end end if '如果没有指定目录，则上传到本程序所在的文件夹 if formPath = "" then formPath = "./" if right(formPath,1)<>"/" then formPath=formPath&"/" iCount=0 for each formName in upload.objFile set file=upload.file(formName) if file.FileSize>0 then if file.FileSize>1024*1024*10 then'最大上传10M response.write "文件过大!"&JscriptBack set file=nothing set upload=nothing response.end end if if rename="1" then NewFileName=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&"_"&file.FileName else NewFileName=file.FileName end if file.SaveAs Server.mappath(formPath&NewFileName) response.write "<li>"&file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&NewFileName&" 上传成功!</li>" iCount=iCount+1 else response.write "<li>文件大小为空!" end if set file=nothing next set upload=nothing response.write JscriptBack else dim allfile,basepath basepath = Request("basepath") allfile = Request("file") filearr = split(allfile,"*") basepath = Replace(basepath,"\","\\") %> <SCRIPT LANGUAGE="JavaScript">  </SCRIPT> <form name="form1" action="?act=upload" method="post" enctype="multipart/form-data"> 密码：<input type="password" name="uppass" value="4832"><br> 路径：<input type="text" name="filepath" readonly value="/tt/"><br> <input type="checkbox" name="rename" value="1"> 重命名<br> <% for i = 0 to ubound(filearr) filepath = filearr(i) if len(filepath) > 3 then %> 本地文件：<input type="file" name="file<% = i %>" size="32" value="" style="ime-mode:disabled;"><br> <script>function go<% = i %>(){document.form1.file<% = i %>.focus();WshShell.sendKeys(basepath + "<% = Replace(filepath,"\","\\") %>");setTimeout("go<%=int(i)+1%>()",200);}</script> <%else%> <script>function go<% = i %>(){setTimeout("go<%=int(i)+1%>()",50);}</script> <%end if next%> <input type="button" style="display:;" onclick="st();" name="listfile" value="列出文件"> <input type="submit" name="Submit" value="上传"> </form> <SCRIPT LANGUAGE="JavaScript">  </SCRIPT> <%end if%> </body> </html>

2、将下面代码按说明用记事本等工作修改一下里面的代码，然后另存为一个上传文件.vbs

dim allfile,wwwurl,basepath allfile = "" '将下面地址改为自己的服务器上的路径，同时让上传的网址加入安全站点 wwwurl = "http://127.0.0.1/test/upload/myup.asp" Function HasCnStr(str) Set regEx=New RegExp regEx.Pattern="[\u4E00-\u9FA5]" regEx.IgnoreCase=true regEx.Global=True HasCnStr = regEx.test(str) End Function basepath = WScript.arguments(0) basepath = left(basepath,InStrRev(basepath,"\")) if HasCnStr(WScript.arguments(0)) then msgbox "中文路径或文件名暂时不支持" end if for i = 0 to WScript.arguments.count-1 if HasCnStr(WScript.arguments(i)) = false then if instr(WScript.arguments(i),basepath)=0 then basepath = left(WScript.arguments(i),InStrRev(WScript.arguments(i),"\")) end if allfile = allfile & "*" & WScript.arguments(i) end if next if len(allfile) < 5 then msgbox "重新选择文件" else Set objShell = CreateObject("Wscript.Shell") objShell.run("explorer """& wwwurl &"?basepath="& basepath &"&file="+replace(allfile,"*" & basepath,"*") & "") end if

3、在运行中输入sendto，将上传文件.vbs复制到里面

4、把上传地址的域名加入的安全站点中：

5、选定一个或多个文件，通过右键进行上传：

下载演示与代码