?? uploadfile.asp
字號:
<!--#include file = "Include/Startup.asp"-->
<!--#include file = "private.asp"-->
<%
Dim sStyleID, sUploadDir, sCurrDir, sDir
sPosition = sPosition & "上傳文件管理"
Call Content()
Sub Content()
If IsObjInstalled("Scripting.FileSystemObject") = False Then
Response.Write "此功能要求服務器支持文件系統對象（FSO），而你當前的服務器不支持！"
Exit Sub
End If
' 初始化傳入參數
Call InitParam()
Select Case sAction
Case "DELALL" ' 刪除所有文件
Call DoDelAll()
Case "DEL" ' 刪除指定文件
Call DoDel()
Case "DELFOLDER" ' 刪除文件夾
Call DoDelFolder()
End Select
' 顯示文件列表
Call ShowList()
End Sub
' UploadFile目錄下的所有文件列表
Sub ShowList()
If sCurrDir = "" Then Exit Sub
Response.Write "<link href='../Inc/Admin_Style.css' rel='stylesheet' type='text/css'>"& _
"<table cellpadding='0' cellspacing='1' border='0' width='90%' align='center' class='border'>"& _
"<tr>"& _
"<td class='topbg' height='25' align='center'><strong>上 傳 文 件 管 理</strong></td>"& _
"</tr>"& _
"<tr>"& _
"<td align='center'><table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' >" & _
"<form action='?id=" & sStyleID & "&dir=" & sDir & "&action=del' method=post name=myform>" & _
"<tr align=center>" & _
"<td class='tdbg' width=50>類型</td>" & _
"<td class='tdbg' width=140>文件地址</td>" & _
"<td class='tdbg' width=100>縮覽圖</td>" & _
"<td class='tdbg' width=100>大小</td>" & _
"<td class='tdbg' width=130>最后訪問</td>" & _
"<td class='tdbg' width=130>上傳日期</td>" & _
"<td class='tdbg'width=30>刪除</td>" & _
"</tr>"
Dim sCurrPage, nCurrPage, nFileNum, nPageNum, nPageSize
sCurrPage = Trim(Request("page"))
nPageSize = 20
If sCurrpage = "" Or Not IsNumeric(sCurrPage) Then
nCurrPage = 1
Else
nCurrPage = CLng(sCurrPage)
End If
Dim oFSO, oUploadFolder, oUploadFiles, oUploadFile, sFileName
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set oUploadFolder = oFSO.GetFolder(Server.MapPath(sCurrDir))
If Err.Number>0 Then
Response.Write "</table>無效的目錄！"
Exit Sub
End If
If sDir <> "" Then
Response.Write "<tr align=center>" & _
"<td class='tdbg'><img border=0 src='sysimage/file/folderback.gif'></td>" & _
"<td class='tdbg' align=left colspan=5><a href=""?id=" & sStyleID & "&dir="
If InstrRev(sDir, "/") > 1 Then
Response.Write Left(sDir, InstrRev(sDir, "/") - 1)
End If
Response.Write """>返回上一級目錄</a></td></tr>"
End If
Dim oSubFolder
For Each oSubFolder In oUploadFolder.SubFolders
Response.Write "<tr align=center>" & _
"<td class='tdbg'><img border=0 src='sysimage/file/folder.gif'></td>" & _
"<td class='tdbg' align=left colspan=4><a href=""?id=" & sStyleID & "&dir="
If sDir <> "" Then
Response.Write sDir & "/"
End If
Response.Write oSubFolder.Name & """>" & oSubFolder.Name & "</a></td>" & _
"<td class='tdbg'><a href='?id=" & sStyleID & "&dir=" & sDir & "&action=delfolder&foldername=" & oSubFolder.Name & "'>刪除</a></td></tr>"
Next
Set oUploadFiles = oUploadFolder.Files
nFileNum = oUploadFiles.Count
nPageNum = Int(nFileNum / nPageSize)
If nFileNum Mod nPageSize > 0 Then
nPageNum = nPageNum+1
End If
If nCurrPage > nPageNum Then
nCurrPage = 1
end If
Dim i
i = 0
For Each oUploadFile In oUploadFiles
i = i + 1
If i > (nCurrPage - 1) * nPageSize And i <= nCurrPage * nPageSize Then
sFileName = oUploadFile.Name
Response.Write "<tr align=center>" & _
"<td class='tdbg'>" & FileName2Pic(sFileName) & "</td>" & _
"<td class='tdbg'' align=left><a href=""" & sCurrDir & sFileName & """ target=_blank>" & sFileName & "</a></td>" & _
"<td class='tdbg'><a href=""" & sCurrDir & sFileName & """ target=_blank><img " & FileName3Pic(sFileName) & " border='0'></a></td>" & _
"<td class='tdbg'>" & oUploadFile.size & " B </td>" & _
"<td class='tdbg'>" & oUploadFile.datelastaccessed & "</td>" & _
"<td class='tdbg'>" & oUploadFile.datecreated & "</td>" & _
"<td class='tdbg'><input type=checkbox name=delfilename value=""" & sFileName & """></td></tr>"
Elseif i > nCurrPage * nPageSize Then
Exit For
End If
Next
Set oUploadFolder = Nothing
Set oUploadFiles = Nothing
If nFileNum <= 0 Then
Response.Write "<tr><td colspan=6>指定目錄下現在還沒有文件！</td></tr>"
End If
Response.Write "</table>"
If nFileNum > 0 Then
' 分頁
Response.Write "<table class='tdbg' border='0' align='center' cellpadding='2' cellspacing='1' width='100%'><tr><td>"
If nCurrPage > 1 Then
Response.Write "<a href='?id=" & sStyleID & "&dir=" & sDir & "&page=1'>首頁</a> <a href='?id=" & sStyleID & "&dir=" & sDir & "&page="& nCurrPage - 1 & "'>上一頁</a> "
Else
Response.Write "首頁 上一頁 "
End If
If nCurrPage < i / nPageSize Then
Response.Write "<a href='?id=" & sStyleID & "&dir=" & sDir & "&page=" & nCurrPage + 1 & "'>下一頁</a> <a href='?id=" & sStyleID & "&dir=" & sDir & "&page=" & nPageNum & "'>尾頁</a>"
Else
Response.Write "下一頁 尾頁"
End If
Response.Write " 共<b>" & nFileNum & "</b>個 頁次:<b><span class=highlight2>" & nCurrPage & "</span>/" & nPageNum & "</b> <b>" & nPageSize & "</b>個文件/頁"
Response.Write "</td></tr></table>"
End If
Response.Write "<table border='0' align='center' cellpadding='2' cellspacing='1' width='100%'><tr><td class='tdbg'><input type=submit name=b value=' 刪除選定的文件 '> <input type=submit name=b1 value=' 清空所有文件 ' onclick=""javascript:if (confirm('你確定要清空所有文件嗎？')) {location.href='#uploadfile.asp?id=" & sStyleID & "&dir=" & sDir & "&action=delall';}""></td></tr></table></form></td></tr></table><br><br><br><br><br>"
End Sub
' 刪除指定的文件
Sub DoDel()
On Error Resume Next
Dim sFileName, oFSO, sMapFileName
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
For Each sFileName In Request.Form("delfilename")
sMapFileName = Server.MapPath(sCurrDir & sFileName)
If oFSO.FileExists(sMapFileName) Then
oFSO.DeleteFile(sMapFileName)
End If
Next
Set oFSO = Nothing
End Sub
' 刪除所有的文件
Sub DoDelAll()
On Error Resume Next
Dim sFileName, oFSO, sMapFileName, oFolder, oFiles, oFile
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Server.MapPath(sCurrDir))
Set oFiles = oFolder.Files
For Each oFile In oFiles
sFileName = oFile.Name
sMapFileName = Server.MapPath(sCurrDir & sFileName)
If oFSO.FileExists(sMapFileName) Then
oFSO.DeleteFile(sMapFileName)
End If
Next
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
' 刪除文件夾
Sub DoDelFolder()
On Error Resume Next
Dim sFolderName, oFSO, sMapFolderName
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
sFolderName = Trim(Request("foldername"))
sMapFolderName = Server.Mappath(sCurrDir & sFolderName)
If oFSO.FolderExists(sMapFolderName) = True Then
oFSO.DeleteFolder(sMapFolderName)
End If
Set oFSO = Nothing
End Sub
' 檢測服務器是否支持某一對象
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
' 按文件名取圖
Function FileName2Pic(sFileName)
Dim sExt, sPicName
sExt = UCase(Mid(sFileName, InstrRev(sFileName, ".")+1))
Select Case sExt
Case "TXT"
sPicName = "txt.gif"
Case "CHM", "HLP"
sPicName = "hlp.gif"
Case "DOC"
sPicName = "doc.gif"
Case "PDF"
sPicName = "pdf.gif"
Case "MDB"
sPicName = "mdb.gif"
Case "GIF"
sPicName = "gif.gif"
Case "JPG"
sPicName = "jpg.gif"
Case "BMP"
sPicName = "bmp.gif"
Case "PNG"
sPicName = "pic.gif"
Case "ASP", "JSP", "JS", "PHP", "PHP3", "ASPX"
sPicName = "code.gif"
Case "HTM", "HTML", "SHTML"
sPicName = "htm.gif"
Case "ZIP"
sPicName = "zip.gif"
Case "RAR"
sPicName = "rar.gif"
Case "EXE"
sPicName = "exe.gif"
Case "AVI"
sPicName = "avi.gif"
Case "MPG", "MPEG", "ASF"
sPicName = "mp.gif"
Case "RA", "RM"
sPicName = "rm.gif"
Case "MP3"
sPicName = "mp3.gif"
Case "MID", "MIDI"
sPicName = "mid.gif"
Case "WAV"
sPicName = "audio.gif"
Case "XLS"
sPicName = "xls.gif"
Case "PPT", "PPS"
sPicName = "ppt.gif"
Case "SWF"
sPicName = "swf.gif"
Case Else
sPicName = "unknow.gif"
End Select
FileName2Pic = "<img border=0 src='sysimage/file/" & sPicName & "'>"
End Function
' 按文件名取圖
Function FileName3Pic(sFileName)
Dim sExt, sPicName
sExt = UCase(Mid(sFileName, InstrRev(sFileName, ".")+1))
Select Case sExt
Case "TXT"
sPicName = "src='sysimage/file/txt.gif' "
Case "CHM", "HLP"
sPicName = "src='sysimage/file/hlp.gif' "
Case "DOC"
sPicName = "src='sysimage/file/doc.gif' "
Case "PDF"
sPicName = "src='sysimage/file/pdf.gif' "
Case "MDB"
sPicName = "src='sysimage/file/mdb.gif' "
Case "GIF"
sPicName = "src=""" & sCurrDir & sFileName & """ width='45' height='32'"
Case "JPG"
sPicName = "src=""" & sCurrDir & sFileName & """ width='45' height='32'"
Case "BMP"
sPicName = "src=""" & sCurrDir & sFileName & """ width='45' height='32'"
Case "PNG"
sPicName = "src=""" & sCurrDir & sFileName & """ width='45' height='32'"
Case "ASP", "JSP", "JS", "PHP", "PHP3", "ASPX"
sPicName = "src='sysimage/file/code.gif' "
Case "HTM", "HTML", "SHTML"
sPicName = "src='sysimage/file/htm.gif' "
Case "ZIP"
sPicName = "src='sysimage/file/zip.gif' "
Case "RAR"
sPicName = "src='sysimage/file/rar.gif' "
Case "EXE"
sPicName = "src='sysimage/file/exe.gif' "
Case "AVI"
sPicName = "src='sysimage/file/avi.gif' "
Case "MPG", "MPEG", "ASF"
sPicName = "src='sysimage/file/mp.gif' "
Case "RA", "RM"
sPicName = "src='sysimage/file/rm.gif' "
Case "MP3"
sPicName = "src='sysimage/file/mp3.gif' "
Case "MID", "MIDI"
sPicName = "src='sysimage/file/mid.gif' "
Case "WAV"
sPicName = "src='sysimage/file/audio.gif' "
Case "XLS"
sPicName = "src='sysimage/file/xls.gif' "
Case "PPT", "PPS"
sPicName = "src='sysimage/file/ppt.gif' "
Case "SWF"
sPicName = "src='sysimage/file/swf.gif' "
Case Else
sPicName = "src='sysimage/file/unknow.gif' "
End Select
FileName3Pic = "" & sPicName & ""
End Function
' ===============================================
' 初始化下拉框
' v_InitValue : 初始值
' s_Sql : 從數據庫中取值時,select name,value from table
' s_AllName : 空值的名稱,如:"全部","所有","默認"
' ===============================================
Function InitSelect(v_InitValue, s_Sql, s_AllName)
Dim i
InitSelect = ""
If s_AllName <> "" Then
InitSelect = InitSelect & "<option value=''>" & s_AllName & "</option>"
End If
oRs.Open s_Sql, oConn, 0, 1
Do While Not oRs.Eof
InitSelect = InitSelect & "<option value=""" & inHTML(oRs(1)) & """"
If CStr(oRs(1)) = CStr(v_InitValue) Then
InitSelect = InitSelect & " selected"
End If
InitSelect = InitSelect & ">" & outHTML(oRs(0)) & "</option>"
oRs.MoveNext
Loop
oRs.Close
End Function
' ===============================================
' 初始化傳入參數
' ===============================================
Function InitParam()
sStyleID = Trim(Request("id"))
sUploadDir = ""
If IsNumeric(sStyleID) = True Then
sSql = "select S_UploadDir from eWebEditor_Style where S_ID=" & sStyleID
oRs.Open sSql, oConn, 0, 1
If Not oRs.Eof Then
sUploadDir = oRs(0)
End If
oRs.Close
End If
If sUploadDir = "" Then
sStyleID = ""
Else
sUploadDir = Replace(sUploadDir, "\", "/")
If Right(sUploadDir, 1) <> "/" Then
sUploadDir = sUploadDir & "/"
End If
End If
sCurrDir = sUploadDir
' 樣式下的目錄
sDir = Trim(Request("dir"))
If sDir <> "" Then
If CheckValidDir(Server.Mappath(sUploadDir & sDir)) = True Then
sCurrDir = sUploadDir & sDir & "/"
Else
sDir = ""
End If
End If
End Function
' ===============================================
' 檢測目錄的有效性
' ===============================================
Function CheckValidDir(s_Dir)
Dim oFSO
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
CheckValidDir = oFSO.FolderExists(s_Dir)
Set oFSO = Nothing
End Function
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -