<%
'######################################
' eWebEditor v6.2 - Advanced online web based WYSIWYG HTML editor.
' Copyright (c) 2003-2008 eWebSoft.com
'
' For further information go to http://www.ewebsoft.com/
' This copyright notice MUST stay intact for use.
'######################################
%>
<%
Dim sStyleID, sCurrDir, sDir, sCurrPath
sPosition = sPosition & "上传文件管理"
Call Header()
Call Content()
Call Footer()
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
Sub ShowList()
Dim sCurrPage, nCurrPage, nFileNum, nPageNum, nPageSize
sCurrPage = Trim(Request("page"))
Dim s_ViewMode, s_FormViewMode
s_ViewMode = Trim(Request("d_viewmode"))
s_FormViewMode = InitSelect("d_viewmode", Split("预览模式|列表模式", "|"), Split("|list", "|"), s_ViewMode, "", "onchange=""location.href='?id=" & sStyleID & "&d_viewmode='+this.value+'&dir=" & sDir & "&page=" & sCurrPage & "'""")
Response.Write "
" & _
"
"
If sCurrDir = "" Then Exit Sub
Response.Write "
" & _
"
"
Exit Sub
End If
If sDir <> "" Then
Response.Write "
"
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, m, n
i = 0
m = 0
n = 0
For Each oUploadFile In oUploadFiles
i = i + 1
If i > (nCurrPage - 1) * nPageSize And i <= nCurrPage * nPageSize Then
sFileName = oUploadFile.Name
If s_ViewMode = "list" Then
Response.Write "
"
End If
End If
Elseif i > nCurrPage * nPageSize Then
Exit For
End If
Next
Set oUploadFolder = Nothing
Set oUploadFiles = Nothing
If s_ViewMode <> "list" Then
If n > 0 Then
Dim ii
If m <> 0 Then
For ii = 1 To 4 - m
Response.Write "
"
Next
Response.Write ""
End If
Response.Write "
"
End If
End If
If nFileNum <= 0 Then
Response.Write "
指定目录下现在还没有文件！
"
End If
If nFileNum > 0 Then
Response.Write "
"
If nCurrPage > 1 Then
Response.Write "首页上一页 "
Else
Response.Write "首页 上一页 "
End If
If nCurrPage < i / nPageSize Then
Response.Write "下一页尾页"
Else
Response.Write "下一页 尾页"
End If
Response.Write " 共" & nFileNum & "个 页次:" & nCurrPage & "/" & nPageNum & "" & nPageSize & "个文件/页"
Response.Write "
"
End If
Response.Write ""
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 = 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(sCurrDir)
Set oFiles = oFolder.Files
For Each oFile In oFiles
sFileName = oFile.Name
sMapFileName = 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 = 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", "JPEG"
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 = ""
End Function
Function File2Preview(s_Path, s_File)
Dim s_PathFile
s_PathFile = s_Path & s_File
Dim sExt
sExt = UCase(Mid(s_File, InstrRev(s_File, ".")+1))
Select Case sExt
Case "GIF", "JPG", "JPEG", "BMP", "PNG"
File2Preview = ""
Case "SWF"
File2Preview = ""
Case Else
File2Preview = FileName2Pic(s_File)
End Select
End Function
Function InitSelectStyle(v_InitValue, s_AllName)
Dim i, aTemp
InitSelectStyle = ""
If s_AllName <> "" Then
InitSelectStyle = InitSelectStyle & ""
End If
For i = 1 To Ubound(aStyle)
aTemp = Split(aStyle(i), "|||")
InitSelectStyle = InitSelectStyle & ""
Next
End Function
Function InitParam()
Dim i, a_CurrStyle, s_UploadDir, s_BaseUrl
sStyleID = Trim(Request("id"))
s_UploadDir = ""
If IsNumeric(sStyleID) = True Then
If Clng(sStyleID) <= Ubound(aStyle) Then
a_CurrStyle = Split(aStyle(Clng(sStyleID)), "|||")
s_UploadDir = a_CurrStyle(3)
End If
End If
If s_UploadDir = "" Then
sStyleID = ""
sCurrDir = ""
Exit Function
End If
s_BaseUrl = a_CurrStyle(19)
If s_BaseUrl = "3" Then
sCurrDir = s_UploadDir
sCurrPath = a_CurrStyle(23)
Else
If Left(s_UploadDir,1)<>"/" Then
s_UploadDir = "../" & s_UploadDir
End If
sCurrDir = Server.MapPath(s_UploadDir)
sCurrPath = s_UploadDir
End If
If CheckValidDir(sCurrDir) = False Then
sCurrDir = ""
Exit Function
End If
If Right(sCurrDir,1)<>"\" Then
sCurrDir = sCurrDir & "\"
End If
If Right(sCurrPath,1)<>"/" Then
sCurrPath = sCurrPath & "/"
End If
sDir = Trim(Request("dir"))
If sDir <> "" Then
Dim s_Dir2
s_Dir2 = Replace(sDir, "/", "\")
If CheckValidDir(sCurrDir & s_Dir2) = True Then
sCurrDir = sCurrDir & s_Dir2 & "\"
sCurrPath = sCurrPath & 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
%>
