clsfile.cls

利用Visual Basic6.0制作的字符串搜索处理系统!推荐中

                        End If
                        If Trim$(strData) = "end enum" Then Exit Do
                        If InStr(strData, " = ") = 0 Then
                            ' looks after case where enum values are implied
                            strItemBreakdown = strItemBreakdown & IIf(strItemBreakdown = "", "", "~") & Trim$(strData) & "^^^" & CStr(lngEnumCount)
                            lngEnumCount = lngEnumCount + 1
                        Else
                            ' standard explictly defined enum values
                            ' set the enum count in case the next enum item does not have a value (ie implied)
                            strValue = Mid$(strData, InStr(strData, " = ") + 3)
                            ' remove any brackets
                            strValue = Replace(strValue, ")", "")
                            strValue = Replace(strValue, "(", "")
                            ' remove trailing & symbol
                            If Right$(strValue, 1) = "&" Then
                                strValue = Left$(strValue, Len(strValue) - 1)
                            End If
                            ' if the value is not a number then ignore
                            If IsNumber(strValue) = True Then
                                lngEnumCount = CLng(strValue) + 1
                            End If
                            strItemBreakdown = strItemBreakdown & IIf(strItemBreakdown = "", "", "~") & Trim$(Replace(strData, " = ", "^^^"))
                        End If
                    End If
                Loop
                mastrEnums(mintNumEnums) = strItemName & "|" & strHold & "|" & strItemBreakdown
                mintNumEnums = mintNumEnums + 1
                strData = ""
                strCommentHold = ""
            End If
            
            ' process standard declaration
            If blnDoDec = True Then
                ' make sure we're only dealing with 1 declaration at a time
                strSplitDec = SpecialSplit(strData, ",")
                For i = 0 To UBound(strSplitDec)
                    If UBound(mastrDeclarations) < mintNumDeclarations Then
                        ReDim Preserve mastrDeclarations(UBound(mastrDeclarations) + 1)
                    End If
                    ' save the inline comments
                    strInLine = ""
                    If InStr(strSplitDec(i), "'") > 0 Then
                        strInLine = Trim$(Mid$(strSplitDec(i), InStr(strSplitDec(i), "'") + 1))
                        strSplitDec(i) = Left$(strSplitDec(i), InStr(strSplitDec(i), "'") - 1)
                    End If
                    ' remove any "As New" bits
                    strSplitDec(i) = Replace(strSplitDec(i), " As New ", " ")
                    ' remove any "WithEvents" bits
                    strSplitDec(i) = Replace(strSplitDec(i), "WithEvents ", "")
                    ' make sure we have a space char at the end
                    If Right$(strSplitDec(i), 1) <> " " Then
                        strSplitDec(i) = strSplitDec(i) & " "
                    End If
                    ' look for a const value
                    strConstVal = ""
                    If InStr(strSplitDec(i), " = ") > 0 Then
                        strConstVal = Mid$(strSplitDec(i), InStr(strSplitDec(i), " = "), InStr(InStr(strSplitDec(i), " = ") + 4, strSplitDec(i), " ") _
                            - InStr(strSplitDec(i), " = "))
                    End If
                    ' look for const
                    strSubData = ""
                    If Left$(strSplitDec(i), 6) = "const " Then
                        strSubData = "Constant "
                        strSplitDec(i) = Mid$(strSplitDec(i), 7)
                    End If
                    ' get the variable type
                    If InStr(strSplitDec(i), " as ") > 0 Then
                        strSubData = strSubData & Mid$(strSplitDec(i), InStr(strSplitDec(i), " as ") + 4, _
                            InStr(InStr(strSplitDec(i), " as ") + 4, strSplitDec(i), " ") _
                            - (InStr(strSplitDec(i), " as ") + 4))
                    
                        mastrDeclarations(mintNumDeclarations) = Left$(strSplitDec(i), InStr(strSplitDec(i), " as ") - 1) & _
                            IIf(strConstVal <> "", " " & strConstVal, "") & "|" & strHold & "|" & _
                            strSubData & "|" & strInLine
                    Else
                        If strSubData <> "Constant " Then
                            strSubData = strSubData & "Variant"
                        End If
                        
                        If InStr(strSplitDec(i), " = ") > 0 Then
                            mastrDeclarations(mintNumDeclarations) = Left$(strSplitDec(i), InStr(strSplitDec(i), " = ") - 1) & _
                                IIf(strConstVal <> "", " " & strConstVal, "") & "|" & strHold & "|" & _
                                strSubData & "|" & strInLine
                        Else
                            mastrDeclarations(mintNumDeclarations) = strSplitDec(i) & _
                                IIf(strConstVal <> "", " " & strConstVal, "") & "|" & strHold & "|" & _
                                strSubData & "|" & strInLine
                        End If
                    End If
                    
                    mintNumDeclarations = mintNumDeclarations + 1
                    
                Next
                strData = ""
                strCommentHold = ""
            End If
        End If
        
        If strData <> "" Then
            ' check for a sub
            If (InStr(strData, " sub ") > 0 Or InStr(strData, "sub ") = 1) And InStr(LTrim$(strData), "declare sub ") = 0 Then
                blnConfirm = True
                If InStr(strData, "sub ") > 1 Then
                    strSubData = Left$(strData, InStr(strData, "sub ") - 1)
                    blnConfirm = CheckForValidInfo(strSubData)
                End If
                If blnConfirm = True Then
                    If UBound(mastrSubroutines) < mintNumSubroutines Then
                        ReDim Preserve mastrSubroutines(UBound(mastrSubroutines) + 1)
                        ReDim Preserve mastrSubDescr(UBound(mastrSubroutines))
                        ReDim Preserve mastrSubAttrib(UBound(mastrSubroutines))
                    End If
                    blnSubDescrOn = True
                    mastrSubroutines(mintNumSubroutines) = strData
                    mintNumSubroutines = mintNumSubroutines + 1
                    If strCommentHold <> "" Then
                        mastrSubDescr(mintNumSubroutines - 1) = strCommentHold
                        strCommentHold = ""
                    End If
                    blnFirstItem = True
                End If
            End If
            
            ' check for a function
            If (InStr(strData, " function ") > 0 Or InStr(strData, "function ") = 1) And InStr(LTrim$(strData), "declare function ") = 0 Then
                blnConfirm = True
                If InStr(strData, "function ") > 1 Then
                    strSubData = Left$(strData, InStr(strData, "function ") - 1)
                    blnConfirm = CheckForValidInfo(strSubData)
                End If
                If blnConfirm = True Then
                    If UBound(mastrFunctions) < mintNumFunctions Then
                        ReDim Preserve mastrFunctions(UBound(mastrFunctions) + 1)
                        ReDim Preserve mastrFunctionDescr(UBound(mastrFunctions))
                        ReDim Preserve mastrFunctionAttrib(UBound(mastrFunctions))
                    End If
                    blnFunctionDescrOn = True
                    mastrFunctions(mintNumFunctions) = strData
                    mintNumFunctions = mintNumFunctions + 1
                    If strCommentHold <> "" Then
                        mastrFunctionDescr(mintNumFunctions - 1) = strCommentHold
                        strCommentHold = ""
                    End If
                    blnFirstItem = True
                End If
            End If
            
            ' check for a property
            If (InStr(strData, " property ") > 0 Or InStr(strData, "property ") = 1) Then
                blnConfirm = True
                If InStr(strData, "property ") > 1 Then
                    strSubData = Left$(strData, InStr(strData, "property ") - 1)
                    blnConfirm = CheckForValidInfo(strSubData)
                End If
                If blnConfirm = True Then
                    If UBound(mastrProperties) < mintNumProperties Then
                        ReDim Preserve mastrProperties(UBound(mastrProperties) + 1)
                        ReDim Preserve mastrPropDescr(UBound(mastrProperties))
                        ReDim Preserve mastrPropAttrib(UBound(mastrProperties))
                    End If
                    blnPropDescrOn = True
                    mastrProperties(mintNumProperties) = strData
                    mintNumProperties = mintNumProperties + 1
                    If strCommentHold <> "" Then
                        mastrPropDescr(mintNumProperties - 1) = strCommentHold
                        strCommentHold = ""
                    End If
                    blnFirstItem = True
                End If
            End If
            
            If InStr(strData, "attribute vb_creatable") = 1 Then
                blnCreatable = IIf(Trim$(Mid$(strData, InStr(strData, "=") + 1)) = "false", False, True)
            End If
            If InStr(strData, "attribute vb_exposed") = 1 Then
                blnExposed = IIf(Trim$(Mid$(strData, InStr(strData, "=") + 1)) = "false", False, True)
            End If
            If InStr(strData, "attribute vb_globalnamespace") = 1 Then
                blnGlobal = IIf(Trim$(Mid$(strData, InStr(strData, "=") + 1)) = "false", False, True)
            End If
            If InStr(strData, " mtstransactionmode ") = 1 Then
                intMTSMode = Val(Mid$(strData, InStr(strData, "=") + 1))
            End If
            If InStr(strData, " persistable ") = 1 Then
                intPersist = Val(Mid$(strData, InStr(strData, "=") + 1))
            End If
        End If
        strCommentHold = ""
    Else
        If blnSubDescrOn = True Then
            mastrSubDescr(mintNumSubroutines - 1) = mastrSubDescr(mintNumSubroutines - 1) & "<br>" & Trim$(Mid$(Trim$(strData), 2))
        End If
        If blnFunctionDescrOn = True Then
            mastrFunctionDescr(mintNumFunctions - 1) = mastrFunctionDescr(mintNumFunctions - 1) & "<br>" & Trim$(Mid$(Trim$(strData), 2))
        End If
        If blnPropDescrOn = True Then
            mastrPropDescr(mintNumProperties - 1) = mastrPropDescr(mintNumProperties - 1) & "<br>" & Trim$(Mid$(Trim$(strData), 2))
        End If
        If blnSubDescrOn = False And blnFunctionDescrOn = False And blnPropDescrOn = False Then
            strCommentHold = strCommentHold & "<br>" & Trim$(Mid$(Trim$(strData), 2))
        End If
    End If
Loop

Close #intInFile

If blnCreatable = False And blnExposed = True Then mstrType = "Public Not Creatable"
If blnCreatable = False And blnExposed = False Then mstrType = "Private"
If blnCreatable = True And blnExposed = True Then
    If blnGlobal = True Then
        mstrType = "Global MultiUse"
    Else
        mstrType = "MultiUse"
    End If
End If

Select Case intMTSMode
    Case 0: mstrMTSMode = "Not an MTS object"
    Case 1: mstrMTSMode = "Does not support transactions"
    Case 2: mstrMTSMode = "Requires transactions"
    Case 3: mstrMTSMode = "Uses transactions"
    Case 4: mstrMTSMode = "Requires a new transaction"
End Select

Select Case intPersist
    Case 0: mstrPersist = "Not Persistable"
    Case 1: mstrPersist = "Persistable"
End Select

' sort the lists
ReDim astrSort(UBound(mastrSubroutines))
For i = 0 To UBound(mastrSubroutines)
    astrSort(i) = GetItemName(mastrSubroutines(i))
Next i
Call SortList(astrSort(), mastrSubroutines(), mastrSubDescr(), mastrSubAttrib())

ReDim astrSort(UBound(mastrFunctions))
For i = 0 To UBound(mastrFunctions)
    astrSort(i) = GetItemName(mastrFunctions(i))
Next i
Call SortList(astrSort(), mastrFunctions(), mastrFunctionDescr(), mastrFunctionAttrib())

ReDim astrSort(UBound(mastrProperties))
For i = 0 To UBound(mastrProperties)
    astrSort(i) = GetItemName(mastrProperties(i))
Next i
Call SortList(astrSort(), mastrProperties(), mastrPropDescr(), mastrPropAttrib())

ReDim astrSort(UBound(mastrDeclarations))
For i = 0 To UBound(mastrDeclarations)
    astrSort(i) = mastrDeclarations(i)
Next i
Call SortList(astrSort(), mastrDeclarations())

ReDim astrSort(UBound(mastrTypes))
For i = 0 To UBound(mastrTypes)
    astrSort(i) = mastrTypes(i)
Next i
Call SortList(astrSort(), mastrTypes())

ReDim astrSort(UBound(mastrEnums))
For i = 0 To UBound(mastrEnums)
    astrSort(i) = mastrEnums(i)
Next i
Call SortList(astrSort(), mastrEnums())

ReDim astrSort(UBound(mastrAPI))
For i = 0 To UBound(mastrAPI)
    astrSort(i) = GetAPIItemName(mastrAPI(i))
Next i
Call SortList(astrSort(), mastrAPI())

ReDim astrSort(UBound(mastrEvents))
For i = 0 To UBound(mastrEvents)
    astrSort(i) = GetItemName(mastrEvents(i))
Next i
Call SortList(astrSort(), mastrEvents())

' count the properties
For i = 0 To UBound(mastrProperties)
    If strTemp <> GetItemName(mastrProperties(i)) And mastrProperties(i) <> "" Then
        mintPropCount = mintPropCount + 1
        strTemp = GetItemName(mastrProperties(i))
    End If
Next i

Call GetHeaderComments

Exit Sub

Handler:
Err.Raise Err.Number, IIf(Left$(Err.Source, 3) <> "cls", "clsFile.ParseForm", Err.Source), Err.Description

End Sub

Private Function ParseParamsHTML(ByVal pstrData As String, Optional ByVal pstrDescr As String, Optional ByVal pstrAttrib As String) As String

Dim astrWhole() As String
Dim astrParts() As String
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim i As Integer, intStart As Integer
Dim intCount As Integer
Dim strExtra As String
Dim strType As String
Dim strOutput As String
Dim strLib As String
Dim strAlias As String
Dim strAttrib() As String

strOutput = ""
If pstrData = "" Then Exit Function

If Left$(Trim$(pstrData), 1) <> "'" Then
    
    ' remove inline comments
    If InStr(pstrData, "'") > 0 Then
        pstrData = Trim$(Left$(pstrData, InStr(pstrData, "'") - 1))