<title>WEB文件管理器2.0版 http://asp2004.net<;/title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <style type="text/css"> <!-- a { font-size: 9pt; color: #3300CC; text-decoration: none; } body { font-size: 9pt; margin-left: 0px; margin-top: 0px; margin-right: 0px; margin-bottom: 0px; line-height: 20px; background-color: #EEEEEE; } td { font-size: 9pt; line-height: 20px; } .tx { border-color:#000000; border-left-width: 0px; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; font-size: 9pt; background-color: #EEEEEE; } .tx1 { font-size: 9pt; border: 1px solid; border-color:#000000; color: #000000; } --> </style> <% ’版权声明：本代码仅供学习研究之用，本人不对因使用本程序而造成的任何后果负责。未经作者书面许可不得用于商业用途。 ’QQ：103895 ’email:quxiaohui_0@163.com ’http://asp2004.net Server.scriptTimeout = 999 action = Request("action") temp = Split(Request.ServerVariables("URL"), "/") url = temp(UBound(temp)) Const pass = "asp2004.net"’登陆密码 ’登陆验证 Call ChkLogin() Set fso = CreateObject("scripting.FileSystemObject") Select Case action Case "新建文件" Call fileform(Request("path")&"/") Case "savefile" Call savefile(Request("filename"), Request("content"), Request("filename1")) Case "新建文件夹" Call newfolder(Request("path")&"/") Case "savefolder" Call savefolder(Request("foldername")) Case "编辑" Call edit(Request("f")) Case "重命名" Call renameform(Request("f")) Case "saverename" Call rename(Request("oldname"), Request("newname")) Case "剪切" session("f") = request("f") session("action") = action Response.Redirect(url&"?foldername="&Request("path")) Case "复制" session("f") = request("f") session("action") = action Response.Redirect(url&"?foldername="&Request("path")) Case "粘贴" Call affix(Request("path")&"/") Case "删除" Call Delete( request("f"), Request("path") ) Case "uploadform" Call uploadform(Request("filepath"), Request("path")) Case "saveupload" Call saveupload() Case "下载" Call download(request("f")) Case "打包" Dim Str, s, s1, s2, rep Call Dabao( Request("f"), Request("path") ) Case "解包" Call Jiebao(Request("f"), Request("path")) Case "退出" Call logout() Case Else Path = Request("foldername") If Path = "" Then Path = server.MapPath("./") ShowFolderList(Path) End Select Set fso = Nothing ’列出文件和文件夹 Function ShowFolderList(folderspec) temp = Request.ServerVariables("HTTP_REFERER") temp = Left(temp, Instrrev(temp, "/")) temp1 = Len(folderspec) - Len(server.MapPath("./")) -1 If temp1>0 Then temp1 = Right(folderspec, CInt(temp1)) + "/" ElseIf temp1 = -1 Then temp1 = "" End If tempurl = temp + Replace(temp1, "/", "/") uppath = "./" + Replace(temp1, "/", "/") upfolderspec = fso.GetParentFolderName(folderspec&"/") Set f = fso.GetFolder(folderspec) %> <form name="form1" method=post action=""> <input type="hidden" name="path" class="tx1" value="<%= folderspec%>"> <input type="submit" name="action" class="tx1" value="新建文件夹"> <input type="submit" name="action" class="tx1" value="新建文件"> <input type="button" value="向上" class="tx1" /","//")%>’"> <input type="button" value="返回" class="tx1" > <input type="submit" name="action" class="tx1" value="重命名"> <input type="submit" name="action" class="tx1" value="编辑"> <input type="submit" name="action" class="tx1" value="剪切"> <input type="submit" name="action" class="tx1" value="复制"> <input type="submit" name="action" class="tx1" value="粘贴" <%if session("f")="" or isnull(session("f")) then response.write(" disabled") %>> <input type="submit" name="action" class="tx1" value="删除" > <input type="button" name="action" class="tx1" value="上传" /","//")%>’,’new_page’,’width=600,height=260,left=100,top=100,scrollbars=auto’);return false;"> <input type="submit" name="action" class="tx1" value="下载"> <input type="submit" name="action" class="tx1" value="打包" > <input type="submit" name="action" class="tx1" value="解包" > <input type="submit" name="action" class="tx1" value="退出" > <br>当前目录:<%=f.path%>当前时间:<%=now%> <table width="100%" height="24" border="1" cellpadding="0" cellspacing="0" bordercolor="#FFFFFF" bordercolorlight="#FFFFFF" bordercolordark="#000000"> <tr bgcolor="#CCCCCC"> <td width="4%" align="center">操作<input type="checkbox" name="chkall" ></td> <td width="42%" align="center">名称</td> <td width="11%" align="right">大小<%= formatnumber(f.size/1024,2)%>K</td> <td width="20%" align="center">类型</td> <td width="13%">修改时间</td> <td width="10%">属性</td> </tr> <% ’列出目录 Set fc = f.SubFolders For Each f1 in fc %> <tr bgcolor="#EEEEEE" onmouseover=this.bgColor=’#F3F6FA’; onmouseout=this.bgColor=’#EEEEEE’;> <td><center><input type="checkbox" name="f" value="<%= folderspec&"/"&f1.name%>"></center></td> <td><a href="<%= url%>?foldername=<%= folderspec%>/<%= f1.name%>"><%= f1.name%></a></td> <td align="right"><%= f1.size%></td> <td><%= f1.type%></td> <td><%= f1.datelastmodified%></td> <td><%= f1.Attributes%></td> </tr> <% Next ’列出文件 Set fc = f.Files For Each f1 in fc %> <tr bgcolor="#EFEFEF" onmouseover=this.bgColor=’#F3F6FA’; onmouseout=this.bgColor=’#EEEEEE’;> <td><center><input type="checkbox" name="f" value="<%= folderspec&"/"&f1.name%>"></center></td> <td><a href="<%= tempurl+f1.name%>" target="_blank"><%= f1.name%></a></td> <td align="right"><%= f1.size%></td> <td><%= f1.type%></td> <td><%= f1.datelastmodified%></td> <td><%= f1.Attributes%></td> </tr> <% Next %> </table> </form> <% End Function ’保存文件 Function savefile(filename, content, filename1) If Request.ServerVariables("PATH_TRANSLATED")<>filename Then Set f1 = fso.OpenTextFile(filename, 2, true) f1.Write(content) f1.Close End If Response.Redirect(url&"?foldername="&fso.GetParentFolderName(filename)) End Function ’文件表单 Function fileform(filename) If fso.FileExists(filename) Then Set f1 = fso.OpenTextFile(filename, 1, true) content = server.HTMLEncode(f1.ReadAll) f1.Close End If %> <form name="form1" method="post" action="<%= url%>?action=savefile"> <center><input name="filename" type="text" class="tx" style="width:100%" value="<%= filename%>"><textarea name="content" wrap="VIRTUAL" class="tx" style="width:100%;height:100%;font:Arial,Helvetica,sans-serif;" onKeyUp="style.height=this.scrollHeight;"><%= content%></textarea><input type="submit" class="tx1" value="保存"><input type="reset" class="tx1" value="重置"></center> </form> <% End Function ’保存文件夹 Function savefolder(foldername) Set f = fso.CreateFolder(foldername) Response.Redirect(url&"?foldername="&f) End Function ’新文件夹 Function newfolder(foldername) folderform foldername End Function ’文件夹表单 Function folderform(foldername) %> <form method="post" action="<%= url%>?action=savefolder"> <center><input name="foldername" type="text" size="100" value="<%= foldername%>"><input type="submit" class="tx1" value="保存"><input type="reset" class="tx1" value="重置"></center> </form> <% End Function ’重命名表单 Function renameform(oldname) %> <form method=post action=""> <center>输入新的名字：<input type="hidden" name="oldname" value=’<%= oldname%>’><input type="hidden" name="action" value="saverename"><input type="text" name="newname" value=’<%= oldname%>’ size="100"><input type="submit" class="tx1" value="提交修改"></center> </form> <% End Function ’重命名 Function Rename(oldstr, newstr) oldname = Split(oldstr, ",") newname = Split(newstr, ",") For i = 0 To UBound(oldname) If fso.FileExists(Trim(oldname(i))) Then fso.MoveFile Trim(oldname(i)), Trim(newname(i)) If fso.FolderExists(Trim(oldname(i))) Then fso.MoveFolder Trim(oldname(i)), Trim(newname(i)) Next Response.Redirect(url&"?foldername="&fso.GetParentFolderName( oldname(0) )) End Function ’粘贴 Function affix(Path) oldname = Split(session("f"), ",") If session("action") = "剪切" Then For i = 0 To UBound(oldname) If fso.FileExists(Trim(oldname(i))) Then fso.MoveFile Trim(oldname(i)), Path&fso.GetFileName(Trim(oldname(i))) If fso.FolderExists(Trim(oldname(i))) Then fso.MoveFolder Trim(oldname(i)), Trim(Path) Next ElseIf session("action") = "复制" Then For i = 0 To UBound(oldname) If fso.FileExists(Trim(oldname(i))) Then fso.CopyFile Trim(oldname(i)), Path&fso.GetFileName(Trim(oldname(i))) If fso.FolderExists(Trim(oldname(i))) Then fso.CopyFolder Trim(oldname(i)), Trim(Path) Next End If session("f") = "" Response.Redirect(url&"?foldername="&Path) End Function ’编辑 Function edit(f) If fso.FileExists(f) Then Call fileform(f) If fso.FolderExists(f) Then Call folderform( f ) End Function ’删除 Function Delete( Str, Path ) For Each f In Str If fso.FileExists(f) Then fso.DeleteFile(f) If fso.FolderExists(f) Then fso.DeleteFolder(f) Next Response.Redirect(url&"?foldername="&Path) End Function ’打包 Function Dabao( Str, Path ) For Each f In Str If fso.FolderExists(f) Then Call pack(f, Path&"/") Next Response.Redirect(url&"?foldername="&Path) End Function ’解包 Function Jiebao( Str, Path ) For Each f In Str If fso.FileExists(f) And InStrRev(f, ".asp2004")>0 And Len(f) - InStrRev(f, ".asp2004") = 7 Then Install(f) Next Response.Redirect(url&"?foldername="&Path) End Function ’上传表单 Function uploadform(filepath, Path) %> <div id="waitting" style="position:absolute; top:100px; left:240px; z-index:10; visibility:hidden"> <table border="0" cellspacing="1" cellpadding="0" bgcolor="0959AF"> <tr><td bgcolor="#FFFFFF" align="center"> <table width="160" border="0" height="50"> <tr><td valign="top"><div align="center">操 作 执 行 中<br>请稍候... </div></td></tr> </table> </td></tr> </table> </div> <div id="upload" style="visibility:visible"> <form name="form1" method="post" action="<%= url%>?action=saveupload" enctype="multipart/form-data" > <table width="100%" height="24" border="1" cellpadding="0" cellspacing="0" bordercolor="#FFFFFF" bordercolorlight="#FFFFFF" bordercolordark="#000000"> <tr bgcolor="#CCCCCC"><td bgcolor="#CCCCCC">文件上传 <input type="hidden" name="act" value="upload"></td> </tr> <tr align="left" bgcolor="#EEEEEE"><td> <li>需要上传的个数：<input name="upcount" class="tx" value="1"><input type="button" class="tx1" value="设定"> <li>上传到：<input name="filepath" class="tx" value="<%= filepath%>" size="60"><input name="path" class="tx" size="60" value="<%= path%>" style="display=’none’">使用绝对路径<input name="ispath" type="checkbox" value="true" > <li>防止覆盖自动重命名<input name="checkbox" type="checkbox" value="true" checked> <li>密码：<input name="uppass" type="password" class="tx"> </td></tr> <tr><td align="left" id="upid"></td></tr> <tr bgcolor="#EEEEEE"><td align="center" bgcolor="#EEEEEE"> <input type="submit" class="tx1" value="提交"> <input type="reset" class="tx1" value="重置"> <input type="button" class="tx1" value="取消"> </td></tr> </table> </form></div> <script language="javascript"> function exec() { waitting.style.visibility="visible"; upload.style.visibility="hidden"; } function setid() { if(window.form1.upcount.value>0) { str=’’; for(i=1;i<=window.form1.upcount.value;i++) str+=’文件’+i+’:<input type="file" name="file’+i+’" style="width:400" class="tx1"><br>’; window.upid.innerHTML=str+’’; } } setid(); </script> <% End Function ’保存上传 Function saveupload() Const filetype = ".bmp.gif.jpg.png.rar.zip.txt."’允许上传的文件类型。以.分隔 Const MaxSize = 5000000’允许的文件大小 Dim upload, File, formName, formPath Set upload = New upload_5xsoft If upload.Form("filepath")<>"" Then If upload.Form("ispath") = "true" Then formPath = upload.Form("path") Else formPath = Server.mappath(upload.Form("filepath")) End If If Right(formPath, 1)<>"/" Then formPath = formPath&"/" If fso.FolderExists(formPath)<>true Then fso.CreateFolder(formPath) End If For Each formName in upload.objFile Set File = upload.File(formName) temp = Split(File.FileName, ".") fileExt = temp(UBound(temp)) If InStr(1, filetype, LCase(fileExt))>0 Or upload.Form("uppass") = pass Then If upload.Form("checkbox") = "true" Then Randomize ranNum = Int(90000 * Rnd) + 10000 filename = Year(Now)&Right("0"&Month(Now),2)&Right("0"&Day(Now),2)&Right("0"&Hour(Now),2)&Right("0"&Minute(Now),2)&Right("0"&Second(Now),2)&ranNum&"."&fileExt Else temp = Split(File.FileName, "/") filename = temp(Ubound(temp)) End If If File.FileSize>0 And (File.FileSize<MaxSize Or upload.Form("uppass") = pass) Then File.SaveAs formPath&filename End If Set File = Nothing End If Next End If Response.Write("<script language=’javascript’>window.opener.location.reload();self.close();</script>") Set upload = Nothing End Function ’下载文件 Function download(File) temp = Split(File, "/") filename = temp(UBound(temp)) Set s = CreateObject("adodb.stream") s.mode = 3 s.Type = 1 s.Open s.loadfromfile(File) data = s.Read If IsNull(data) Then response.Write "空" Else response.Clear Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition", "attachment; filename=" & filename response.binarywrite(data) End If Set s = Nothing End Function ’打包 Function pack(Folder, Path) Randomize ranNum = Int(90000 * Rnd) + 10000 Set f1 = fso.GetFolder(Folder) filename = Year(Now)&Month(Now)&Day(Now)&Hour(Now)&Minute(Now)&Second(Now)&ranNum&"_"&f1.Size Set s = server.CreateObject("ADODB.Stream") Set s1 = server.CreateObject("ADODB.Stream") Set s2 = server.CreateObject("ADODB.Stream") s.Open s1.Open s2.Open s.Type = 1 s1.Type = 1 s2.Type = 2 rep = fso.GetParentFolderName(Folder&"/")’当前目录 Str = "folder>0>"&Replace(Folder, rep, "")&vbCrLf’连目录一起打包 Call WriteFile(Folder) s2.charset = "gb2312" s2.WriteText(Str) s2.Position = 0 s2.Type = 1 s2.Position = 0 bin = s2.Read s1.Write(bin) s1.SetEOS s1.SaveToFile(Path&filename&".asp2004") s.Close s1.Close s2.Close Set s = Nothing Set s1 = Nothing Set s2 = Nothing End Function Function WriteFile(folderspec) Set f = fso.GetFolder(folderspec) Set fc = f.Files For Each f1 in fc If f1.Name<>"pack.asp" Then Str = Str&"file>"&f1.Size&">"&Replace(folderspec&"/"&f1.Name, rep, "")&vbCrLf s.LoadFromFile(folderspec&"/"&f1.Name) img = s.Read() If Not IsNull(img) Then s1.Write(img) End If Next Set fc = f.SubFolders For Each f1 in fc Str = Str&"folder>0>"&Replace(folderspec&"/"&f1.Name, rep, "")&vbCrLf WriteFile(folderspec&"/"&f1.Name) Next End Function ’解包 Function install(filename) tofolder = fso.GetParentFolderName(filename) t1 = Split(filename, "/")’得到文件全名 t2 = Split(t1(UBound(t1)), ".")’得到文件名 t3 = Split(t2(0), "_")’得到数据大小 Size = CStr(t3(1)) Set s = server.CreateObject("adodb.stream") Set s1 = server.CreateObject("adodb.stream") Set s2 = server.CreateObject("adodb.stream") s.Open s1.Open s2.Open s.Type = 1 s1.Type = 1 s2.Type = 1 s.loadfromfile(filename) s.position = Size s1.Write(s.Read) s1.position = 0 s1.Type = 2 s1.charset = "gb2312" s1.position = 0 a = Split(s1.readtext, vbCrLf) s.position = 0 i = 0 While(i<UBound(a)) b = Split(a(i), ">") If b(0) = "folder" Then If Not fso.FolderExists(tofolder&b(2)) Then fso.CreateFolder(tofolder&b(2)) ’folder=split(tofolder&b(2),"/")’自动建立分层目录 ’for j=0 to ubound(folder) ’newfolder=newfolder&folder(j)&"/" ’if not fso.folderexists(newfolder) then ’fso.createfolder(newfolder) ’end if ’next End If ElseIf b(0) = "file" Then If fso.FileExists(tofolder&b(2)) Then fso.DeleteFile(tofolder&b(2)) End If s2.position = 0 data = s.Read(b(1)) If Not IsNull(data) then s2.Write(data) s2.seteos s2.savetofile(tofolder&b(2)) End If i = i + 1 Wend s.Close s1.Close s2.Close Set s = Nothing Set s1 = Nothing Set s2 = Nothing Response.Write("<script language=’javascript’>window.opener.location.reload();self.close();</script>") End Function ’检查登陆 Function ChkLogin() If Session("login") = "true" Then Exit Function ElseIf Request("action") = "chklogin" Then Server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) Server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) If Server_v1<>"" And Mid(Server_v1,8,Len(Server_v2)) = Server_v2 Then If Request("password") = pass Then Session("login") = "true" Response.Redirect(url) Else Response.Write("<script>alert(’登陆失败’);</script>") End If End If End If Call LoginForm() End Function ’登陆表单 Function LoginForm() %> <body > <br><br><br><br><br> <form name="form1" method="post" action="<%= url%>?action=chklogin"> <center>请输入密码：<input name="password" type="password" class="tx"> <input type="submit" class="tx1" value="登陆"> <br><br><br><br><br><br> 版权所有：<a href="http://Asp2004.net" target="_blank">http://<;font color=red>A</font>sp2004.net</a> </center> </form> </body> <% Response.End() End Function ’注销 Function logout() Session.Abandon() Response.Redirect(url) End Function %> <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 Version="化境HTTP上传程序 Version 2.0" 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>
