clsfile.cls

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

    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

If mintNumFunctions > 0 And mblnIncludeSubs = True Then
    strOutput = strOutput & "<h3>函数</h3><a href=''></a><p>" & vbCrLf
    For i = 0 To mintNumFunctions - 1
        strOutput = strOutput & ParseParamsHTML(mastrFunctions(i), mastrFunctionDescr(i), mastrFunctionAttrib(i))
    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

If mblnIncludeNAVBar = True Then
    strOutput = strOutput & "</td></tr>" & vbCrLf
End If

AddHTMLBody = strOutput

End Function

Private Function AddHTMLFooter() As String

AddHTMLFooter = "</body></html>" & vbCrLf

End Function

Public Sub GetHeaderComments()

Dim strComments As String, strData As String, intInFile As Integer
Dim strHold As String, blnAbort As Boolean
Dim blnFound As Boolean

If mstrFile = "" Then Exit Sub

intInFile = FreeFile
Open mstrFile For Input As #intInFile

' get to the start of the code section in the file
' loop through the file looking for "Attribute"
' once we come to the end of the attributes, we are at the code section
Do While Not EOF(intInFile)
    Line Input #intInFile, strData
    If Left$(strData, 10) = "attribute " Then
        blnFound = True
    End If
    If Left$(strData, 10) <> "attribute " And blnFound = True Then Exit Do
Loop

Do While Not EOF(intInFile)
    'Line Input #intInFile, strData
    strHold = ""
    Do While Right$(Trim(strData), 1) = "_"
        strData = strHold & strData
        strHold = strData
        Line Input #intInFile, strData
    Loop
    strData = strHold & strData
    strData = Replace(strData, " _", " ")
    strData = Replace(strData, "  ", " ")

    ' count the code/comment lines
    If Left$(Trim$(strData), 1) = "'" Then
        mlngNumCommentLines = mlngNumCommentLines + 1
    ElseIf Trim$(strData) <> "" Then
        If Left$(strData, 10) <> "attribute " Then
            mlngNumCodeLines = mlngNumCodeLines + 1
        End If
    End If

    If Left$(Trim$(strData), 1) = "'" And blnAbort = False Then
        strComments = strComments & Trim$(Mid$(strData, 2)) & "<br>" & vbCrLf
    Else
        blnAbort = True
    End If
    
    If strData = "" And strComments = "" And mlngNumCodeLines = 0 Then blnAbort = False
    
    Line Input #intInFile, strData
Loop

Close #intInFile

mstrHeaderComments = strComments

'' remove the sub/function/property declaration code lines from the count
'mlngNumCodeLines = mlngNumCodeLines - (mintNumFunctions * 2 + mintNumSubroutines * 2 + mintNumProperties * 2)

End Sub

Public Sub ParseForm()

Dim astrSort() As String
Dim intInFile As Integer
Dim strData As String, strConstVal As String, strInLine As String, strValue As String
Dim strSubData As String, lngPos As Long, blnConfirm As Boolean
Dim strHold As String
Dim blnSubDescrOn As Boolean, blnFunctionDescrOn As Boolean, blnPropDescrOn As Boolean
Dim i As Integer
Dim blnCreatable As Boolean, blnExposed As Boolean, blnGlobal As Boolean
Dim intMTSMode As Integer, intPersist As Integer
Dim intPropCount As Integer, strTemp As String, blnFirstItem As Boolean
Dim blnDoDec As Boolean, blnDoAPI As Boolean, blnDoType As Boolean, blnDoEnum As Boolean
Dim blnDoEvent As Boolean, lngEnumCount As Long
Dim strOriginal As String, strItemName As String, strItemBreakdown As String
Dim strSplitDec() As String
Dim strCommentHold As String

If mstrFile = "" Then Exit Sub

On Error GoTo Handler

ReDim mastrSubroutines(50)
ReDim mastrFunctions(50)
ReDim mastrProperties(50)
ReDim mastrSubDescr(50)
ReDim mastrFunctionDescr(50)
ReDim mastrPropDescr(50)
ReDim mastrSubAttrib(50)
ReDim mastrFunctionAttrib(50)
ReDim mastrPropAttrib(50)
ReDim mastrDeclarations(50)
ReDim mastrAPI(50)
ReDim mastrTypes(50)
ReDim mastrEnums(50)
ReDim mastrEvents(50)

intMTSMode = -1
intPersist = -1

If InStr(mstrFile, ".") = 0 Then mstrFile = mstrFile & ".frm"

intInFile = FreeFile
Open mstrFile For Input As #intInFile

Do While Not EOF(intInFile)
    Line Input #intInFile, strData
    strHold = ""
    
    Do While Right$(Trim(strData), 1) = "_"
        strData = strHold & strData
        strHold = strData
        Line Input #intInFile, strData
    Loop
    strData = strHold & strData
    strData = Replace(strData, " _", " ")
    strData = Replace(strData, "  ", " ")
    
    ' do sub/function/property parsing
    If Left$(Trim$(strData), 1) <> "'" Then
        If Left$(Trim$(strData), 10) = "attribute " And (blnSubDescrOn = True Or blnFunctionDescrOn = True Or blnPropDescrOn = True) Then
            If blnSubDescrOn = True Then
                mastrSubAttrib(mintNumSubroutines - 1) = mastrSubAttrib(mintNumSubroutines - 1) & _
                    IIf(mastrSubAttrib(mintNumSubroutines - 1) = "", "", "~") & _
                    ProcessAttributes(strData)
            End If
            If blnFunctionDescrOn = True Then
                mastrFunctionAttrib(mintNumFunctions - 1) = mastrFunctionAttrib(mintNumFunctions - 1) & _
                    IIf(mastrFunctionAttrib(mintNumFunctions - 1) = "", "", "~") & _
                    ProcessAttributes(strData)
            End If
            If blnPropDescrOn = True Then
                mastrPropAttrib(mintNumProperties - 1) = mastrPropAttrib(mintNumProperties - 1) & _
                    IIf(mastrPropAttrib(mintNumProperties - 1) = "", "", "~") & _
                    ProcessAttributes(strData)
            End If
            strData = ""
        Else
            blnSubDescrOn = False
            blnFunctionDescrOn = False
            blnPropDescrOn = False
        End If
        
        ' check for declaration at start of file
        ' ie. we haven't come to a sub/function/prop yet
        If blnFirstItem = False Then
            blnDoDec = False
            blnDoAPI = False
            blnDoType = False
            blnDoEnum = False
            blnDoEvent = False
            strOriginal = strData
            
            ' look for a scope part
            strHold = "(全局)"
            If Left$(strData, 7) = "global " Then
                ' remove the dim/public/private item
                strData = Mid$(strData, InStr(strData, " ") + 1)
                strHold = "Public (Global)"
                blnDoDec = True
            End If
            If Left$(Trim$(strData), 4) = "dim " Then
                ' remove the dim/public/private item
                strData = Mid$(strData, InStr(strData, " ") + 1)
                strHold = "(全局)"
                blnDoDec = True
            End If
            If Left$(Trim$(strData), 8) = "private " Then
                If InStr(strData, " property ") = 0 And _
                    (InStr(strData, " sub ") = 0 Or _
                    (InStr(strData, " sub ") > 0 And _
                    InStr(strData, " declare ") > 0)) And _
                    (InStr(strData, " function ") = 0 Or _
                    (InStr(strData, " function ") > 0 And _
                    InStr(strData, " declare ") > 0)) Then
                    
                    ' remove the dim/public/private item
                    strData = Mid$(strData, InStr(strData, " ") + 1)
                    strHold = "私有"
                    blnDoDec = True
                End If
            End If
            If Left$(Trim$(strData), 7) = "public " Then
                If InStr(strData, " property ") = 0 And _
                    (InStr(strData, " sub ") = 0 Or _
                    (InStr(strData, " sub ") > 0 And _
                    InStr(strData, " declare ") > 0)) And _
                    (InStr(strData, " function ") = 0 Or _
                    (InStr(strData, " function ") > 0 And _
                    InStr(strData, " declare ") > 0)) Then
                
                    ' remove the dim/public/private item
                    strData = Mid$(strData, InStr(strData, " ") + 1)
                    strHold = "全局"
                    blnDoDec = True
                End If
            End If
            
            ' decide which type of declaration we are doing
            If Left$(strData, 5) = "type " Then
                blnDoType = True
                blnDoDec = False
            End If
            If Left$(strData, 5) = "enum " Then
                blnDoEnum = True
                blnDoDec = False
            End If
            If Left$(strData, 8) = "declare " Then
                blnDoAPI = True
                blnDoDec = False
            End If
            If Left$(strData, 6) = "event " Then
                blnDoEvent = True
                blnDoDec = False
            End If
            If Left$(Trim$(strData), 6) = "const " Then
                blnDoDec = True
            End If
            
            strSubData = ""
            
            ' process API
            If blnDoAPI = True Then
                If UBound(mastrAPI) < mintNumAPI Then
                    ReDim Preserve mastrAPI(UBound(mastrAPI) + 1)
                End If
                mastrAPI(mintNumAPI) = Replace(strOriginal, "declare ", "", , , vbTextCompare)
                mintNumAPI = mintNumAPI + 1
                strData = ""
                strCommentHold = ""
            End If
            
            ' process events
            If blnDoEvent = True Then
                If UBound(mastrEvents) < mintNumEvents Then
                    ReDim Preserve mastrEvents(UBound(mastrEvents) + 1)
                End If
                mastrEvents(mintNumEvents) = Replace(strOriginal, "event ", "sub ", , , vbTextCompare)
                mintNumEvents = mintNumEvents + 1
                strData = ""
                strCommentHold = ""
            End If
            
            ' process types
            If blnDoType = True Then
                If UBound(mastrTypes) < mintNumTypes Then
                    ReDim Preserve mastrTypes(UBound(mastrTypes) + 1)
                End If
                ' remove inline comments
                If InStr(strData, "'") > 0 Then
                    strData = Left$(strData, InStr(strData, "'") - 1)
                End If
                strItemName = Mid$(strData, InStr(strData, " ") + 1)
                strItemBreakdown = ""
                Do While Not EOF(intInFile)
                    Line Input #intInFile, strData
                    If Left$(Trim$(strData), 1) <> "'" Then
                        ' remove inline comments
                        If InStr(strData, "'") > 0 Then
                            strData = Left$(strData, InStr(strData, "'") - 1)
                        End If
                        If Trim$(strData) = "end type" Then Exit Do
                        strItemBreakdown = strItemBreakdown & IIf(strItemBreakdown = "", "", "~") & Trim$(Replace(strData, " As ", "^^^"))
                    End If
                Loop
                mastrTypes(mintNumTypes) = strItemName & "|" & strHold & "|" & strItemBreakdown
                mintNumTypes = mintNumTypes + 1
                strData = ""
                strCommentHold = ""
            End If
            
            ' process enum
            If blnDoEnum = True Then
                If UBound(mastrEnums) < mintNumEnums Then
                    ReDim Preserve mastrEnums(UBound(mastrEnums) + 1)
                End If
                ' remove inline comments
                If InStr(strData, "'") > 0 Then
                    strData = Left$(strData, InStr(strData, "'") - 1)
                End If
                strItemName = Mid$(strData, InStr(strData, " ") + 1)
                strItemBreakdown = ""
                lngEnumCount = 0
                Do While Not EOF(intInFile)
                    Line Input #intInFile, strData
                    If Left$(Trim$(strData), 1) <> "'" Then
                        ' remove inline comments
                        If InStr(strData, "'") > 0 Then
                            strData = Left$(strData, InStr(strData, "'") - 1)