无组件多个文件上传客户端脚本

无组件上传最大的麻烦就是一个个的选择文件，如果一次上传几十个文件，会把手都累疼了。海娃写了一个VBS脚本，从一定程度上帮助大家解决了这个问题。当然，还是没有FTP方便。：）

操作方法：将代码分别保存下来，放在服务器端和本地，按照操作演示操作。(演示制作软件：DemoForge)

环境：win2000+sp4 ie6.0下测试通过

现存问题：文件夹的路径不能有中文，文件名为中文的也不能上传。

请注意：服务器端路径请设置复杂一些或设置登陆限制，防止受到攻击。

任何问题请在网站留言，谢谢。

服务器端代码：upfiles.asp 下载代码

<%@ LANGUAGE="VBSCRIPT" codepage ="936" %> <html> <title>上传文件</title> <style> *{font-family: Tahoma; font-size: 8pt;text-decoration: none;color:#000000;} </style> <% if request("up")=1 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> <% dim upload,file,formName,formPath,iCount set upload=new upload_5xsoft if upload.form("filepath")="" then response.write "请输入要上传至的目录!" set upload=nothing response.end else formPath=upload.form("filepath") if mid(formPath,2,1)=":" then formPath = replace(formPath & "\","\\","\") else if right(formPath,1)<>"/" then formPath=formPath & "/" end if end if iCount=0 for each formName in upload.objForm next response.write "<br>" for each formName in upload.objFile set file=upload.file(formName) if file.FileSize>0 then if mid(formPath,2,1)=":" then'绝对路径 file.SaveAs formPath&file.FileName else file.SaveAs Server.mappath(formPath&file.FileName) end if response.write "<li>"&file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 上传成功!</li>" iCount=iCount+1 end if set file=nothing next set upload=nothing response.write "<center><B>"&iCount&"</B>个文件上传结束!</center>" response.write "<center><br><a href=""javascript:history.back();""><font color='#D00000'>返回上一页</font></a></center>" end if %>

客户端代码：filelist.vbs

'///////////////////////////////////////////////
'一次上传上传多个文件
'海娃
'http://www.51windows.Net
'///////////////////////////////////////////////
on error resume next
Set ArgObj = WScript.Arguments
Set fsoBrowse = CreateObject("Scripting.FileSystemObject")
cpath=ArgObj(0)'传递路径
dim allfilename
allfilename=""
dim filesize
filesize = 0
if fsoBrowse.FolderExists(cpath)then
	Set theFolder=fsoBrowse.GetFolder(cpath)
	Set theFiles=theFolder.Files
	For Each x In theFiles
		if x.Size < 1024*100 then'这里是条件，现在条件为小于100K之内的
			filesize = filesize + x.Size
			allfilename = allfilename & formatsendkey(x.name) & "|"
		end if
	next
end if
set fsoBrowse = nothing

cpath = replace(cpath,"\","\\")&"\\"
allfilename = left(allfilename,len(allfilename)-1)

function formatsendkey(str)
	str1 = str
	str1 = replace(str1,"%","{%}")
	str1 = replace(str1,"~","{~}")
	str1 = replace(str1,"^","{^}")
	str1 = replace(str1,"+","{+}")
	formatsendkey = str1
end function
cpath = formatsendkey(cpath)

dim htmlstr

htmlstr ="<html>" & vbNewLine
htmlstr = htmlstr & "<head>" & vbNewLine
htmlstr = htmlstr & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbNewLine
htmlstr = htmlstr & "<meta name=""Keywords"" content=""51windows.Net"">" & vbNewLine
htmlstr = htmlstr & "<meta name=""Author"" content=""haiwa"">" & vbNewLine
htmlstr = htmlstr & "<title>Upload many file</title>" & vbNewLine
htmlstr = htmlstr & "<style>*{font:menu}</style>" & vbNewLine
htmlstr = htmlstr & "</head>" & vbNewLine
htmlstr = htmlstr & "<body>" & vbNewLine
htmlstr = htmlstr & "<form name=""form1"" method=""post"" action=""http://127.0.0.1/upfiles.asp?up=1"" enctype=""multipart/form-data"">" & vbNewLine
htmlstr = htmlstr & "<input type=""hidden"" name=""act"" value=""upload"">" & vbNewLine
htmlstr = htmlstr & "<div id=MyZone></div>" & vbNewLine
htmlstr = htmlstr & "<script language=""JavaScript"">" & vbNewLine
htmlstr = htmlstr & "function del(){document.all.thetable.deleteRow(window.event.srcElement.parentElement.rowIndex);}" & vbNewLine
htmlstr = htmlstr & "var allfilefolder = """&cpath&"""" & vbNewLine
htmlstr = htmlstr & "var allfilename = """&allfilename&"""" & vbNewLine
htmlstr = htmlstr & "filearr = allfilename.split(""|"")" & vbNewLine
htmlstr = htmlstr & "var start = 1" & vbNewLine
htmlstr = htmlstr & "var end  = filearr.length+1" & vbNewLine
htmlstr = htmlstr & "	document.all.MyZone.innerHTML+=""<table id='thetable' border=0 cellpadding=0 cellspacing=0 width=100%><tr><td width='100%'>""" & vbNewLine
htmlstr = htmlstr & "for (i=start;i<end;i++)" & vbNewLine
htmlstr = htmlstr & "{" & vbNewLine
htmlstr = htmlstr & "	k = i;" & vbNewLine
htmlstr = htmlstr & "	if(i<100){k='0'+i;}" & vbNewLine
htmlstr = htmlstr & "	if(i<10){k='00'+i;}" & vbNewLine
htmlstr = htmlstr & "	document.all.MyZone.innerHTML+=""(""+k+"").<input type='file' size='80' name='file""+i+""'><br>""" & vbNewLine
htmlstr = htmlstr & "}" & vbNewLine
htmlstr = htmlstr & "	document.all.MyZone.innerHTML+=""</td></tr></table>""" & vbNewLine
htmlstr = htmlstr & "function setfile(j)" & vbNewLine
htmlstr = htmlstr & "{" & vbNewLine
htmlstr = htmlstr & "	eval(""document.all.file""+j).focus();" & vbNewLine
htmlstr = htmlstr & "	var WshShell=new ActiveXObject(""WScript.Shell"")" & vbNewLine
htmlstr = htmlstr & "	WshShell.sendKeys(allfilefolder+filearr[j-1])" & vbNewLine
htmlstr = htmlstr & "	//WshShell.sendKeys((allfilefolder+filearr[j-1]).replace(/%/,""\{%\}"").replace(/\~/,""\{\~\}"").replace(/\^/,""\{\^\}"").replace(/\+/,""\{\+\}""))" & vbNewLine
htmlstr = htmlstr & "	start++" & vbNewLine
htmlstr = htmlstr & "	if (start==end){clearInterval(s)}" & vbNewLine
htmlstr = htmlstr & "}" & vbNewLine
htmlstr = htmlstr & "</script>" & vbNewLine
htmlstr = htmlstr & "<script language=""JavaScript"" defer>" & vbNewLine
htmlstr = htmlstr & "var s = setInterval(""setfile(start)"",50)" & vbNewLine
htmlstr = htmlstr & "</script>" & vbNewLine
htmlstr = htmlstr & "上传到:<input name=""filepath"" type=""text"" value=""/xxx/"" size=""40"">" & vbNewLine
htmlstr = htmlstr & "<input type=""submit"" name=""Submit"" value=""上传文件""></form></body>" & vbNewLine
htmlstr = htmlstr & "</html>"& vbNewLine

Set fso = CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile("c:\filelist.htm")
fout.WriteLine htmlstr
fout.close
set fso = nothing
if err=0 then
	msgbox "已生成，所有文件共" & formatnumber(filesize/1024/1024,3) & "M"
else
	msgbox "出错了:" & err.description
end if