WEB文件管理器2.0版

<%
’版权声明：本代码仅供学习研究之用，本人不对因使用本程序而造成的任何后果负责。未经作者书面许可不得用于商业用途。
’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)
%>

’">





>

’,’new_page’,’width=600,height=260,left=100,top=100,scrollbars=auto’);return false;">





当前目录:<%=f.path%>当前时间:<%=now%>









<%
’列出目录
Set fc = f.SubFolders
For Each f1 in fc
%>








<%
Next
’列出文件
Set fc = f.Files
For Each f1 in fc
%>








<%
Next
%>

操作	名称	大小<%= formatnumber(f.size/1024,2)%>K	类型	修改时间	属性
">	<%= f1.name%>	<%= f1.size%>	<%= f1.type%>	<%= f1.datelastmodified%>	<%= f1.Attributes%>
">	<%= f1.name%>	<%= f1.size%>	<%= f1.type%>	<%= f1.datelastmodified%>	<%= f1.Attributes%>

<%
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
%>

<%= content%>

<%
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)
%>

输入新的名字：’>’ size="100">

<%
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)
%>

操 作 执 行 中 请稍候...

文件上传

需要上传的个数： 上传到：使用绝对路径 防止覆盖自动重命名 密码：

<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+’:
’;
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 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 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()
%>

请输入密码：








版权所有：http://Asp2004.net

<%
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>