📄 wm.sys_ftp.asp
字号:
Response.Write "<tr Class=td2><td width='20%'><strong>原文件夹名称</strong></td><td width='80%'><input type='text' name='Path' value='"&w_Path&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>新文件夹名称</strong></td><td><input type='text' name='NewPath'></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td></td><td><input type=submit name='Submit' value='重命名'> <input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "</table>" & vbCrLf
Else
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<form name='form1' method='post' action='?"&URLParameter&"&Action=EditFile'>" & vbCrLf
Response.Write "<tr Class=td2><td width='20%'><strong>原文件名称</strong></td><td width='80%'><input type='text' name='Path' value='"&w_Path&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>新文件名称</strong></td><td><input type='text' name='NewPath'></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td></td><td><input type=submit name='Submit' value='重命名'> <input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "</table>" & vbCrLf
End If
Case "MoveFolder"
w_NewPath = Request("NewPath")
If Right(w_NewPath,1) = "/" Then w_NewPath = Left(w_NewPath,Len(w_NewPath)-1)
If WRMPS.FsoIsTrue("Dir",w_NewPath) = False Then
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<tr Class=td2><td height=100px align=center><strong>新路径不存在</strong><p><input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Else
If sCurrDir&w_Path <> w_NewPath&"/"&w_Path Then
WRMPS.FolderCopy sCurrDir&w_Path,w_NewPath&"/"&GetPath(w_Path)
WRMPS.FsoDel "Dir",sCurrDir&w_Path
End If
Response.Redirect "?"&URLParameter
End If
Case "MoveFile"
w_NewPath = Request("NewPath")
If Right(w_NewPath,1) = "/" Then w_NewPath = Left(w_NewPath,Len(w_NewPath)-1)
If WRMPS.FsoIsTrue("Dir",w_NewPath) = False Then
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<tr Class=td2><td height=100px align=center><strong>新路径不存在</strong><p><input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Else
If sCurrDir&w_Path <> w_NewPath&"/"&w_Path Then
WRMPS.FileCopy sCurrDir&w_Path,w_NewPath&"/"&GetPath(w_Path)
WRMPS.FsoDel "File",sCurrDir&w_Path
End If
Response.Redirect "?"&URLParameter
End If
Case "Move"
If w_Ext <> "File" Then
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<form name='form1' method='post' action='?"&URLParameter&"&Action=MoveFolder'>" & vbCrLf
Response.Write "<tr Class=td2><td width='20%'><strong>文件夹名称</strong></td><td width='80%'><input type='text' name='Path' value='"&w_Path&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>当前路径</strong></td><td><input type='text' value='"&sCurrDir&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>新路径</strong></td><td><input type='text' name='NewPath' value='"&sCurrDir&"'></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td></td><td><input type=submit name='Submit' value='移 动'> <input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "</table>" & vbCrLf
Else
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<form name='form1' method='post' action='?"&URLParameter&"&Action=MoveFile'>" & vbCrLf
Response.Write "<tr Class=td2><td width='20%'><strong>文件名称</strong></td><td width='80%'><input type='text' name='Path' value='"&w_Path&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>当前路径</strong></td><td><input type='text' value='"&sCurrDir&"' readonly></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td><strong>新路径</strong></td><td><input type='text' name='NewPath' value='"&sCurrDir&"'></td></tr>" & vbCrLf
Response.Write "<tr Class=td2><td></td><td><input type=submit name='Submit' value='移 动'> <input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()""></td></tr>" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "</table>" & vbCrLf
End If
Case "DelGO"
If w_Ext <> "File" Then
WRMPS.FsoDel "Dir",sCurrDir&w_Path
Else
WRMPS.FsoDel "File",sCurrDir&w_Path
End If
Response.Redirect "?"&URLParameter
Case "Del"
Dim DelText
If w_Ext <> "File" Then
DelText = "文件夹"
Else
DelText = "文件"
End If
Response.Write "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Response.Write "<tr Class=td2><td height=100px align=center><strong>确实要删除此"&DelText&"吗?</strong><p>" & vbCrLf
Response.Write "<input type='button' name='Submit' value='确 定' Onclick=""javascript:window.open('?"&URLParameter&"&Action=DelGO&Ext="&w_Ext&"&Path="&w_Path&"','_self')""> "
Response.Write "<input type='button' name='Submit' value='返 回' Onclick=""javascript:history.back()"">"
Response.Write "</td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Case Else
'显示文件列表
Response.Write "<table width=100% border=0 align=center cellpadding=0 cellspacing=0>" & vbCrLf
Set oUploadFolder = Fso.GetFolder(Server.MapPath(sCurrDir))
If Err.Number > 0 Then
Response.Write "<tr><td Class=td4>无效的目录</td></tr></table></td></tr></table>" & vbCrLf
Call ClassEnd()
Call GetBottom()
Exit Sub
End If
sF = 0
If sDir <> "" Then
sF = sF + 1
Response.write "<tr><td colspan=4 style=""padding:2px 0 2px 5px"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write "><a title='返回上一级文件夹' href='?dir="
If InStrRev(sDir, "/") > 1 Then Response.Write Left(sDir, InStrRev(sDir, "/") - 1)
Response.Write "' target=''><img border=0 src='../Images/Ext/folderback.gif' align=absmiddle> ..</a></td>"
Response.Write "</tr>" & vbCrLf
End If
For Each oSubFolder In oUploadFolder.SubFolders
sF = sF + 1
Response.write "<tr><td style=""padding:2px 0 2px 5px"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write "><a title='打开此文件夹' href=""?dir="
If sDir <> "" Then Response.Write sDir & "/"
Response.Write oSubFolder.Name & """ target=''><img border=0 src='../Images/Ext/folder.gif' align=absmiddle> " & oSubFolder.Name & "</a></td>"
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write "></td>" & vbCrLf
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write ">"&oSubFolder.DateLastModified&"</td>" & vbCrLf
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write "><a href='?"&URLParameter&"&Action=Move&Ext=Folder&Path="&oSubFolder.Name&"'>移动</a> <a href='?"&URLParameter&"&Action=EditName&Ext=Folder&Path="&oSubFolder.Name&"'>改名</a> <a href='?"&URLParameter&"&Action=Del&Ext=Folder&Path="&oSubFolder.Name&"'>删除</a></td></tr>" & vbCrLf
Next
Set oUploadFiles = oUploadFolder.Files
Dim nFileNum
nFileNum = oUploadFiles.Count
n = 0
For Each oUploadFile In oUploadFiles
sF = sF + 1
sFilter = "":sPic = "":sFileName = oUploadFile.Name
sFilter = Lcase(Split(sCurrDir & sFileName,".")(UBound(Split(sCurrDir & sFileName,"."))))
If sFilter = "jpg" Or sFilter = "gif" Or sFilter = "jpeg" Or sFilter = "bmp" Or sFilter = "png" Or sFilter = "ico" Then sPic = Replace(sCurrDir & sFileName,"../../","") Else sPic = sExt(sCurrDir & sFileName)
Response.write "<tr><td style=""padding:2px 0 2px 5px"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write " width='*'><a style='cursor:hand' onclick=""show("&nFileNum&",'"&sPic&"','a_"&n&"','"&sFileName&"','"&UCase(Mid(sFileName, InStrRev(sFileName, ".") + 1)) &"','"&Showsize(oUploadFile.size)&"','"&oUploadFile.DateCreated&"','"&oUploadFile.DateLastModified&"','"&oUploadFile.DateLastAccessed&"')"" target=''"
Response.write " title='名称:"&sFileName&vbCrLf&"类型:"&UCase(Mid(sFileName, InStrRev(sFileName, ".") + 1)) &" 文件"&vbCrLf&"大小:"&Showsize(oUploadFile.size)&vbCrLf&"创建时间:"&oUploadFile.DateCreated&vbCrLf&"最后更新:"&oUploadFile.DateLastModified&vbCrLf&"最后访问:"&oUploadFile.DateLastAccessed&"'>"
Response.Write "<img border=0 src='"&sExt(sCurrDir & sFileName)&"' align=absmiddle> <span id=a_"&n&">" &sFileName& "</span></a></td>"
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write " width='80px'>"&Showsize(oUploadFile.size)&"</td>" & vbCrLf
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write " width='150px'>"&oUploadFile.DateLastModified&"</td>" & vbCrLf
Response.Write "<td align=right style=""padding:2px 5px 2px 0"""
If sF Mod 2 = 0 Then Response.write " class=td1" Else Response.write " class=td2"
Response.write " width='150px'><a href='?"&URLParameter&"&Action=Edit&Ext="&sFilter&"&Path="&sFileName&"'>编辑</a> <a href='?"&URLParameter&"&Action=Move&Ext=File&Path="&sFileName&"'>移动</a> <a href='?"&URLParameter&"&Action=EditName&Ext=File&Path="&sFileName&"'>改名</a> <a href='?"&URLParameter&"&Action=Del&Ext=File&Path="&sFileName&"'>删除</a></td></tr>" & vbCrLf
n = n + 1
Next
Response.Write "</tr>" & vbCrLf
Set oUploadFolder = Nothing
Set oUploadFiles = Nothing
Call WRMPS.FsoEnd()
Response.Write "</table>" & vbCrLf
End Select
Response.Write "</td>"
Response.Write "<td width=200px valign=top>" & vbCrLf
Response.Write "</td></tr>"
Response.Write "</table>" & vbCrLf
End Sub
Function Showsize(Show)
Dim ShowS
ShowS = Show & " Byte"
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " KB"
End If
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " MB"
End If
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " GB"
End If
Showsize = ShowS
End Function
Function sExt(str)
Dim Z_sExt
Z_sExt = UCase(Mid(str, InStrRev(str, ".") + 1))
Select Case Z_sExt
Case "TXT"
sExt = "../Images/Ext/txt.gif"
Case "CHM", "HLP"
sExt = "../Images/Ext/hlp.gif"
Case "DOC"
sExt = "../Images/Ext/doc.gif"
Case "PDF"
sExt = "../Images/Ext/pdf.gif"
Case "MDB"
sExt = "../Images/Ext/mdb.gif"
Case "GIF"
sExt = "../Images/Ext/gif.gif"
Case "PNG"
sExt = "../Images/Ext/pic.gif"
Case "BMP"
sExt = "../Images/Ext/bmp.gif"
Case "JPG","JPEG"
sExt = "../Images/Ext/jpg.gif"
Case "SWF"
sExt = "../Images/Ext/swf.gif"
Case "ASP", "JSP", "JS", "PHP", "PHP3", "PHP4", "ASPX", "CSS"
sExt = "../Images/Ext/code.gif"
Case "HTM","HTML","SHTML","DHTML"
sExt = "../Images/Ext/htm.gif"
Case "RAR"
sExt = "../Images/Ext/rar.gif"
Case "ZIP"
sExt = "../Images/Ext/zip.gif"
Case "EXE"
sExt = "../Images/Ext/exe.gif"
Case "XLS"
sExt = "../Images/Ext/xls.gif"
Case "AVI"
sExt = "../Images/Ext/avi.gif"
Case "RM"
sExt = "../Images/Ext/rm.gif"
Case "MP3"
sExt = "../Images/Ext/mp3.gif"
Case "MID","MIDI"
sExt = "../Images/Ext/mid.gif"
Case "MPG", "MPEG", "ASF","RA","WAV","MP4"
sExt = "../Images/Ext/mp.gif"
Case Else
sExt = "../Images/Ext/unknow.gif"
End Select
End Function
Call ClassEnd()
Call GetBottom()
Class UpLoadClass
Private p_MaxSize,p_FileType,p_SavePath,p_AutoSave,p_Error
Private objForm,binForm,binItem,strDate,lngTime
Public FormItem,FileItem
Public Property Get Version
Version="Rumor UpLoadClass Version 2.0"
End Property
Public Property Get Error
Error=p_Error
End Property
Public Property Get MaxSize
MaxSize=p_MaxSize
End Property
Public Property Let MaxSize(lngSize)
if isNumeric(lngSize) then
p_MaxSize=clng(lngSize)
end if
End Property
Public Property Get FileType
FileType=p_FileType
End Property
Public Property Let FileType(strType)
p_FileType=strType
End Property
Public Property Get SavePath
SavePath=p_SavePath
End Property
Public Property Let SavePath(strPath)
p_SavePath=replace(strPath,chr(0),"")
End Property
Public Property Get AutoSave
AutoSave=p_AutoSave
End Property
Public Property Let AutoSave(byVal Flag)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -