admin_selectfile.asp

个人网站比较简短

<!--#include file="Admin_Common.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Const NeedCheckComeUrl = False   '是否需要检查外部访问

Const PurviewLevel = 2      '0--不检查，1--超级管理员，2--普通管理员
Const PurviewLevel_Channel = 0   '0--不检查，1--频道管理员，2--栏目总编，3--栏目管理员
Const PurviewLevel_Others = ""   '其他权限

'强制浏览器重新访问服务器下载页面，而不是从缓存读取页面
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"


Dim FileCount, TotalSize, TotalSize_Page
Dim TotalUnit, strTotalUnit, PageUnit, strPageUnit

Dim ShowFileStyle
Dim StrFileType
Dim TruePath, theFolder, theFile, thisfile
Dim FolderCount, theSubFolder
Dim RootDir, ParentDir, CurrentDir
Dim strPath, strPath2, strPath3
Dim DialogType

Dim req, sortBy, priorSort, curFiles, currentSlot, fileItem, reverse
Dim fname, fext, fsize, ftype, fcreate, fmod, faccess
Dim kind, minmax, minmaxSlot, temp, i, mark, j
Dim theFiles, SearchKeyword
Dim rsChannel, UpFileType

ShowFileStyle = GetUploadFileStyle()
SearchKeyword = Trim(Request("SearchKeyword"))

ParentDir = Replace(Replace(Replace(Trim(Request("ParentDir")), "../", ""), "..\", ""), "\", "/")
If Left(ParentDir, 1) = "/" Then ParentDir = Right(ParentDir, Len(ParentDir) - 1)

CurrentDir = Replace(Replace(Replace(Trim(Request("CurrentDir")), "/", ""), "\", ""), "..", "")
DialogType = LCase(Trim(Request("DialogType")))
ChannelID = PE_CLng(Trim(Request("ChannelID")))
If ChannelID = 0 Then
    Response.Write "请指定频道ID！"
    Response.End
Else
    Set rsChannel = Conn.Execute("select * from PE_Channel where ChannelID=" & ChannelID & " order by OrderID")
    If rsChannel.BOF And rsChannel.EOF Then
        Response.Write "找不到指定的频道！"
        Response.End
    Else
        If rsChannel("Disabled") = True Then
            Response.Write "此频道已经被禁用！"
            Response.End
        End If
        ChannelDir = rsChannel("ChannelDir")
        ModuleType = rsChannel("ModuleType")
        UpFileType = rsChannel("UpFileType")
        Dim arrFileType
        If UpFileType = "" Then
            arrFileType = Split("gif|jpg|jpeg|jpe|bmp|png$swf$mid|mp3|wmv|asf|avi|mpg$ram|rm|ra$rar|exe|doc|zip", "$")
        Else
            arrFileType = Split(UpFileType, "$")
            If UBound(arrFileType) < 4 Then
                arrFileType = Split("gif|jpg|jpeg|jpe|bmp|png$swf$mid|mp3|wmv|asf|avi|mpg$ram|rm|ra$rar|exe|doc|zip", "$")
            End If
        End If
        Select Case DialogType
            Case "pic", "batchpic", "softpic", "adpic", "productthumb"
                UpFileType = Trim(arrFileType(0))
            Case "photo", "photos"
                UpFileType = Trim(arrFileType(0)) & "|" & Trim(arrFileType(1))
            Case "flash"
                UpFileType = Trim(arrFileType(1))
            Case "media"
                UpFileType = Trim(arrFileType(2))
            Case "rm"
                UpFileType = Trim(arrFileType(3))
            Case "fujian"
                UpFileType = Trim(arrFileType(4))
            Case "soft"
                UpFileType = Trim(arrFileType(1)) & "|" & Trim(arrFileType(2)) & "|" & Trim(arrFileType(3)) & "|" & Trim(arrFileType(4))
            Case "all"
                UpFileType = Trim(arrFileType(0)) & "|" & Trim(arrFileType(1)) & "|" & Trim(arrFileType(2)) & "|" & Trim(arrFileType(3)) & "|" & Trim(arrFileType(4))
            Case Else
                UpFileType = ""
        End Select
        If DialogType = "softpic" Then
            UploadDir = "UploadSoftPic"
        Else
            UploadDir = rsChannel("UploadDir")
        End If
    End If
    rsChannel.Close
    Set rsChannel = Nothing
End If
If ChannelDir = "" Then
    Response.Write "未指定相应的目录！"
    Response.End
End If
strFileName = "Admin_SelectFile.asp?ChannelID=" & ChannelID & "&DialogType=" & DialogType

RootDir = InstallDir & ChannelDir & "/" & UploadDir
strPath = RootDir
strPath2 = UploadDir
strPath3 = ""
If ParentDir <> "" Then
    strPath = strPath & "/" & ParentDir
    strPath2 = strPath2 & "/" & ParentDir
    strPath3 = ParentDir
End If
If CurrentDir <> "" Then
    strPath = strPath & "/" & CurrentDir
    strPath2 = strPath2 & "/" & CurrentDir
    If ParentDir <> "" Then
        strPath3 = strPath3 & "/" & CurrentDir & "/"
    Else
        strPath3 = CurrentDir & "/"
    End If
End If
strPath = Replace(strPath, "//", "/")
strPath2 = Replace(strPath2, "//", "/")
TruePath = Server.MapPath(strPath)

Response.Write "<html>" & vbCrLf
Response.Write "<head>" & vbCrLf
Response.Write "<title>从已上传文件选择</title>" & vbCrLf
Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
Response.Write "<link href='Admin_Style.css' rel='stylesheet' type='text/css'>" & vbCrLf
Response.Write "<base target='_self'>" & vbCrLf
Response.Write "</head>" & vbCrLf
Response.Write "<body leftmargin='2' topmargin='0' marginwidth='0' marginheight='0'>" & vbCrLf
If ObjInstalled_FSO = False Then
    Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能使用本功能</font></b>"
    Response.Write "</body></html>"
    Response.End
End If

If SearchKeyword <> "" Then
    Response.Write "    <form name='myform' method='Post' action='" & strFileName & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & "&SearchKeyword=" & SearchKeyword & "'>" & vbCrLf
Else
    Response.Write "    <form name='myform' method='Post' action='" & strFileName & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & "'>" & vbCrLf
End If
Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1'>" & vbCrLf

Response.Write "  <tr class='tdbg'> "
Response.Write "    <td width='0' height='30'>"
Response.Write "    &nbsp;&nbsp;<img src='Images/admin_open.gif'  width='13' height='13' border='0'>&nbsp;&nbsp;&nbsp;"
If ShowFileStyle = 1 Then
    Response.Write "<a href='Admin_UploadFile_Style.asp?ShowFileStyle=2'>切换到缩略图方式 </a>" & vbCrLf
Else
    Response.Write "<a href='Admin_UploadFile_Style.asp?ShowFileStyle=1'>切换到详细信息方式</a>" & vbCrLf
End If

Response.Write "    </td>"

Response.Write "<td height='30'>"
Response.Write "    <table width='100%' border='0' align='center' cellpadding='1' cellspacing='1'><tr><td height='22' align='right'>"
Response.Write "&nbsp; 搜索当前目录文件：</td><td height='22'><input type='text' name='SearchKeyword' id='SearchKeyword' size='18' value=''>&nbsp;</td><td height='22'><input type='submit' name='submit1' value=' 搜索 '>"
Response.Write "    </td></tr></table></td>"
Response.Write "  </tr>"
Response.Write "</table>" & vbCrLf

If fso.FolderExists(TruePath) = False Then
    Response.Write "找不到文件夹！可能是配置有误！"
    Response.End
End If

Dim Add2Array
If fso.FolderExists(TruePath) = False Then
    FoundErr = True
    ErrMsg = ErrMsg & "<li>找不到文件夹！请上传文件后再进行管理！</li>"
    Response.End
End If
Response.Write "<Script Language=""JavaScript"">" & vbCrLf
Response.Write "function reSort(which)" & vbCrLf
Response.Write "{" & vbCrLf
If SearchKeyword <> "" Then
    Response.Write "document.myform.SearchKeyword.value = '" & SearchKeyword & "';" & vbCrLf
End If
Response.Write "document.myform.sortby.value = which;" & vbCrLf
Response.Write "document.myform.submit();" & vbCrLf
Response.Write "}" & vbCrLf
Response.Write "</Script>" & vbCrLf
'Dim FolderCount

req = Trim(Request("sortBy"))
If Len(req) < 1 Or req = "-1" Then
    sortBy = 0
Else
    sortBy = CInt(req)
End If
req = Request("priorSort")
If Len(req) < 1 Or req = "-1" Then
    priorSort = -1
Else
    priorSort = CInt(req)
End If
'设置倒序
If sortBy = priorSort Then
    reverse = True
    priorSort = -1
Else
    reverse = False
    priorSort = sortBy
End If

Set theFolder = fso.GetFolder(TruePath)
Set curFiles = theFolder.Files

ReDim theFiles(500)
currentSlot = -1

For Each fileItem In curFiles
    Add2Array = False
    fname = fileItem.name
    If SearchKeyword <> "" Then
        If InStr(LCase(fname), LCase(SearchKeyword)) > 0 Then
            Add2Array = True
        End If
    Else
        Add2Array = True
    End If
    If Add2Array = True Then
        fext = InStrRev(fname, ".")
        If fext < 1 Then fext = "" Else fext = Mid(fname, fext + 1)
        ftype = fileItem.Type
        fsize = fileItem.size
        fcreate = fileItem.DateCreated
        fmod = fileItem.DateLastModified
        faccess = fileItem.DateLastAccessed
        currentSlot = currentSlot + 1
        If currentSlot > UBound(theFiles) Then
            ReDim Preserve theFiles(currentSlot + 99)
        End If

        theFiles(currentSlot) = Array(fname, fext, fsize, ftype, fcreate, fmod, faccess)
    End If
Next

If currentSlot > -1 Then
    FileCount = currentSlot ' 文件数量
    ReDim Preserve theFiles(currentSlot)


    If VarType(theFiles(0)(sortBy)) = 8 Then
        If reverse Then kind = 1 Else kind = 2
    Else
        If reverse Then kind = 3 Else kind = 4
    End If
    For i = FileCount To 0 Step -1
        minmax = theFiles(0)(sortBy)
        minmaxSlot = 0
        For j = 1 To i
            Select Case kind
                Case 1
                mark = (StrComp(theFiles(j)(sortBy), minmax, vbTextCompare) < 0)
                Case 2
                mark = (StrComp(theFiles(j)(sortBy), minmax, vbTextCompare) > 0)
                Case 3
                mark = (theFiles(j)(sortBy) < minmax)
                Case 4
                mark = (theFiles(j)(sortBy) > minmax)
            End Select
            If mark Then
                minmax = theFiles(j)(sortBy)
                minmaxSlot = j
            End If
        Next
        If minmaxSlot <> i Then
            temp = theFiles(minmaxSlot)