<%@ Page language="VB" AutoEventWireup="false" aspCompat="True" validateRequest="False"%>
<!--#include file="config.aspx"-->
<%
If InitUpload() = True Then
    sAction = UCase(Trim(Request.QueryString("action")))
    Select Case sAction
    Case "LOCAL"
        Call DoCreateNewDir()
        Call DoLocal()
    Case "REMOTE"
        Call DoCreateNewDir()
        Call DoRemote()
    Case "SAVE"
        Call ShowForm()
        Call DoCreateNewDir()
        Call DoSave()
    Case Else
        Call ShowForm()
    End Select
End If
%>
<script language="vb" runat="server">
Dim sAction As String
Dim sType As String, sStyleName As String, sCusDir As String
Dim sAllowExt As String, nAllowSize As Integer, sUploadDir As String, nUploadObject As Integer, nAutoDir As Integer, sBaseUrl As String, sContentPath As String
Dim sFileExt As String, sOriginalFileName As String, sSaveFileName As String, sPathFileName As String, nFileNum As Integer
Dim nSLTFlag As Integer, nSLTMinSize As Integer, nSLTOkSize As Integer, nSYWZFlag As Integer, sSYText As String, sSYFontColor As String, nSYFontSize As Integer, sSYFontName As String, sSYPicPath As String, nSLTSYObject As Integer, sSLTSYExt As String, nSYWZMinWidth As Integer, sSYShadowColor As String, nSYShadowOffset As Integer, nSYWZMinHeight As Integer, nSYWZPosition As Integer, nSYWZTextWidth As Integer, nSYWZTextHeight As Integer, nSYWZPaddingH As Integer, nSYWZPaddingV As Integer, nSYTPFlag As Integer, nSYTPMinWidth As Integer, nSYTPMinHeight As Integer, nSYTPPosition As Integer, nSYTPPaddingH As Integer, nSYTPPaddingV As Integer, nSYTPImageWidth As Integer, nSYTPImageHeight As Integer, nSYTPOpacity As Single, nCusDirFlag As Integer
Sub ShowForm()
    Response.Write ("<HTML>" & _
    "<HEAD>" & _
    "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & _
    "<TITLE>eWebEditor</TITLE>" & _
    "<script language=""javascript"" src=""../dialog/dialog.js""></s" & "cript>" & _
    "<link href='../dialog/dialog.css' type='text/css' rel='stylesheet'>" & _
    "</head>" & _
    "<body class=upload>")
    Response.Write ("<form action='?action=save&type=" & sType & "&style=" & sStyleName & "&cusdir=" & sCusDir & "' method=post name=myform enctype='multipart/form-data'>" & _
    "<input type=file name=uploadfile size=1 style='width:100%' onchange='try{parent.doPreview();} catch(e){}'>" & _
    "</form>")
    Response.Write ("<script language=javascript>" & VBCrlf & _
    "" & VBCrlf & _
    "var sAllowExt = """ & sAllowExt & """;" & VBCrlf & _
    "" & VBCrlf & _
    "function CheckUploadForm() {" & VBCrlf & _
    "   if (!IsExt(document.myform.uploadfile.value,sAllowExt)){" & VBCrlf & _
    "       parent.UploadError('提示：\n\n请选择一个有效的文件，\n支持的格式有:'+sAllowExt);" & VBCrlf & _
    "       return false;" & VBCrlf & _
    "   }" & VBCrlf & _
    "   return true" & VBCrlf & _
    "}" & VBCrlf & _
    "" & VBCrlf & _
    "var oForm = document.myform ;" & VBCrlf & _
    "oForm.attachEvent(""onsubmit"", CheckUploadForm) ;" & VBCrlf & _
    "if (! oForm.submitUpload) oForm.submitUpload = new Array() ;" & VBCrlf & _
    "oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;" & VBCrlf & _
    "if (! oForm.originalSubmit) {" & VBCrlf & _
    "   oForm.originalSubmit = oForm.submit ;" & VBCrlf & _
    "   oForm.submit = function() {" & VBCrlf & _
    "       if (this.submitUpload) {" & VBCrlf & _
    "           for (var i = 0 ; i < this.submitUpload.length ; i++) {" & VBCrlf & _
    "               this.submitUpload[i]() ;" & VBCrlf & _
    "           }" & VBCrlf & _
    "       }" & VBCrlf & _
    "       this.originalSubmit() ;" & VBCrlf & _
    "   }" & VBCrlf & _
    "}" & VBCrlf & _
    "" & VBCrlf & _
    "try {" & VBCrlf & _
    "   parent.UploadLoaded();" & VBCrlf & _
    "}" & VBCrlf & _
    "catch(e){" & VBCrlf & _
    "}" & VBCrlf & _
    "" & VBCrlf & _
    "</s" & "cript>" & VBCrlf )
    Response.Write ("</body></html>")
End Sub
Sub DoSave()
    Dim b
    Select Case nUploadObject
    Case 1
        b = DoUpload_ASPUpload()
    Case 2
        b = DoUpload_SAFileUP()
    Case 3
        b = DoUpload_LyfUpload()
    Case Else
        b = DoUpload_ASPDotNet()
    End Select
    If b = False Then Exit Sub
    Dim s_SmallImageFile As String, s_SmallImagePathFile As String, s_SmallImageScript As String
    s_SmallImageFile = getSmallImageFile(sSaveFileName)
    s_SmallImagePathFile = ""
    s_SmallImageScript = ""
    If makeImageSLT(sUploadDir, sSaveFileName, s_SmallImageFile) = True Then
        Call makeImageSY(sUploadDir, s_SmallImageFile)
        Call makeImageSY(sUploadDir, sSaveFileName)
        s_SmallImagePathFile = sContentPath & s_SmallImageFile
        s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
    Else
        s_SmallImageFile = ""
        Call makeImageSY(sUploadDir, sSaveFileName)
    End If
    sPathFileName = sContentPath & sSaveFileName
    Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments;if((!obj.eWebEditor)||(!obj.eWebEditor_Temp_HTML)||(!obj.eWebEditor_UploadForm)){obj=parent.dialogArguments.dialogArguments;} try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
End Sub
Sub DoLocal()
    Dim b
    Select Case nUploadObject
    Case 1
        b = DoUpload_ASPUpload()
    Case 2
        b = DoUpload_SAFileUP()
    Case 3
        b = DoUpload_LyfUpload()
    Case Else
        b = DoUpload_ASPDotNet()
    End Select
    If b = False Then Exit Sub
    sPathFileName = sContentPath & sSaveFileName
    Response.Write(sPathFileName)
End Sub
Sub makeImageSY(s_Path As String, s_File As String)
    If nSYWZFlag = 0 And nSYTPFlag = 0 Then Exit Sub
    If isValidSLTSYExt(s_File) = False Then Exit Sub
    On Error Resume Next
    Dim nOriginalWidth, nOriginalHeight, posX, posY
    Select Case nSLTSYObject
    Case 0
        Dim image As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(s_Path & s_File))
        nOriginalWidth = image.Width
        nOriginalHeight = image.Height
        Dim bitmap As New System.Drawing.Bitmap(image.Width, image.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bitmap)
        g.DrawImage(image, 0, 0, image.Width, image.Height)
        If nSYWZFlag = 1 Then
            If nOriginalWidth<nSYWZMinWidth Or nOriginalHeight<nSYWZMinHeight Then Exit Sub
            posX = getSYPosX(nSYWZPosition, nOriginalWidth, nSYWZTextWidth+nSYShadowOffset, nSYWZPaddingH)
            posY = getSYPosY(nSYWZPosition, nOriginalHeight, nSYWZTextHeight+nSYShadowOffset, nSYWZPaddingV)
            Dim f As System.Drawing.Font, b As System.Drawing.Brush
            f = new System.Drawing.Font(sSYFontName, nSYFontSize, System.Drawing.GraphicsUnit.Pixel)
            b = new System.Drawing.SolidBrush(System.Drawing.ColorTranslator.FromHtml("#" & sSYShadowColor))
            g.DrawString(sSYText, f, b, posX+nSYShadowOffset, posY+nSYShadowOffset)
            b = new System.Drawing.SolidBrush(System.Drawing.ColorTranslator.FromHtml("#" & sSYFontColor))
            g.DrawString(sSYText, f, b, posX, posY)
        End If
        If nSYTPFlag = 1 Then
            If nOriginalWidth<nSYTPMinWidth Or nOriginalHeight<nSYTPMinHeight Then Exit Sub
            posX = getSYPosX(nSYTPPosition, nOriginalWidth, nSYTPImageWidth, nSYTPPaddingH)
            posY = getSYPosY(nSYTPPosition, nOriginalHeight, nSYTPImageHeight, nSYTPPaddingV)
            Dim cMatrix As New System.Drawing.Imaging.ColorMatrix(New Single()() {New Single() {1, 0, 0, 0, 0}, New Single() {0, 1, 0, 0, 0}, New Single() {0, 0, 1, 0, 0}, New Single() {0, 0, 0, nSYTPOpacity, 0}, New Single() {0, 0, 0, 0, 1}})
            Dim imageAttrib As New System.Drawing.Imaging.ImageAttributes
            imageAttrib.SetColorMatrix(cMatrix, System.Drawing.Imaging.ColorMatrixFlag.Default, System.Drawing.Imaging.ColorAdjustType.Bitmap)
            Dim copyImage As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(sSYPicPath))
            g.DrawImage(copyImage, new System.Drawing.Rectangle(posX, posY, copyImage.Width, copyImage.Height), 0, 0, copyImage.Width, copyImage.Height, System.Drawing.GraphicsUnit.Pixel, imageAttrib)
            copyImage.Dispose()
        End If
        g.Dispose()
        image.Dispose()
        bitmap.Save(Server.Mappath(s_Path & s_File))
        bitmap.Dispose()
    Case Else
        Dim oImage, oLogo
        If IsObjInstalled("Persits.Jpeg") = False Then Exit Sub
        oImage = Server.CreateObject("Persits.Jpeg")
        If nSYWZFlag = 1 Then
            oImage.Open (Server.Mappath(s_Path & s_File))
            nOriginalWidth = oImage.OriginalWidth
            nOriginalHeight = oImage.OriginalHeight
            If nOriginalWidth<nSYWZMinWidth Or nOriginalHeight<nSYWZMinHeight Then Exit Sub
            posX = getSYPosX(nSYWZPosition, nOriginalWidth, nSYWZTextWidth+nSYShadowOffset, nSYWZPaddingH)
            posY = getSYPosY(nSYWZPosition, nOriginalHeight, nSYWZTextHeight+nSYShadowOffset, nSYWZPaddingV)
            oImage.Canvas.Font.Color = CInt("&H" & sSYFontColor)
            oImage.Canvas.Font.Family = sSYFontName
            'oImage.Canvas.Font.Bold = True
            oImage.Canvas.Font.Size = nSYFontSize
            oImage.Canvas.Font.ShadowColor = CInt("&H" & sSYShadowColor)
            oImage.Canvas.Font.ShadowXOffset = nSYShadowOffset
            oImage.Canvas.Font.ShadowYOffset = nSYShadowOffset
            oImage.Canvas.Print (posX, posY, sSYText)
            oImage.Save (Server.Mappath(s_Path & s_File))
        End If
        If nSYTPFlag = 1 Then
            oImage.Open (Server.Mappath(s_Path & s_File))
            nOriginalWidth = oImage.OriginalWidth
            nOriginalHeight = oImage.OriginalHeight
            If nOriginalWidth<nSYTPMinWidth Or nOriginalHeight<nSYTPMinHeight Then Exit Sub
            posX = getSYPosX(nSYTPPosition, nOriginalWidth, nSYTPImageWidth, nSYTPPaddingH)
            posY = getSYPosY(nSYTPPosition, nOriginalHeight, nSYTPImageHeight, nSYTPPaddingV)
            oLogo = Server.CreateObject("Persits.Jpeg")
            oLogo.Open (Server.Mappath(sSYPicPath))
            oImage.DrawImage (posX, posY, oLogo, nSYTPOpacity, &HFFFFFF)
            oImage.Save (Server.Mappath(s_Path & s_File))
            oLogo = Nothing
        End If
        oImage = Nothing
    End Select
End Sub
Function getSYPosX(posFlag, originalW, syW, paddingH)
    Select Case posFlag
    Case 1, 2, 3
        getSYPosX = paddingH
    Case 4, 5, 6
        getSYPosX = (originalW - syW) \ 2
    Case 7, 8, 9
        getSYPosX = originalW - paddingH - syW
    End Select
End Function
Function getSYPosY(posFlag, originalH, syH, paddingV)
    Select Case posFlag
    Case 1, 4, 7
        getSYPosY = paddingV
    Case 2, 5, 8
        getSYPosY = (originalH - syH) \ 2
    Case 3, 6, 9
        getSYPosY = originalH - paddingV - syH
    End Select
End Function
Function makeImageSLT(s_Path As String, s_File As String, s_SmallFile As String)
    makeImageSLT = False
    If nSLTFlag = 0 Then Exit Function
    If isValidSLTSYExt(s_File) = False Then Exit Function
    On Error Resume Next
    Dim nOriginalWidth As Integer, nOriginalHeight As Integer, nWidth As Integer, nHeight As Integer
    Select Case nSLTSYObject
    Case 0
        Dim image As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(s_Path & s_File))
        nOriginalWidth = image.Width
        nOriginalHeight = image.Height
        If nOriginalWidth < nSLTMinSize And nOriginalHeight < nSLTMinSize Then Exit Function
        If nOriginalWidth > nOriginalHeight Then
            nWidth = nSLTOkSize
            nHeight = (nSLTOkSize / nOriginalWidth) * nOriginalHeight
        Else
            nHeight = nSLTOkSize
            nWidth = (nSLTOkSize / nOriginalHeight) * nOriginalWidth
        End If
        Dim bitmap As New System.Drawing.Bitmap(nWidth, nHeight, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bitmap)
        g.Clear(System.Drawing.Color.Transparent)
        g.DrawImage(image, new System.Drawing.Rectangle(0, 0, nWidth, nHeight))
        image.Dispose()
        Dim s_Ext As String, s_Mime As String
        s_Ext = LCase(Mid(s_File, InstrRev(s_File, ".")+1))
        Select Case s_Ext
        Case "png"
            s_Mime = "image/png"
        Case "tif", "tiff"
            s_Mime = "image/tiff"
        Case "bmp"
            s_Mime = "image/bmp"
        Case Else
            s_Mime = "image/jpeg"
        End Select
        Dim parameters As New System.Drawing.Imaging.EncoderParameters(1)
        parameters.Param(0) = new System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 90)
        bitmap.Save(Server.Mappath(s_Path & s_SmallFile), GetCodecInfo(s_Mime), parameters)
        parameters.Dispose()
        g.Dispose()
        bitmap.Dispose()
    Case 1
        Dim oImage
        If IsObjInstalled("Persits.Jpeg") = False Then Exit Function
        oImage = Server.CreateObject("Persits.Jpeg")
        oImage.Open (Server.Mappath(s_Path & s_File))
        nOriginalWidth = oImage.OriginalWidth
        nOriginalHeight = oImage.OriginalHeight
        If nOriginalWidth < nSLTMinSize And nOriginalHeight < nSLTMinSize Then Exit Function
        If nOriginalWidth > nOriginalHeight Then
            nWidth = nSLTOkSize
            nHeight = (nSLTOkSize / nOriginalWidth) * nOriginalHeight
        Else
            nHeight = nSLTOkSize
            nWidth = (nSLTOkSize / nOriginalHeight) * nOriginalWidth
        End If
        oImage.Width = nWidth
        oImage.Height = nHeight
        oImage.Save (Server.Mappath(s_Path & s_SmallFile))
        oImage = Nothing
    End Select
    makeImageSLT = True
End Function
Function GetCodecInfo(s_Mime As String)
    Dim CodecInfo() As System.Drawing.Imaging.ImageCodecInfo = System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
    Dim ici As System.Drawing.Imaging.ImageCodecInfo
    For Each ici In CodecInfo
        If ici.MimeType = s_Mime Then
            GetCodecInfo = ici
        End If
    Next
End Function
Function isValidSLTSYExt(s_File)
    Dim b, i, aExt, sExt
    b = False
    sExt = LCase(Mid(s_File, InstrRev(s_File, ".")+1))
    aExt = Split(LCase(sSLTSYExt), "|")
    For i = 0 To UBound(aExt)
        If aExt(i) = sExt Then
            b = True
            Exit For
        End If
    Next
    isValidSLTSYExt = b
End Function
Function getSmallImageFile(s_File)
    Dim n
    n = InstrRev(s_File, ".")
    getSmallImageFile = Left(s_File, n-1) & "_s." & Mid(s_File, n+1)
End Function
Sub DoRemote()
    Dim sContent
    sContent = Request.Form("eWebEditor_UploadText")
    If sAllowExt <> "" Then
        sContent = ReplaceRemoteUrl(sContent, sAllowExt)
    End If
    Response.Write ("<HTML><HEAD><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>" & _
        "<TITLE>eWebEditor</TITLE>" & _
        "<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
        "</body></html>")
    Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")
End Sub
Sub DoCreateNewDir()
    Dim a, i
    If nCusDirFlag = 1 Then
        a = Split(sCusDir, "/")
        For i = 0 To UBound(a)
            If a(i) <> "" Then
                Call CreateFolder(a(i))
            End If
        Next
    End If
    Dim s_DateDir
    Select Case nAutoDir
    Case 1
        s_DateDir = Left(FormatTime(Now(), 4), 4)
    Case 2
        s_DateDir = Left(FormatTime(Now(), 4), 6)
    Case 3
        s_DateDir = Left(FormatTime(Now(), 4), 8)
    Case Else
        s_DateDir = ""
    End Select
    If s_DateDir <> "" Then
        Call CreateFolder(s_DateDir)
    End If
End Sub
Sub CreateFolder(s_Folder)
    sUploadDir = sUploadDir & s_Folder & "/"
    sContentPath = sContentPath & s_Folder & "/"
    Dim oDir As System.IO.Directory
    If oDir.Exists(Server.Mappath(sUploadDir)) = False Then
        oDir.CreateDirectory(Server.Mappath(sUploadDir))
    End If
End Sub
Function DoUpload_LyfUpload()
    DoUpload_LyfUpload = False
    On Error Resume Next
    Dim oUpload, sResult, sOriginalFile
    oUpload = Server.CreateObject("LyfUpload.UploadFile")
    oUpload.ExtName = Replace(sAllowExt, "|", ",")
    oUpload.MaxSize = nAllowSize*1024
    sOriginalFile = oUpload.Request("originalfile")
    sOriginalFileName = Mid(sOriginalFile, InStrRev(sOriginalFile, "\") + 1)
    sFileExt = LCase(Mid(sOriginalFileName, InStrRev(sOriginalFileName, ".") + 1))
    If CheckValidExt(sFileExt) = False Then
        Exit Function
    End If
    sSaveFileName = GetRndFileName(sFileExt)
    sResult = oUpload.SaveFile("uploadfile", Server.Mappath(sUploadDir), True, sSaveFileName)
    Select Case sResult
    Case "0"
        Call OutScript("parent.UploadError('您上传的文件总大小超出了最大限制:" & nAllowSize & "KB')")
        Exit Function
    Case ""
        Call OutScript("parent.UploadError('请选择有效的上传文件！')")
        Exit Function
    Case "1"
        Call OutScript("parent.UploadError('提示：\n\n请选择一个有效的文件，\n支持的格式有:" & sAllowExt & "')")
        Exit Function
    End Select
    oUpload = Nothing
    DoUpload_LyfUpload = True
End Function
Function DoUpload_SAFileUp()
    DoUpload_SAFileUp = False
    On Error Resume Next
    Dim oFileUp
    oFileUp = Server.CreateObject("SoftArtisans.FileUp")
    'oFileUp.MaxBytes = nAllowSize*1024
    oFileUp.Path = Server.MapPath(sUploadDir)
    If oFileUp.Form("uploadfile").TotalBytes > nAllowSize*1024 Then
        Err.Clear
        Call OutScript("parent.UploadError('您上传的文件总大小超出了最大限制:" & nAllowSize & "KB')")
        Exit Function
    End If
    If oFileUp.Form("uploadfile").IsEmpty Then
        Call OutScript("parent.UploadError('请选择有效的上传文件！')")
        Exit Function
    End If
    Dim sShortFileName
    sShortFileName = oFileUp.Form("uploadfile").ShortFileName
    sFileExt = LCase(Mid(sShortFileName, InStrRev(sShortFileName, ".") + 1))
    If CheckValidExt(sFileExt) = False Then
        Exit Function
    End If
    sOriginalFileName = sShortFileName
    sSaveFileName = GetRndFileName(sFileExt)
    oFileUp.Form("uploadfile").SaveAs(Server.Mappath(sUploadDir & sSaveFileName))
    oFileUp = Nothing
    DoUpload_SAFileUp = True
End Function
Function DoUpload_ASPUpload()
    DoUpload_ASPUpload = False
    On Error Resume Next
    Dim oUpload, oFile, nCount
    oUpload = Server.CreateObject("Persits.Upload")
    oUpload.SetMaxSize(nAllowSize*1024, True)
    nCount = oUpload.Save
    If nCount < 1 Then
        Call OutScript("parent.UploadError('请选择有效的上传文件！')")
        Exit Function
    End If
    If Err.Number = 8 Then
        Err.Clear
        Call OutScript("parent.UploadError('您上传的文件总大小超出了最大限制:" & nAllowSize & "KB')")
        Exit Function
    End If
    oFile = oUpload.Files("uploadfile")
    sFileExt = LCase(Mid(oFile.Ext, 2))
    If CheckValidExt(sFileExt) = False Then
        Exit Function
    End If
    sOriginalFileName = oFile.FileName
    sSaveFileName = GetRndFileName(sFileExt)
    oFile.SaveAs (Server.Mappath(sUploadDir & sSaveFileName))
    oFile = Nothing
    oUpload = Nothing
    DoUpload_ASPUpload = True
End Function
Function DoUpload_ASPDotNet()
    DoUpload_ASPDotNet = False
    On Error Resume Next
    Dim oFiles As System.Web.HttpFileCollection = System.Web.HttpContext.Current.Request.Files
    Dim postedFile As System.Web.HttpPostedFile = oFiles(0)
    sOriginalFileName = System.IO.Path.GetFileName(postedFile.FileName)
    sFileExt = System.IO.Path.GetExtension(sOriginalFileName)
    sFileExt = LCase(Mid(sFileExt, 2))
    If CheckValidExt(sFileExt) = False Then
        Exit Function
    End If
    sSaveFileName = GetRndFileName(sFileExt)
    If PostedFile.ContentLength > nAllowSize*1024 Then
        Call OutScript("parent.UploadError('您上传的文件总大小超出了最大限制:" & nAllowSize & "KB')")
        Exit Function
    End If
    Dim str_Mappath
    str_Mappath = Server.Mappath(sUploadDir & sSaveFileName)
    sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
    If CheckValidExt(sFileExt) = False Then
        Exit Function
    End If
    postedFile.SaveAs(str_Mappath)
    oFiles = Nothing
    DoUpload_ASPDotNet = True
End Function
Function GetRndFileName(sExt)
    Dim sRnd
    Randomize
    sRnd = Int(900 * Rnd) + 100
    GetRndFileName = FormatTime(now, 5) & sRnd & "." & sExt
End Function
Sub OutScript(str)
    If sAction <> "LOCAL" Then
        Response.Write ("<script language=javascript>" & str & ";history.back()</s" & "cript>")
    End If
    Response.End
End Sub
Sub OutScriptNoBack(str)
    Response.Write ("<script language=javascript>" & str & "</s" & "cript>")
End Sub
Function CheckValidExt(sExt)
    Dim b, i, aExt
    b = False
    aExt = Split(sAllowExt, "|")
    For i = 0 To UBound(aExt)
        If LCase(aExt(i)) = sExt Then
            b = True
            Exit For
        End If
    Next
    If b = False Then
        Call OutScript("parent.UploadError('提示：\n\n请选择一个有效的文件，\n支持的格式有:" & sAllowExt & "')")
        Exit Function
    End If
    CheckValidExt = b
End Function
Function InitUpload()
    InitUpload = False
    sType = UCase(Trim(Request.QueryString("type")))
    sStyleName = Trim(Request.QueryString("style"))
    sCusDir = Trim(Request.QueryString("cusdir"))
    sCusDir = Replace(sCusDir, "\", "/")
    If Left(sCusDir, 1) = "/" Or Left(sCusDir, 1) = "." Or Right(sCusDir, 1) = "." Or InStr(sCusDir, "./") > 0 Or InStr(sCusDir, "/.") > 0 Or InStr(sCusDir, "//") > 0 Then
        sCusDir = ""
    End If
    Dim i, aStyleConfig, bValidStyle
    bValidStyle = False
    For i = 1 To Ubound(aStyle)
        aStyleConfig = Split(aStyle(i), "|||")
        If Lcase(sStyleName) = Lcase(aStyleConfig(0)) Then
            bValidStyle = True
            Exit For
        End If
    Next
    If bValidStyle = False Then
        Call OutScript("parent.UploadError('调用错误：请传入有效的样式名！')")
        Exit Function
    End If
    sBaseUrl = aStyleConfig(19)
    nUploadObject = CInt(aStyleConfig(20))
    nAutoDir = CInt(aStyleConfig(21))
    sUploadDir = aStyleConfig(3)
    If Left(sUploadDir, 1) <> "/" Then
        sUploadDir = "../" & sUploadDir
    End If
    Select Case sBaseUrl
    Case "0"
        sContentPath = aStyleConfig(23)
    Case "1"
        sContentPath = RelativePath2RootPath(sUploadDir)
    Case "2"
        sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
    End Select
    Select Case sType
    Case "REMOTE"
        sAllowExt = aStyleConfig(10)
        nAllowSize = CInt(aStyleConfig(15))
    Case "FILE"
        sAllowExt = aStyleConfig(6)
        nAllowSize = CInt(aStyleConfig(11))
    Case "MEDIA"
        sAllowExt = aStyleConfig(9)
        nAllowSize = CInt(aStyleConfig(14))
    Case "FLASH"
        sAllowExt = aStyleConfig(7)
        nAllowSize = CInt(aStyleConfig(12))
    Case "LOCAL"
        sAllowExt = aStyleConfig(44)
        nAllowSize = CInt(aStyleConfig(45))
    Case Else
        sAllowExt = aStyleConfig(8)
        nAllowSize = CInt(aStyleConfig(13))
    End Select
    nSLTFlag = CInt(aStyleConfig(29))
    nSLTMinSize = CInt(aStyleConfig(30))
    nSLTOkSize = CInt(aStyleConfig(31))
    nSYWZFlag = CInt(aStyleConfig(32))
    sSYText = aStyleConfig(33)
    sSYFontColor = aStyleConfig(34)
    nSYFontSize = CInt(aStyleConfig(35))
    sSYFontName = aStyleConfig(36)
    sSYPicPath = aStyleConfig(37)
    nSLTSYObject = CInt(aStyleConfig(38))
    sSLTSYExt = aStyleConfig(39)
    nSYWZMinWidth = CInt(aStyleConfig(40))
    sSYShadowColor = aStyleConfig(41)
    nSYShadowOffset = CInt(aStyleConfig(42))
    nSYWZMinHeight = CInt(aStyleConfig(46))
    nSYWZPosition = CInt(aStyleConfig(47))
    nSYWZTextWidth = CInt(aStyleConfig(48))
    nSYWZTextHeight = CInt(aStyleConfig(49))
    nSYWZPaddingH = CInt(aStyleConfig(50))
    nSYWZPaddingV = CInt(aStyleConfig(51))
    nSYTPFlag = CInt(aStyleConfig(52))
    nSYTPMinWidth = CInt(aStyleConfig(53))
    nSYTPMinHeight = CInt(aStyleConfig(54))
    nSYTPPosition = CInt(aStyleConfig(55))
    nSYTPPaddingH = CInt(aStyleConfig(56))
    nSYTPPaddingV = CInt(aStyleConfig(57))
    nSYTPImageWidth = CInt(aStyleConfig(58))
    nSYTPImageHeight = CInt(aStyleConfig(59))
    nSYTPOpacity = System.Convert.ToSingle(aStyleConfig(60))
    nCusDirFlag = CInt(aStyleConfig(61))
    InitUpload = True
End Function
Function RelativePath2RootPath(url)
    Dim sTempUrl
    sTempUrl = url
    If Left(sTempUrl, 1) = "/" Then
        RelativePath2RootPath = sTempUrl
        Exit Function
    End If
    Dim sWebEditorPath
    sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
    sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
    Do While Left(sTempUrl, 3) = "../"
        sTempUrl = Mid(sTempUrl, 4)
        sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
    Loop
    RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
End Function
Function RootPath2DomainPath(url)
    Dim sHost, sPort
    sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
    sPort = Request.ServerVariables("SERVER_PORT")
    If sPort <> "80" Then
        sHost = sHost & ":" & sPort
    End If
    RootPath2DomainPath = sHost & url
End Function
Function ReplaceRemoteUrl(sHTML, sExt)
    Dim s_Content
    s_Content = sHTML
    If IsObjInstalled("Microsoft.XMLHTTP") = False then
        ReplaceRemoteUrl = s_Content
        Exit Function
    End If
    Dim SaveFileName, SaveFileType
    Dim re As Regex
    Dim RemoteFile As MatchCollection
    Dim RemoteFileurl As Match
    Dim strSearchPattern As String
    strSearchPattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}([A-Za-z0-9]{1,5})\/(\S+\.(" & sExt & ")))"
    RemoteFile = re.Matches(s_Content, strSearchPattern, RegexOptions.IgnoreCase)
    Dim a_RemoteUrl(), n, i, bRepeat
    n = 0
    ' to no repeat array
    For Each RemoteFileurl in RemoteFile
        If n = 0 Then
            n = n + 1
            Redim a_RemoteUrl(n)
            a_RemoteUrl(n) = RemoteFileurl.Value.ToString
        Else
            bRepeat = False
            For i = 1 To UBound(a_RemoteUrl)
                If UCase(RemoteFileurl.Value.ToString) = UCase(a_RemoteUrl(i)) Then
                    bRepeat = True
                    Exit For
                End If
            Next
            If bRepeat = False Then
                n = n + 1
                Redim Preserve a_RemoteUrl(n)
                a_RemoteUrl(n) = RemoteFileurl.Value.ToString
            End If
        End If
    Next
    ' start replace
    nFileNum = 0
    For i = 1 To n
        SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
        SaveFileName = GetRndFileName(SaveFileType)
        If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
            nFileNum = nFileNum + 1
            If nFileNum > 1 Then
                sOriginalFileName = sOriginalFileName & "|"
                sSaveFileName = sSaveFileName & "|"
                sPathFileName = sPathFileName & "|"
            End If
            sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
            sSaveFileName = sSaveFileName & SaveFileName
            sPathFileName = sPathFileName & sContentPath & SaveFileName
            s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
        End If
    Next
    ReplaceRemoteUrl = s_Content
End Function
Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
    Dim Ads, Retrieval, GetRemoteData
    Dim bError
    bError = False
    SaveRemoteFile = False
    On Error Resume Next
    Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open ("Get", s_RemoteFileUrl, False, "", "")
        .Send
        GetRemoteData = .ResponseBody
    End With
    Retrieval = Nothing
    If GetRemoteData.length > nAllowSize*1024 Then
        bError = True
    Else
        Ads = Server.CreateObject("Adodb." & "Stream")
        With Ads
            .Type = 1
            .Open
            .Write (GetRemoteData)
            .SaveToFile (Server.MapPath(sUploadDir & s_LocalFileName), 2)
            .Cancel()
            .Close()
        End With
        Ads=nothing
    End If
    If Err.Number = 0 And bError = False Then
        SaveRemoteFile = True
    Else
        Err.Clear
    End If
End Function
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err.Number = 0
    Dim xTestObj
    xTestObj = Server.CreateObject(strClassString)
    If 0 = Err.Number Then IsObjInstalled = True
    xTestObj = Nothing
    Err.Number = 0
End Function
Function inHTML(str)
    Dim sTemp
    sTemp = str
    inHTML = ""
    If IsDBNull(sTemp) = True Then
        Exit Function
    End If
    sTemp = Replace(sTemp, "&", "&amp;")
    sTemp = Replace(sTemp, "<", "&lt;")
    sTemp = Replace(sTemp, ">", "&gt;")
    sTemp = Replace(sTemp, Chr(34), "&quot;")
    inHTML = sTemp
End Function
Function FormatTime(s_Time, n_Flag)
    Dim y, m, d, h, mi, s
    FormatTime = ""
    If IsDate(s_Time) = False Then Exit Function
    y = cstr(year(s_Time))
    m = cstr(month(s_Time))
    If len(m) = 1 Then m = "0" & m
    d = cstr(day(s_Time))
    If len(d) = 1 Then d = "0" & d
    h = cstr(hour(s_Time))
    If len(h) = 1 Then h = "0" & h
    mi = cstr(minute(s_Time))
    If len(mi) = 1 Then mi = "0" & mi
    s = cstr(second(s_Time))
    If len(s) = 1 Then s = "0" & s
    Select Case n_Flag
    Case 1
        FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
    Case 2
        FormatTime = y & "-" & m & "-" & d
    Case 3
        FormatTime = h & ":" & mi & ":" & s
    Case 4
        FormatTime = y & m & d
    Case 5
        FormatTime = y & m & d & h & mi & s
    End Select
End Function
</script>