io

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

Private clsItem(2)
Private objInput, objTemp
Private lngPostBytes, lngFileBytes
Private strAllow
Private blnParseQuery, blnParseForm
Private intParseState
Private vbCrLfB
Private clsProc

Private Sub Class_Initialize()
    Set clsItem(ITEM_QUERY) = Server.CreateObject(PROGID_HASH)
    Set clsItem(ITEM_FORM) = Server.CreateObject(PROGID_HASH)
    Set clsItem(ITEM_FILE) = Server.CreateObject(PROGID_HASH)
    lngPostBytes = MBYTE
    lngFileBytes = KBYTE * 200
    strAllow = "gif|png|jpg|bmp|swf|txt"
    blnParseQuery = False
    blnParseForm = False
    intParseState = -1
    vbCrLfb = ChrB(13) & ChrB(10)
    Set clsProc = Nothing
End Sub

Private Sub Class_Terminate()
    Call Flush
    Set clsProc = Nothing
    Set clsItem(ITEM_FILE) = Nothing
    Set clsItem(ITEM_FORM) = Nothing
    Set clsItem(ITEM_QUERY) = Nothing
End Sub

'Request Extension
Public Property Get PostBytes()
    PostBytes = lngPostBytes
End Property

Public Property Let PostBytes(ByVal lngValue)
    lngPostBytes = lngValue
End Property

Public Property Get FileBytes()
    FileBytes = lngFileBytes
End Property

Public Property Let FileBytes(ByVal lngValue)
    lngFileBytes = lngValue
End Property

Public Property Get Allow()
    Allow = strAllow
End Property

Public Property Let Allow(ByVal strValue)
    strAllow = strValue
End Property

Public Function Keys(ByVal intType)
    Select Case intType
    Case ITEM_QUERY
        If Not blnParseQuery Then
            blnParseQuery = True
            Call ParseCollection(Request.QueryString, ITEM_QUERY)
        End If
    Case ITEM_FORM, ITEM_FILE
        If Not blnParseForm Then
            Call Parse
        End If
    End Select
    Keys = clsItem(intType).Keys
End Function

Public Function Items(ByVal intType)
    Select Case intType
    Case ITEM_QUERY
        If Not blnParseQuery Then
            blnParseQuery = True
            Call ParseCollection(Request.QueryString, ITEM_QUERY)
        End If
    Case ITEM_FORM, ITEM_FILE
        If Not blnParseForm Then
            Call Parse
        End If
    End Select
    Items = clsItem(intType).Items
End Function

Public Property Get ParseState()
End Property

Public Function Env(ByVal strKey)
    Dim ret, strQS
    Select Case strKey
    Case "REQUEST_URI"
        strQS = Env("QUERY_STRING")
        ret = str_format("$0$1$2", Array(Env("PATH_INFO"), IIf(strQS = "", "", "?"), strQS))
    Case "REQUEST_URL"
        ret = str_format("http://$0$1", Array(Env("HTTP_HOST"), Env("REQUEST_URI")))
    Case Else
        ret = Request.ServerVariables(strKey)
    End Select
    Env = ret
End Function

Public Function QueryStringArray(ByVal strKey)
    If Not blnParseQuery Then
        blnParseQuery = True
        Call ParseCollection(Request.QueryString, ITEM_QUERY)
    End If
    QueryStringArray = clsItem(ITEM_QUERY)(strKey)
End Function

Public Function QueryString(ByVal strKey)
    Dim arr
    arr = QueryStringArray(strKey)
    If IsArray(arr) Then
        QueryString = Join(arr, ", ")
    End If
End Function

Public Function FormArray(ByVal strKey)
    If Not blnParseForm Then Call Parse
    FormArray = clsItem(ITEM_FORM)(strKey)
End Function

Public Function Form(ByVal strKey)
    Dim arr
    arr = FormArray(strKey)
    If IsArray(arr) Then
        Form = Join(arr, ", ")
    End If
End Function

Public Function File(ByVal strKey, ByVal intIndex)
    If Not blnParseForm Then Call Parse
    Dim ptr
    Dim i
    i = 0
    For Each ptr In clsItem(ITEM_FILE).Items
        If ptr.Name = strKey Then
            If i = intIndex Then
                Set File = ptr
                Exit Function
            End If
            i = i + 1
        End If
    Next
    Set File = Nothing
End Function

