<%
’版权声明：本代码仅供学习研究之用，本人不对因使用本程序而造成的任何后果负责。未经作者书面许可不得用于商业用途。
’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)
%>
<%
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
%>
<%
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)
%>
<%
End Function
’重命名表单
Function renameform(oldname)
%>
<%
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)
%>
|
<%
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 File.SaveAs formPath&filename End If Set File = Nothing End If Next End If Response.Write("") 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 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("") 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("") End If End If End If Call LoginForm() End Function ’登陆表单 Function LoginForm() %>
版权所有：http://Asp2004.net
<%
Response.End()
End Function
’注销
Function logout()
Session.Abandon()
Response.Redirect(url)
End Function
%>