view

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

Private objMatter
Private strReferer

Private Sub Class_Initialize()
End Sub

Private Sub Class_Terminate()
End Sub

Public Sub main()
    If MyIO.Env("REQUEST_METHOD") = "POST" Then
        Call doPost
    Else
        Call doGet
    End If
End Sub

Private Sub doGet()
    Dim intType
    Dim hexMatter
    intType = atoi(MyIO.QueryString("Type"))
    hexMatter = MyIO.QueryString("Matter")
    strReferer = MyIO.QueryString("Referer")
    If strReferer = "" Then strReferer = MyIO.Env("HTTP_REFERER")
    If strReferer = "" Then strReferer = ""
    Set objMatter = MyKernel.Command(T_MATTER)
    objMatter.CommandType = "SELECT"
    objMatter.Where = "MARK=" & atol("&H" & hexMatter)
    If Not objMatter.Exec Then
        MyRedirect strReferer
    ElseIf objMatter("Hidden") = 1 Then
        MyRedirect strReferer
    ElseIf Not ValidReferer() Then
        MyRedirect strReferer
    Else
        Call ExportMatter
    End If
    Set objMatter = Nothing
End Sub

Private Sub doPost()
End Sub

Private Function ValidReferer()
    Dim lngSID, lngCID, strRefer
    If MyKernel.Config("disable_link") = "1" Then
        ValidReferer = False
        lngSID = MyIO.QueryString("StapleId")
        lngCID = MyIO.QueryString("ContentId")
        strRefer = MyIO.Env("HTTP_REFERER")
        If lngSID = "" Then Exit Function
        If lngCID = "" Then Exit Function
        If strRefer = "" Then Exit Function
        ValidReferer = reg_test(str_format("http://$0$1content\.asp\?stapleid=$2&.*contentid=$3", Array(MyIO.Env("HTTP_HOST"), WM_Home, lngSID, lngCID)), "i", strRefer)
    Else
        ValidReferer = True
    End If
End Function

Private Sub ExportMatter()
    Dim strExt
    Dim strPath1, strPath2
    Dim intWidth, intHeight
    Dim blnDownload
    strExt = MyIO.QueryString("Ext")
    intWidth = atoi(MyIO.QueryString("Width"))
    intHeight = atoi(MyIO.QueryString("Height"))
    If intWidth < 1 Or intHeight < 1 Then
        If Not GetUAConfig(intWidth, intHeight) Then
            intWidth = objMatter("Width")
            intHeight = objMatter("Height")
        End If
    ElseIf intWidth > atoi(MyKernel.Config("KeepWidth")) Or intHeight > atoi(MyKernel.Config("KeepHeight")) Then
        intWidth = objMatter("Width")
        intHeight = objMatter("Height")
    End If
    blnDownload = False
    If objMatter("Category") = wmTypeImage Then
        strExt = objMatter("Ext")
        strPath1 = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), strExt, "")
        strPath2 = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), strExt, "D")
        If Not fso.FileExists(GetMapPath(strPath1)) Then
            'pass
        Else
            ImageResize3 GetMapPath(strPath1), GetMapPath(strPath2), intWidth, intHeight
        End If
    ElseIf UCase(strExt) = "JAD" Then
        strPath2 = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), "jad", "")
    Else
        strPath2 = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), objMatter("Ext"), "")
    End If
    If fso.FileExists(GetMapPath(strPath2)) Then
        If MyKernel.Config("DownloadType") <> "1" Then
            blnDownload = DownloadFile(GetMapPath(strPath2))
        Else
            blnDownload = True
        End If
    End If
    If blnDownload Then
        Call doLog("download", objMatter("SeqId"), strReferer)
        If MyKernel.Config("DownloadType") = "1" Then
            MyRedirect strPath2
        End If
    Else
        MyRedirect strReferer
    End If
End Sub

Private Function GetUAConfig(ByRef intWidth, ByRef intHeight)
    GetUAConfig = False
    Dim strUA
    strUA = MyIO.Env("HTTP_USER_AGENT")
    If strUA = "" Then Exit Function
    Dim rs, strSQL
    strSQL = MyKernel.DB.GetLimitSQL(1, "ImageWidth,ImageHeight", T_USER_AGENT, "MobileFace LIKE '%$(UserAgent)%'", "", "")
    strSQl = Replace(strSQL, "$(UserAgent)", SafeString(strUA))
    Set rs = MyKernel.DB.Exec2(strSQL)
    GetUAConfig = CBool(rs.EOF = False)
    If GetUAConfig Then
        ingWidth = atoi(rs("ImageWidth"))
        ingHeight = atoi(rs("ImageHeight"))
    End If
    rs.Close
    Set rs = Nothing
End Function

Private Function GetContentType(ByVal strExt)
    Dim xmlDoc, xmlNode
    Set xmlDoc = WM_GetCache("mime")
    Set xmlNode = XMLQuery(xmlDoc.documentElement, "mime[@name='" & XPathString(LCase(strExt)) & "']")
    If Not xmlNode Is Nothing Then
        GetContentType = XMLAttr(xmlNode, "type")
    Else
        GetContentType = "application/octet-stream"
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
End Function

Private Function DownloadFile(ByVal strPath)
    Dim objTemp, vtData
    Dim lngSize, lngBytes, lngChunk, lngRange, lngBreak
    Dim strRange, arr
    DownloadFile = False
    lngSize = GetFileSize(strPath)
    strRange = MyIO.Env("HTTP_RANGE")
    If strRange = "" Then
        lngRange = 0
        lngBreak = lngSize
    Else
        strRange = Mid(strRange, 7)
        arr = Split(strRange, "-")
        lngRange = CLng(arr(0))
        If IsNumeric(arr(1)) Then
            lngBreak = CLng(arr(1))
        Else
            lngBreak = lngSize
        End If
        If lngBreak > lngSize Then
            lngBreak = lngSize
        End If
    End If
    lngBytes = lngBreak - lngRange
    If lngBytes < 1 Then Exit Function
    If strRange <> "" Then Response.Status = "206 Partial Content"
    Response.ContentType = GetContentType(fso.GetExtensionName(strPath))
    Response.AddHeader "Content-Length", lngBytes
    Response.AddHeader "Content-Disposition", "attachment; filename=" & fso.GetFileName(strPath)
    If strRange <> "" Then
        If lngBreak = lngSize Then
            Response.AddHeader "Content-Range", "bytes " & lngRange & "-" & (lngBreak - 1) & "/" & lngSize
        Else
            Response.AddHeader "Content-Range", "bytes " & lngRange & "-" & lngBreak & "/" & lngSize
        End If
    End If
    Response.AddHeader "Last-Modified", FormatGDate(GetFileModify(strPath), 0)
    Response.AddHeader "Accept-Ranges", "bytes"
    lngChunk = KBYTE * 200
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeBinary
    objTemp.Open
    objTemp.LoadFromFile strPath
    objTemp.Position = lngRange
    Do While lngBytes > lngChunk And Response.IsClientConnected
        Response.BinaryWrite objTemp.Read(lngChunk)
        Response.Flush
        lngBytes = lngBytes - lngChunk
    Loop
    If lngBytes > 0 And Response.IsClientConnected Then
        Response.BinaryWrite objTemp.Read(lngBytes)
        Response.Flush
    End If
    objTemp.Close
    Set objTemp = Nothing
    DownloadFile = True
End Function