Public Function Parse()
    Dim lngSize, lngChunk
    Dim vtData, vtKey
    intParseState = 0
    If blnParseForm Then
        intParseState = 1
    ElseIf Request.TotalBytes = 0 Then
        intParseState = 2
    ElseIf Request.TotalBytes > lngPostBytes Then
        intParseState = 3
        Call ClearInput
    ElseIf Env("REQUEST_METHOD") <> "POST" Then
        intParseState = 4
    ElseIf InStr(Env("CONTENT_TYPE"), "application/x-www-form-urlencoded") > 0 Then
        Call ParseCollection(Request.Form, ITEM_FORM)
    ElseIf InStr(Env("CONTENT_TYPE"), "multipart/form-data") > 0 Then
        lngSize = Request.TotalBytes
        lngChunk = KBYTE * 200
        Set objInput = Server.CreateObject("ADODB.Stream")
        objInput.Type = adTypeBinary
        objInput.Open
        Do While lngSize > lngChunk
            objInput.Write Request.BinaryRead(lngChunk)
            lngSize = lngSize - lngChunk
        Loop
        If lngSize > 0 Then
            objInput.Write Request.BinaryRead(lngSize)
        End If
        objInput.Position = 0
        vtData = objInput.Read(adReadAll)
        vtKey = GetBoundary(vtData)
        If vtKey = "" Then
            intParseState = 5
        Else
            Call ParseBinary(vtData, vtKey)
        End If
        objInput.Close
        Set objInput = Nothing
    Else
        intParseState = 6
        Call ClearInput
    End If
    blnParseForm = True
    Parse = intParseState
End Function

Private Sub ClearInput()
    Dim lngSize, lngChunk, lngIndex
    lngSize = Request.TotalBytes
    lngChunk = KBYTE * 200
    lngIndex = 0
    Do While lngIndex < lngSize
        If lngIndex + lngChunk > lngSize Then
            lngChunk = lngSize - lngIndex
        End If
        Request.BinaryRead lngChunk
        lngIndex = lngIndex + lngChunk
    Loop
End Sub

Private Sub ParseCollection(objColt, ByVal intType)
    Dim key, obj
    Dim arr, i
    For Each key In objColt
        Set obj = objColt(key)
        ReDim arr(obj.Count - 1)
        For i = 1 To obj.Count
            arr(i - 1) = obj(i)
        Next
        clsItem(intType)(key) = arr
        Set obj = Nothing
    Next
End Sub

Private Sub SetItem(ByVal strName, ByVal strValue, objHash)
    Dim arr, i
    If objHash.Exists(strName) Then
        arr = objHash(strName)
        i = UBound(arr) + 1
        ReDim Preserve arr(i)
    Else
        i = 0
        ReDim arr(i)
    End If
    arr(i) = strValue
    objHash(strName) = arr
End Sub

Private Function GetBoundary(vtData)
    Dim strStart
    Dim pos1, pos2
    strStart = ChrB(45) & ChrB(45) ' Chr(45) = "-"
    pos1 = InStrB(vtData, strStart)
    If pos1 = 0 Then Exit Function
    pos1 = pos1 + LenB(strStart)
    pos2 = InStrB(pos1, vtData, vbCrLfB)
    If pos2 = 0 Then Exit Function
    GetBoundary = MidB(vtData, pos1, pos2 - pos1)
End Function

Private Sub ParseBinary(vtData, ByVal strKey)
    Dim intPos1, intPos2, intPos3
    Dim intKey
    Dim vbDblCrLfB
    Dim strMIME
    Dim strName, strFileName, lngSize, strValue, info
    Dim clsFile, i
    vbDblCrLfB = vbCrLfB & vbCrLfB
    intKey = LenB(strKey)
    intPos1 = InStrB(vtData, strKey)
    i = 0
    Set objTemp = Server.CreateObject("ADODB.Stream")
    Do While intPos1
        intPos1 = intPos1 + intKey + 2'2 = LenB(vbCrLfB)
        intPos2 = InStrB(intPos1, vtData, strKey)
        If intPos2 = 0 Then Exit Do
        intPos3 = InStrB(intPos1, vtData, vbDblCrLfB)
        If intPos3 = 0 Or intPos3 > intPos2 Then Exit Do
        intPos3 = intPos3 + 4'4 = LenB(vbDblCrLfB)
        strMIME = StreamToString(intPos1, intPos3 - intPos1)
        strName = GetMultiAttr(strMIME, " name=""", """")
        If strName = "" Then Exit Do
        strFileName = GetMultiAttr(strMIME, " filename=""", """")
        If IsEmpty(strFileName) Then
            lngSize = intPos2 - intPos3 - 4'4 = LenB("--") + LenB(vbCrLfB)
            If lngSize > 0 Then
                strValue = StreamToString(intPos3, lngSize)
            Else
                strValue = ""
            End If