读取txt数据类随笔

Class PostData
    Private oDMStart, oDMEnd, oDMTag, oDMName, oDMSign, oDMFile, oDMType
    Private oSData

Private Sub Class_Initialize
    Dim CrLf, SeparatorPosition, SeparatorStr
    Dim MarkStr, MarkLen, MarkPosition, MarkId, MarkLast
    Dim SignId, SignLen, SignTag
‘创建Dictionary对象，可以调用Dictionary属性和方法
    Set oDMStart = CreateObject("Scripting.Dictionary")
    Set oDMEnd = CreateObject("Scripting.Dictionary")
    Set oDMTag = CreateObject("Scripting.Dictionary")
    Set oDMName = CreateObject("Scripting.Dictionary")
    Set oDMSign = CreateObject("Scripting.Dictionary")
    Set oDMFile = CreateObject("Scripting.Dictionary")

    Set oDMType = CreateObject("Scripting.Dictionary")

’创建2进制对象

    Set oSData = CreateObject("ADODB.Stream")
‘文件可读可写。

    oSData.Mode = 3

’二进制。

    oSData.Type = 1

‘打开对象源

    oSData.Open

’读取数据总数

    Call oSData.Write(Request.BinaryRead(Request.TotalBytes))
    If oSData.Size < 1 Then
        Response.End

    End If

‘ChrB(13)和ChrB(10)是代表换行符和回车符

    CrLf = ChrB(13) & ChrB(10)

    oSData.Position = 0

’oSData.EOS返回对象内数据是否为空

    Do While Not oSData.EOS

‘判断是是否为换行和回车

        If AscB(oSData.Read(1)) = 13 Then '13:AscB(ChrB(13))
            If AscB(oSData.Read(1)) = 10 Then '10:AscB(ChrB(10))
                Exit Do

            Else

’Position 指定或返加对像内数据的当前指针。

                oSData.Position = oSData.Position - 1
            End If
        End If
    Loop
    If oSData.EOS Then
        Response.End
    Else
        SeparatorPosition = oSData.Position - 2
    End If
    oSData.Position = 0
    SeparatorStr = CStr(oSData.Read(SeparatorPosition))

    MarkStr = SeparatorStr & CrLf & Unicode2Ansi("Content-Disposition: form-data; name=""")

‘返回二进制长度

    MarkLen = LenB(MarkStr)
    MarkPosition = 0
    MarkId = 0
    While MarkPosition >= 0
        MarkPosition = getPosition(oSData, MarkPosition, MarkStr)
        If MarkPosition >= 0 Then
            Call oDMStart.Add(MarkId, MarkPosition)
            MarkPosition = MarkPosition + MarkLen
            MarkId = MarkId + 1
        End If
    Wend
    MarkLast = oDMStart.Count - 1
    Call oDMStart.Add(MarkLast + 1, oSData.Size - 4 - SeparatorPosition) '4:LenB(CrLf & "--") SeparatorPosition:LenB(SeparatorStr)
    For MarkId = 0 To MarkLast
        oSData.Position = oDMStart.Item(MarkId) + MarkLen
        Do While Not oSData.EOS
            If AscB(oSData.Read(1)) = 34 Then '34:AscB("""")
                Exit Do
            End If
        Loop
        If oSData.EOS Then
            Response.End
        Else
            Call oDMEnd.Add(MarkId, oSData.Position - 1) '1:LenB("""")
            Select Case (AscB(oSData.Read(1)))
                Case 13 '13:AscB(ChrB(13))
                    Call oDMTag.Add(MarkId, 0) 'the element is form
                Case 59 '59:Asc(";")
                    Call oDMTag.Add(MarkId, 1) 'the element is file
                Case Else
                    Call oDMTag.Add(MarkId, -1) 'the element is unknow
            End Select
        End If
    Next
    Call oDMEnd.Add(MarkId, -1)
    Call oDMTag.Add(MarkId, -1)
    For MarkId = 0 To MarkLast
        oSData.Position = oDMStart.Item(MarkId) + MarkLen
        Call oDMName.Add(MarkId, CStr(oSData.Read(oDMEnd.Item(MarkId) - oDMStart.Item(MarkId) - MarkLen)))
    Next
    Call oDMName.Add(MarkId, "")
    SignLen = -1
    For MarkId = 0 To MarkLast
        SignTag = False
        For SignId = 0 To SignLen
            If CompareAnsi(oDMName.Item(MarkId), oDMSign.Item(SignId)) = True Then
                SignTag = True
                Exit For
            End If
        Next
        If SignTag = False Then
            SignLen = SignLen + 1
            Call oDMSign.Add(SignLen, oDMName.Item(MarkId))
        End If
    Next
    For MarkId = 0 To MarkLast
        If oDMTag.Item(MarkId) = 1 Then 'the element is file
            oSData.Position = oDMEnd.Item(MarkId) + 13 '13:LenB("""; filename=""")
            Do While Not oSData.EOS
                If AscB(oSData.Read(1)) = 34 Then '34:AscB("""")
                    Exit Do
                End If
            Loop
            If oSData.EOS Then
                Response.End
            Else
                Call oDMFile.Add(MarkId, oSData.Position - 1) '1:LenB("""")
                oSData.Position = oSData.Position + 16 '16:LenB(CrLf & "Content-Type: ")
                Do While Not oSData.EOS
                    If AscB(oSData.Read(1)) = 13 Then '13:AscB(ChrB(13))
                        If AscB(oSData.Read(1)) = 10 Then '10:AscB(ChrB(10))
                            Exit Do
                        Else
                            oSData.Position = oSData.Position - 1
                        End If
                    End If
                Loop
                If oSData.EOS Then
                    Response.End
                Else
                    Call oDMType.Add(MarkId, oSData.Position - 2) '2:LenB(CrLf)
                End If
            End If
        Else
            Call oDMFile.Add(MarkId, -1)
            Call oDMType.Add(MarkId, -1)
        End If
    Next
    Call oDMFile.Add(MarkId, -1)
    Call oDMType.Add(MarkId, -1)
End Sub

Private Sub Class_Terminate  
    oSData.Close
    Set oSData = Nothing
    Set oDMStart = Nothing
    Set oDMEnd = Nothing
    Set oDMTag = Nothing
    Set oDMName = Nothing
    Set oDMSign = Nothing
    Set oDMFile = Nothing
    Set oDMType = Nothing
End Sub

'get one element count, if elementname is "", return all element count
Public Function Count(ElementName)
    Dim tmpName, KeyId, KeyLast, NameCount
    
    If IsNull(ElementName) Then
        Count = oDMSign.Count
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        Count = oDMSign.Count
        Exit Function
    End If
    KeyLast = oDMName.Count - 1
    NameCount = 0
    For KeyId = 0 To KeyLast
        If CompareAnsi(oDMName.Item(KeyId), tmpName) = True Then
            NameCount = NameCount + 1
        End If
    Next
    Count = NameCount
End Function

'get form element name
Public Function Name(ElementId)    
    Dim tmpId
    
    If IsNull(ElementId) Then
        Name = ""
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        Name = ""
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId >= oDMSign.Count Or tmpId < 0 Then
        Name = ""
        Exit Function
    End If
    Name = Ansi2Unicode(oDMSign.Item(tmpId))
End Function

'get form element value. if the element is file, return file name, if the elementname is "", the elementid is all element id
Public Function Form(ElementName, ElementId)
    Dim tmpName, tmpId

    If IsNull(ElementName) Then
        Form = ""
        Exit Function
    End If
    If IsNull(ElementId) Then
        Form = ""
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        Form = ""
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        Form = ""
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId < 0 Then
        Form = ""
        Exit Function
    End If

    Form = Ansi2Unicode(getFormData(oSData, oDMStart, oDMEnd, oDMFile, oDMTag, oDMName, tmpName, tmpId))
End Function

'get file content data. if the element is form, return Null
Public Function File(ElementName, ElementId)
    Dim tmpName, tmpId

    If IsNull(ElementName) Then
        File = Null
        Exit Function
    End If
    If IsNull(ElementId) Then
        File = Null
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        File = Null
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        File = Null
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId < 0 Then
        File = Null
        Exit Function
    End If

    File = getFileData(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, tmpName, tmpId)
End Function

'get file content type. if the element is form, return ""
Public Function MIME(ElementName, ElementId)
    Dim tmpName, tmpId

    If IsNull(ElementName) Then
        MIME = ""
        Exit Function
    End If
    If IsNull(ElementId) Then
        MIME = ""
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        MIME = ""
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        MIME = ""
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId < 0 Then
        MIME = ""
        Exit Function
    End If

    MIME = Ansi2Unicode(getFileType(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, tmpName, tmpId))
End Function

'get file content size(unit is byte). if the element is form, return 0
Public Function Size(ElementName, ELementId)
    Dim tmpName, tmpId

    If IsNull(ElementName) Then
        Size = 0
        Exit Function
    End If
    If IsNull(ElementId) Then
        Size = 0
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        Size = 0
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        Size = 0
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId < 0 Then
        Size = 0
        Exit Function
    End If

    Size = getFileSize(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, tmpName, tmpId)
End Function

'save file content to disk. if the element is form, return -1
Public Function Save(ElementName, ElementId, FileName)
    Dim tmpName, tmpId

    If IsNull(ElementName) Then
        Save = -1
        Exit Function
    End If
    If IsNull(ElementId) Then
        Save = -1
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        Save = -1
        Exit Function
    End If
    tmpName = Unicode2Ansi(ElementName)
    If LenB(tmpName) = 0 Then
        Save = -1
        Exit Function
    End If
    tmpId = CInt(ElementId) - 1
    If tmpId < 0 Then
        Save = -1
        Exit Function
    End If

    Save = saveFileData(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, tmpName, tmpId, FileName)
End Function

'ansi string --> unicode string
Private Function Ansi2Unicode(AnsiStr)
    Dim ChrId, AnsiLen, AnsiChr, AnsiAsc

    Ansi2Unicode = ""    
    AnsiLen = LenB(AnsiStr)
    For ChrId = 1 To AnsiLen
        AnsiChr = MidB(AnsiStr, ChrId, 1)
        AnsiAsc = AscB(AnsiChr)
        If AnsiAsc > 127 Then
            ChrId = ChrId + 1
            Ansi2Unicode = Ansi2Unicode & Chr(AscW(MidB(AnsiStr, ChrId, 1) & AnsiChr))
        Else
            Ansi2Unicode = Ansi2Unicode & Chr(AnsiAsc)
        End If
    Next
End Function

'unicode string --> ansi string
Private Function Unicode2Ansi(UnicodeStr)
    Dim UnicodeLen, ChrId, UnicodeChr, UnicodeAsc
    Dim UnicodeHex, UnicodeHigh, UnicodeLow

    Unicode2Ansi = ""
    UnicodeLen = Len(UnicodeStr)
    For ChrId = 1 To UnicodeLen
        UnicodeChr = Mid(UnicodeStr, ChrId, 1)
        UnicodeAsc = Asc(UnicodeChr)
        If UnicodeAsc < 0 Then
            UnicodeAsc = UnicodeAsc + 65536
        End If
        If UnicodeAsc > 255 Then
            UnicodeHex = Hex(UnicodeAsc)
            UnicodeLow = Left(UnicodeHex, 2)
            UnicodeHigh = Right(UnicodeHex, 2)
            Unicode2Ansi = Unicode2Ansi & ChrB("&H" & UnicodeLow ) & ChrB("&H" & UnicodeHigh)
        Else
            Unicode2Ansi = Unicode2Ansi & ChrB(UnicodeAsc)
        End If
    Next
End Function

Private Function CompareAnsi(StrA, StrB)
    Dim StrLen, ChrId, tmpChrA, tmpChrB
    
    If IsNull(StrA) Then
        CompareAnsi = False
        Exit Function
    End If
    If IsNull(StrB) Then
        CompareAnsi = False
        Exit Function
    End If
    If LenB(StrA) <> LenB(StrB) Then
        CompareAnsi = False
        Exit Function
    End If
    
    StrLen = LenB(StrA)
    For ChrId = 1 To StrLen
        tmpChrA = AscB(MidB(StrA, ChrId, 1))
        tmpChrB = AscB(MidB(StrB, ChrId, 1))
        If tmpChrA >= 97 And tmpChrA <= 122 Then '97:Asc("a") 122:Asc("z")
            tmpChrA = tmpChrA - 32
        End If
        If tmpChrB >= 97 And tmpChrB <= 122 Then '97:Asc("a") 122:Asc("z")
            tmpChrB = tmpChrB - 32
        End If
        If tmpChrA <> tmpChrB Then
            CompareAnsi = False
            Exit Function
        End If
    Next
    If ChrId = StrLen + 1 Then
        CompareAnsi = True
    End If        
End Function

'Return :
'>=0 : find SearchStr and return the position
'-1 : not find SearchStr
'-2 : SearchStr is null
'-3 : StartPosition >= oSData.Size - LenB(SearchStr)
'-4 : SearchStr is empty
Private Function getPosition(oSData, StartPosition, SearchStr)
    Dim CurrentPosition, EndPosition, TempPosition
    Dim tmpChr, tmpStr, SearchLen, SameChr, SameLen
    Dim FindTag
    
    If IsNull(SearchStr) Then
        getPosition = -2
        Exit Function        
    End If
    SearchLen = LenB(SearchStr)
    If SearchLen = 0 Then
        getPosition = -4
        Exit Function
    End If
    EndPosition = oSData.Size - SearchLen
    If StartPosition >= EndPosition Then
        getPosition = -3
        Exit Function
    End If
    
    FindTag = False
    CurrentPosition = StartPosition
    tmpStr = ""
    For TempPosition = 1 To SearchLen
        tmpChr = AscB(MidB(SearchStr, TempPosition, 1))
        If tmpChr >= 97 And tmpChr <= 122 Then '97:Asc("a") 122:Asc("z")
            tmpChr = tmpChr - 32
        End If
        tmpStr = tmpStr & ChrB(tmpChr)
    Next
    While FindTag = False And CurrentPosition <= EndPosition
        oSData.Position = CurrentPosition
        For TempPosition = 1 To SearchLen
            tmpChr = AscB(oSData.Read(1))
            If tmpChr >= 97 And tmpChr <= 122 Then
                tmpChr = tmpChr - 32
            End If
            If tmpChr <> AscB(MidB(tmpStr, TempPosition, 1)) Then
                Exit For
            End If
        Next
        If TempPosition = SearchLen + 1 Then
            FindTag = True
        Else
            CurrentPosition = CurrentPosition + 1
        End If
    Wend
    If FindTag = True Then
        getPosition = CurrentPosition
    Else
        getPosition = -1
    End If
End Function

'get form element value
Private Function getFormData(oSData, oDMStart, oDMEnd, oDMFile, oDMTag, oDMName, ElementName, ElementId)
    Dim KeyId, KeyLast
    Dim NameCount
    
    If IsNull(ElementName) Then
        getPosition = ""
        Exit Function        
    End If
    If LenB(ElementName) = 0 Then
        getFormData = ""
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        getFormData = ""
        Exit Function
    End If
    If ElementId < 0 Then
        getFormData = ""
        Exit Function
    End If
    
    KeyLast = oDMStart.Count - 2 'last odmstart item is post data end mark
    NameCount = -1
    For KeyId = 0 To KeyLast
        If CompareAnsi(oDMName.Item(KeyId), ElementName) = True Then
            NameCount = NameCount + 1
            If NameCount = ElementId Then
                Select Case oDMTag.Item(KeyId)
                    Case 0 'the element is form
                        oSData.Position = oDMEnd.Item(KeyId) + 5 '5:LenB("""" + CrLF + CrLf)
                        If oDMStart.Item(KeyId + 1) - 2 > oDMEnd.Item(KeyId) + 5 Then
                            getFormData = CStr(oSData.Read(oDMStart.Item(KeyId + 1) - 2 - oDMEnd.Item(KeyId) - 5)) '2:LenB(CrLf)
                        Else
                            getFormData = ""
                        End If
                    Case 1 'the element is file
                        oSData.Position = oDMEnd.Item(KeyId) + 13 '13:LenB("""; filename=""")
                        If oDMFile.Item(KeyId) > oDMEnd.Item(KeyId) + 13 Then
                            getFormData = Cstr(oSData.Read(oDMFile.Item(KeyId) - oDMEnd.Item(KeyId) - 13))
                        Else
                            getFormData = ""
                        End If
                    Case Else
                        getFormData = ""
                End Select
                Exit Function
            End If
        End If
    Next
    If NameCount <> ElementId Then
        getFormData = ""
    End If
End Function

'get file element content type
Private Function getFileType(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId)
    Dim KeyId, KeyLast
    Dim NameCount
    
    If IsNull(ElementName) Then
        getFileType = ""
        Exit Function        
    End If
    If LenB(ElementName) = 0 Then
        getFileType = ""
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        getFileType = ""
        Exit Function
    End If
    If ElementId < 0 Then
        getFileType = ""
        Exit Function
    End If
    
    KeyLast = oDMStart.Count - 2 'last odmstart item is post data end mark
    NameCount = -1
    For KeyId = 0 To KeyLast
        If CompareAnsi(oDMName.Item(KeyId), ElementName) = True Then
            NameCount = NameCount + 1
            If NameCount = ElementId Then
                Select Case oDMTag.Item(KeyId)
                    Case 0 'the element is form
                        getFileType = ""
                    Case 1 'the element is file
                        oSData.Position = oDMFile.Item(KeyId) + 17 '17:LenB("""" & CrLf & "Content-Type: ")
                        If oDMType.Item(KeyId) > oDMFile.Item(KeyId) + 17 Then
                            getFileType = CStr(oSData.Read(oDMType.Item(KeyId) - oDMFile.Item(KeyId) - 17))
                        Else
                            getFileType = ""
                        End If
                    Case Else
                        getFileType = ""
                End Select
                Exit Function
            End If
        End If
    Next
    If NameCount <> ElementId Then
        getFileType = ""
    End If
End Function

'get file element content size
Private Function getFileSize(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId)
    Dim KeyId, KeyLast
    Dim NameCount
    
    If IsNull(ElementName) Then
        getFileSize = 0
        Exit Function        
    End If
    If LenB(ElementName) = 0 Then
        getFileSize = 0
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        getFileSize = 0
        Exit Function
    End If
    If ElementId < 0 Then
        getFileSize = 0
        Exit Function
    End If
    
    KeyLast = oDMStart.Count - 2 'last odmstart item is post data end mark
    NameCount = -1
    For KeyId = 0 To KeyLast
        If CompareAnsi(oDMName.Item(KeyId), ElementName) = True Then
            NameCount = NameCount + 1
            If NameCount = ElementId Then
                Select Case oDMTag.Item(KeyId)
                    Case 0 'the element is form
                        getFileSize = 0
                    Case 1 'the element is file
                        If oDMStart.Item(KeyId + 1) - 2 > oDMType.Item(KeyId) + 4 Then 'KeyId + 1:next element. 2:LenB(CrLf) 4:LenB(CrLf & CrLf)
                            getFileSize = CLng(oDMStart.Item(KeyId + 1) - 2 - oDMType.Item(KeyId) - 4)
                        Else
                            getFileSize = 0
                        End If
                    Case Else
                        getFileSize = 0
                End Select
                Exit Function
            End If
        End If
    Next
    If NameCount <> ElementId Then
        getFileSize = 0
    End If
End Function

'get file element content
Private Function getFileData(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId)
    Dim KeyId,KeyLast
    Dim NameCount
    
    If IsNull(ElementName) Then
        getFileData = Null
        Exit Function        
    End If
    If LenB(ElementName) = 0 Then
        getFileData = Null
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        getFileData = Null
        Exit Function
    End If
    If ElementId < 0 Then
        getFileData = Null
        Exit Function
    End If
    
    KeyLast = oDMStart.Count - 2 'last odmstart item is post data end mark
    NameCount = -1
    For KeyId = 0 To KeyLast
        If CompareAnsi(oDMName.Item(KeyId), ElementName) = True Then
            NameCount = NameCount + 1
            If NameCount = ElementId Then
                Select Case oDMTag.Item(KeyId)
                    Case 0 'the element is form
                        getFileData = Null
                    Case 1 'the element is file
                        If oDMStart.Item(KeyId + 1) - 2 > oDMType.Item(KeyId) + 4 Then 'KeyId + 1:next element. 2:LenB(CrLf) 4:LenB(CrLf & CrLf)
                            oSData.Position = oDMType.Item(KeyId) + 4
                            If oDMStart.Item(KeyId + 1) - 2 > oDMType.Item(KeyId) + 4 Then
                                getFileData = oSData.Read(oDMStart.Item(KeyId + 1) - 2 - oDMType.Item(KeyId) - 4)
                            Else
                                getFileData = Null
                            End If
                        Else
                            getFileData = Null
                        End If
                    Case Else
                        getFileData = Null
                End Select
                Exit Function
            End If
        End If
    Next
    If NameCount <> ElementId Then
        getFileData = Null
    End If
End Function

'save file element content to disk
'the FileNase is absoult path and the folder is exists
'0:save ok
'-1:the element not exists or file content is null
'-2:the filename is invalid.
Private Function saveFileData(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId, FileName)
    Dim iSData, FSO, SaveTag
    
    If IsNull(ElementName) Then
        saveFileData = -1
        Exit Function        
    End If
    If LenB(ElementName) = 0 Then
        saveFileData = -1
        Exit Function
    End If
    If Not IsNumeric(ElementId) Then
        saveFileData = -1
        Exit Function
    End If
    If ElementId < 0 Then
        saveFileData = -1
        Exit Function
    End If
    
    SaveTag = 0
    Set FSO = Server.CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(FSO.GetParentFolderName(FileName)) Then
        SaveTag = -2
    End If
    Set FSO = Nothing
    If SaveTag <> 0 Then
        saveFileData = SaveTag
        Exit Function
    End If
    Set iSData = Server.CreateObject("ADODB.Stream")
    iSData.Mode = 3
    iSData.Type = 1
    iSData.Open
    If getFileSize(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId) > 0 Then
        Call iSData.Write (getFileData(oSData, oDMStart, oDMFile, oDMType, oDMTag, oDMName, ElementName, ElementId))
        Call iSData.SaveToFile (FileName, 2)
        saveFileData = 0
    Else
        saveFileData = -1
    End If
    iSData.Close
    Set iSData = Nothing
End Function
End Class