admin_uploadfile_main.asp

个人网站比较简短

        Exit Function
    End If
    Dim strFile

    Select Case LCase(sType)
    Case "jpeg", "jpe", "bmp", "png", "jpg", "gif"
        strFile = "<img src='" & sPath & "'"
        strFile = strFile & " width='200'"
        strFile = strFile & " height='120'"
        strFile = strFile & " border='0'>"
    Case "wmv", "avi", "asf", "mpg", "rm", "ra", "ram", "swf"
        strFile = "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0'"
        strFile = strFile & " width='200'"
        strFile = strFile & " height='120'"
        strFile = strFile & "><param name='movie' value='" & sPath & "'>"
        strFile = strFile & "<param name='wmode' value='transparent'>"
        strFile = strFile & "<param name='quality' value='autohigh'>"
        strFile = strFile & "<embed src='" & sPath & "' quality='autohigh'"
        strFile = strFile & " pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash'"
        strFile = strFile & " wmode='transparent'"
        strFile = strFile & " width='200'"
        strFile = strFile & " height='120'"
        strFile = strFile & "></embed></object>"
    Case Else
        strFile = "&nbsp;此文件非图片或动画，无预览&nbsp;"
    End Select

    GetFileContent = strFile
End Function

Sub ShowFileDetail_fol()
    Response.Write "<tr>"
    For Each theSubFolder In theFolder.SubFolders
        If ParentDir <> "" Then
            Response.Write "<td height='18'>&nbsp;&nbsp;<img src='Images/Folder/folderclosed.gif'><a href='" & strFileName & "&ParentDir=" & ParentDir & "/" & CurrentDir & "&CurrentDir=" & theSubFolder.name & "'>" & theSubFolder.name & "</a></td>"
        Else
            Response.Write "<td height='18'>&nbsp;&nbsp;<img src='Images/Folder/folderclosed.gif'><a href='" & strFileName & "&ParentDir=" & CurrentDir & "&CurrentDir=" & theSubFolder.name & "'>" & theSubFolder.name & "</a></td>"
        End If
        Response.Write "<td width='50' align=""right"">&nbsp;</td>"
        Response.Write "<td width='180'>&nbsp;文件夹</td>"
        Response.Write "<td width='140'>" & theSubFolder.DateLastModified & "</td>"

        Response.Write "<td width='30' align='center'><a href='" & strFileName & "&ParentDir=" & ParentDir & "/" & CurrentDir & "&CurrentDir=" & theSubFolder.name & "&Action=DelThisFolder' onclick=""return confirm('你真的要删除此文件夹及里面的文件吗!');"">删除</a>&nbsp;"
        Response.Write "</td></tr><tr>"
        
    Next
End Sub

Function FixJs(Str)
    If Str <> "" Then
        Str = Replace(Str, "&#39;", "'")
        Str = Replace(Str, "\", "\\")
        Str = Replace(Str, Chr(34), "\""")
        Str = Replace(Str, Chr(39), "\'")
        Str = Replace(Str, Chr(13), "\n")
        Str = Replace(Str, Chr(10), "\r")
        Str = Replace(Str, "'", "&#39;")
        Str = Replace(Str, """", "&quot;")
    End If
    FixJs = Str
End Function

Sub DelFiles()
    Dim whichfile, arrFileName, i
    whichfile = Trim(Request("FileName"))
    If whichfile = "" Then Exit Sub
    If InStr(whichfile, ",") > 0 Then
        arrFileName = Split(whichfile, ",")
        For i = 0 To UBound(arrFileName)
            whichfile = Server.MapPath(strPath & "/" & Trim(arrFileName(i)))
            If fso.FileExists(whichfile) Then fso.DeleteFile whichfile
        Next
    Else
        whichfile = Server.MapPath(strPath & "/" & whichfile)
        If fso.FileExists(whichfile) Then fso.DeleteFile whichfile
    End If
    Call main
End Sub

Sub DelCurrentDir()
    Set theFolder = fso.GetFolder(Server.MapPath(strPath))
    For Each theFile In theFolder.Files
        theFile.Delete True
    Next
    Call main
End Sub

Sub DelAll()
    Set theFolder = fso.GetFolder(Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir))
    For Each theSubFolder In theFolder.SubFolders
        theSubFolder.Delete True
    Next
    For Each theFile In theFolder.Files
        theFile.Delete True
    Next
    Call main
End Sub

Sub DelThisFolder()
    On Error Resume Next
    fso.DeleteFolder Server.MapPath(strPath)
    If Err.Number <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>删除文件（ReplaceDBContent.asp）失败，错误原因：" & Err.Description & "<br>请手动删除此文件。"
        Err.Clear
        Exit Sub
    Else
        If SearchKeyword <> "" Then
            Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & "&SearchKeyword=" & SearchKeyword & """>"
        Else
            Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & """>"
        End If
    End If
End Sub

Sub DoAddWatermark()
    Dim whichfile, arrFileName, i, bTemp
    whichfile = Trim(Request("FileName"))
    If whichfile = "" Then Exit Sub

    Dim PE_Thumb
    Set PE_Thumb = New CreateThumb
    If InStr(whichfile, ",") > 0 Then
        arrFileName = Split(whichfile, ",")
        For i = 0 To UBound(arrFileName)
            whichfile = strPath & "/" & Trim(arrFileName(i))
            bTemp = PE_Thumb.AddWatermark(whichfile)
        Next
    Else
        whichfile = strPath & "/" & whichfile
        bTemp = PE_Thumb.AddWatermark(whichfile)
    End If

    Set PE_Thumb = Nothing
    If SearchKeyword <> "" Then
        Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & "&SearchKeyword=" & SearchKeyword & """>"
    Else
        Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & """>"
    End If
End Sub

Function ShowJS_Tooltip()
    Response.Write "<div id=dHTMLADPreview style='Z-INDEX: 1000; LEFT: 0px; VISIBILITY: hidden; WIDTH: 10px; POSITION: absolute; TOP: 0px; HEIGHT: 10px'></DIV>"
    Response.Write "<SCRIPT language = 'JavaScript'>" & vbCrLf
    Response.Write "<!--" & vbCrLf
    Response.Write "var tipTimer;" & vbCrLf
    Response.Write "function locateObject(n, d)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "   var p,i,x;" & vbCrLf
    Response.Write "   if (!d) d=document;" & vbCrLf
    Response.Write "   if ((p=n.indexOf('?')) > 0 && parent.frames.length)" & vbCrLf
    Response.Write "   {d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}" & vbCrLf
    Response.Write "   if (!(x=d[n])&&d.all) x=d.all[n]; " & vbCrLf
    Response.Write "   for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n];" & vbCrLf
    Response.Write "   for (i=0;!x&&d.layers&&i<d.layers.length;i++) x=locateObject(n,d.layers[i].document); return x;" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function ShowADPreview(ADContent)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "  showTooltip('dHTMLADPreview',event, ADContent, '#ffffff','#000000','#000000','6000')" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function showTooltip(object, e, tipContent, backcolor, bordercolor, textcolor, displaytime)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "   window.clearTimeout(tipTimer)" & vbCrLf
    Response.Write "   if (document.all) {" & vbCrLf
    Response.Write "       locateObject(object).style.top=document.body.scrollTop+event.clientY+20" & vbCrLf
    Response.Write "       locateObject(object).innerHTML='<table style=""font-family:宋体; font-size: 9pt; border: '+bordercolor+'; border-style: solid; border-top-width: 1px; border-right-width: 1px; border-bottom-width: 1px; border-left-width: 1px; background-color: '+backcolor+'"" width=""10"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td nowrap><font style=""font-family:宋体; font-size: 9pt; color: '+textcolor+'"">'+unescape(tipContent)+'</font></td></tr></table> '" & vbCrLf
    Response.Write "       if ((e.x + locateObject(object).clientWidth) > (document.body.clientWidth + document.body.scrollLeft)) {" & vbCrLf
    Response.Write "           locateObject(object).style.left = (document.body.clientWidth + document.body.scrollLeft) - locateObject(object).clientWidth-10;" & vbCrLf
    Response.Write "       } else {" & vbCrLf
    Response.Write "           locateObject(object).style.left=document.body.scrollLeft+event.clientX" & vbCrLf
    Response.Write "       }" & vbCrLf
    Response.Write "       locateObject(object).style.visibility='visible';" & vbCrLf
    Response.Write "       tipTimer=window.setTimeout(""hideTooltip('""+object+""')"", displaytime);" & vbCrLf
    Response.Write "       return true;" & vbCrLf
    Response.Write "   } else if (document.layers) {" & vbCrLf
    Response.Write "       locateObject(object).document.write('<table width=""10"" border=""0"" cellspacing=""1"" cellpadding=""1""><tr bgcolor=""'+bordercolor+'""><td><table width=""10"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr bgcolor=""'+backcolor+'""><td nowrap><font style=""font-family:宋体; font-size: 9pt; color: '+textcolor+'"">'+unescape(tipContent)+'</font></td></tr></table></td></tr></table>')" & vbCrLf
    Response.Write "       locateObject(object).document.close()" & vbCrLf
    Response.Write "       locateObject(object).top=e.y+20" & vbCrLf
    Response.Write "       if ((e.x + locateObject(object).clip.width) > (window.pageXOffset + window.innerWidth)) {" & vbCrLf
    Response.Write "           locateObject(object).left = window.innerWidth - locateObject(object).clip.width-10;" & vbCrLf
    Response.Write "       } else {" & vbCrLf
    Response.Write "           locateObject(object).left=e.x;" & vbCrLf
    Response.Write "       }" & vbCrLf
    Response.Write "       locateObject(object).visibility='show';" & vbCrLf
    Response.Write "       tipTimer=window.setTimeout(""hideTooltip('""+object+""')"", displaytime);" & vbCrLf
    Response.Write "       return true;" & vbCrLf
    Response.Write "   } else {" & vbCrLf
    Response.Write "       return true;" & vbCrLf
    Response.Write "   }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function hideTooltip(object) {" & vbCrLf
    Response.Write "    if (document.all) {" & vbCrLf
    Response.Write "        locateObject(object).style.visibility = 'hidden';" & vbCrLf
    Response.Write "        locateObject(object).style.left = 1;" & vbCrLf
    Response.Write "        locateObject(object).style.top = 1;" & vbCrLf
    Response.Write "        return false;" & vbCrLf
    Response.Write "    } else {" & vbCrLf
    Response.Write "        if (document.layers) {" & vbCrLf
    Response.Write "            locateObject(object).visibility = 'hide';" & vbCrLf
    Response.Write "            locateObject(object).left = 1;" & vbCrLf
    Response.Write "            locateObject(object).top = 1;" & vbCrLf
    Response.Write "            return false;" & vbCrLf
    Response.Write "        } else {" & vbCrLf
    Response.Write "            return true;" & vbCrLf
    Response.Write "        }" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "//-->" & vbCrLf
    Response.Write "</SCRIPT>" & vbCrLf
End Function
Sub DoAddWatermark_CurrentDir()
    Dim whichfile, bTemp
    Dim PE_Thumb
    Set PE_Thumb = New CreateThumb
    Set theFolder = fso.GetFolder(Server.MapPath(strPath))
    For Each theFile In theFolder.Files
        whichfile = strPath & "/" & theFile.name
        bTemp = PE_Thumb.AddWatermark(whichfile)
    Next
    'Call main
    Set PE_Thumb = Nothing
    If SearchKeyword <> "" Then
        Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & "&SearchKeyword=" & SearchKeyword & """>"
    Else
        Response.Write "<meta http-equiv=""refresh"" content=0;url=""Admin_UploadFile_Main.asp?ChannelID=" & ChannelID & "&UploadDir=" & UploadDir & "&ParentDir=" & ParentDir & "&CurrentDir=" & CurrentDir & """>"
    End If
End Sub

Function showpage2(sfilename, totalnumber, MaxPerPage)
    Dim n, i, strTemp
    If totalnumber Mod MaxPerPage = 0 Then
        n = totalnumber \ MaxPerPage
    Else
        n = totalnumber \ MaxPerPage + 1
    End If
    If SearchKeyword <> "" Then
        strTemp = "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "&SearchKeyword=" & SearchKeyword & "'><tr><td>"
    Else
         strTemp = "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
    End If
    strTemp = "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
    strTemp = strTemp & "共 <b>" & totalnumber & "</b> 个文件，占用 <b>" & TotalSize & "</b> " & strTotalUnit & "&nbsp;&nbsp;&nbsp;"
    sfilename = JoinChar(sfilename)
    If CurrentPage < 2 Then
            strTemp = strTemp & "首页 上一页&nbsp;"
    Else
            strTemp = strTemp & "<a href='" & sfilename & "page=1'>首页</a>&nbsp;"
            strTemp = strTemp & "<a href='" & sfilename & "page=" & (CurrentPage - 1) & "'>上一页</a>&nbsp;"
    End If

    If n - CurrentPage < 1 Then
            strTemp = strTemp & "下一页 尾页"
    Else
            strTemp = strTemp & "<a href='" & sfilename & "page=" & (CurrentPage + 1) & "'>下一页</a>&nbsp;"
            strTemp = strTemp & "<a href='" & sfilename & "page=" & n & "'>尾页</a>"
    End If
    strTemp = strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp = strTemp & "&nbsp;<b>" & MaxPerPage & "</b>" & "个文件/页"
    strTemp = strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"
    For i = 1 To n
        strTemp = strTemp & "<option value='" & i & "'"
        If CInt(CurrentPage) = CInt(i) Then strTemp = strTemp & " selected "
        strTemp = strTemp & ">第" & i & "页</option>"
    Next
    strTemp = strTemp & "</select>"
    strTemp = strTemp & "</td></tr></form></table>"
    showpage2 = strTemp
End Function


Function CutStr(Str)
    If Len(Str) > 18 Then
        CutStr = "..." & Right(Str, 18)
    Else
        CutStr = Str
    End If
End Function
%>