clsfile.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：05/11/15
'描    述：VB工程文档自动产生器
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************
Option Explicit
Option Compare Text

Public Enum VBMemberFlags
    HideThisMember = &H40
    UserInterfaceDefault = &H200
    DontShowInPropertyBrowser = &H400
    DataBound = &H4
    BindsToDataField = &H20
    ShowInDataBindingsCollection = &H10
    PropertyCallsCanPropertyChange = &H8
    UpdateImmediate = &H1000
End Enum

Private mastrDeclarations() As String
Private mastrAPI() As String
Private mastrEvents() As String
Private mastrTypes() As String
Private mastrEnums() As String
Private mastrSubroutines() As String
Private mastrFunctions() As String
Private mastrProperties() As String
Private mastrSubDescr() As String
Private mastrFunctionDescr() As String
Private mastrPropDescr() As String
Private mastrSubAttrib() As String
Private mastrFunctionAttrib() As String
Private mastrPropAttrib() As String
Private mintNumSubroutines As Integer
Private mintNumFunctions As Integer
Private mintNumProperties As Integer
Private mintNumDeclarations As Integer
Private mintNumAPI As Integer
Private mintNumTypes As Integer
Private mintNumEvents As Integer
Private mintNumEnums As Integer
Private mintPropCount As Integer
Private mstrFile As String
Private mstrPath As String
Private mstrType As String
Private mstrMTSMode As String
Private mstrPersist As String
Private mstrTitle As String
Private mstrMajor As String
Private mstrMinor As String
Private mstrRevision As String
Private mblnIncludeNAVBar As Boolean
Private mstrNAVBar As String
Private mstrFileType As String
Private mstrStyleSheetFile As String
Private mlngNumCodeLines As Long
Private mlngNumCommentLines As Long
Private mstrHeaderComments As String
Private mblnIncludeDeclarations As Boolean
Private mblnIncludeAPI As Boolean
Private mblnIncludeTypes As Boolean
Private mblnIncludeSubs As Boolean
Private mblnIncludeEvents As Boolean
Private mblnIncludeReferences As Boolean
Private mblnIncludeCounts As Boolean
Private mblnIncludeAttributes As Boolean

Public Property Get CodeLineCount() As Long
CodeLineCount = mlngNumCodeLines
End Property

Public Property Get CommentLineCount() As Long
CommentLineCount = mlngNumCommentLines
End Property

Public Property Let Filename(ByVal pstrFile As String)
mstrFile = ExtractFile(pstrFile, mstrPath)
End Property
Public Property Get Filename() As String
Filename = mstrFile
End Property

Public Property Let FilePath(ByVal pstrPath As String)
mstrPath = pstrPath
End Property

Public Property Let FileType(ByVal pstrData As String)
mstrFileType = pstrData
End Property

Public Property Let IncludeAPI(ByVal pblnData As Boolean)
mblnIncludeAPI = pblnData
End Property

Public Property Let IncludeAttributes(ByVal pblnData As Boolean)
mblnIncludeAttributes = pblnData
End Property

Public Property Let IncludeCounts(ByVal pblnData As Boolean)
mblnIncludeCounts = pblnData
End Property

Public Property Let IncludeDeclarations(ByVal pblnData As Boolean)
mblnIncludeDeclarations = pblnData
End Property

Public Property Let IncludeEvents(ByVal pblnData As Boolean)
mblnIncludeEvents = pblnData
End Property

Public Property Let IncludeNAVBar(ByVal pblnData As Boolean)
mblnIncludeNAVBar = pblnData
End Property

Public Property Let IncludeReferences(ByVal pblnData As Boolean)
mblnIncludeReferences = pblnData
End Property

Public Property Let IncludeSubs(ByVal pblnData As Boolean)
mblnIncludeSubs = pblnData
End Property

Public Property Let IncludeTypes(ByVal pblnData As Boolean)
mblnIncludeTypes = pblnData
End Property

Public Property Let NAVBar(ByVal pstrData As String)
mstrNAVBar = pstrData
End Property

Public Property Let ProjectTitle(ByVal pstrData As String)
mstrTitle = pstrData
End Property

Public Property Let ProjectVersionMajor(ByVal pstrMajor As String)
mstrMajor = pstrMajor
End Property

Public Property Let ProjectVersionMinor(ByVal pstrMinor As String)
mstrMinor = pstrMinor
End Property

Public Property Let ProjectVersionRevision(ByVal pstrRevision As String)
mstrRevision = pstrRevision
End Property

Public Property Let StyleSheetFile(ByVal pstrData As String)
mstrStyleSheetFile = pstrData
End Property

Private Function AddHTMLHeader() As String

Dim strOutput As String

strOutput = ""
strOutput = strOutput & "<html>" & vbCrLf
strOutput = strOutput & "<head>" & vbCrLf
strOutput = strOutput & "<title>" & FileOnly(mstrFile) & "</title>" & vbCrLf
strOutput = strOutput & "</head>" & vbCrLf
strOutput = strOutput & "<link rel=""stylesheet"" type=""text/css"" href=""" & IIf(mstrStyleSheetFile <> "", FileOnly(mstrStyleSheetFile), "general.css") & """>" & vbCrLf
strOutput = strOutput & "<body>" & vbCrLf
strOutput = strOutput & "<b>工程名称: " & mstrTitle & "</b><br>版本: " & mstrMajor & "." & mstrMinor & "." & mstrRevision & "<br>" & vbCrLf
strOutput = strOutput & "日期: " & Format$(Now, "yyyy-mm-dd") & "<P>" & vbCrLf
strOutput = strOutput & "<b><h2>" & mstrFileType & ExtractName(mstrFile) & "</h2></b>" & vbCrLf

If InStr(mstrFile, ".cls") Then
    If mstrType <> "" Then
        strOutput = strOutput & "<b>Instancing: " & mstrType & "</b><br>" & vbCrLf
    End If
    If mstrMTSMode <> "" Then
        strOutput = strOutput & "<b>MTS Mode: " & mstrMTSMode & "</b><br>" & vbCrLf
    End If
    If mstrPersist <> "" Then
        strOutput = strOutput & "<b>Persistence: " & mstrPersist & "</b><br>" & vbCrLf
    End If
End If

strOutput = strOutput & "<p>" & vbCrLf

strOutput = strOutput & "<table class=""INTROPAGE"">" & vbCrLf
strOutput = strOutput & "<tr><td class=""INTROHEADER"">属性</td>" & _
    "<td class=""INTROHEADER"">子程序</td>" & _
    "<td class=""INTROHEADER"">函数</td></tr>" & vbCrLf
strOutput = strOutput & "<tr><td class=""INTROCELL"">" & mintPropCount & "</td>" & vbCrLf
strOutput = strOutput & "<td class=""INTROCELL"">" & mintNumSubroutines & "</td>" & vbCrLf
strOutput = strOutput & "<td class=""INTROCELL"">" & mintNumFunctions & "</td></tr></table><p>" & vbCrLf

If mblnIncludeCounts = True Then
    strOutput = strOutput & "代码行数: " & mlngNumCodeLines & "<br>" & vbCrLf
    strOutput = strOutput & "注释行数: " & mlngNumCommentLines & "<p>" & vbCrLf
End If

If mstrHeaderComments <> "" Then
    strOutput = strOutput & mstrHeaderComments & "<p>" & vbCrLf
End If

AddHTMLHeader = strOutput

End Function

Private Function AddHTMLBody() As String

Dim strOutput As String, i As Long, j As Long
Dim strExtra() As String

strOutput = ""

If mblnIncludeNAVBar = True Then
    strOutput = strOutput & "<table class=""LAYOUT""><tr>" & vbCrLf
    strOutput = strOutput & "<td class=""LAYOUTNAV"">" & vbCrLf
    strOutput = strOutput & mstrNAVBar
    strOutput = strOutput & "</td>" & vbCrLf
    strOutput = strOutput & "<td class=""LAYOUTCELL"">" & vbCrLf
End If

If mblnIncludeDeclarations = True Then
    If mintNumDeclarations > 0 Then
        strOutput = strOutput & "<h3>声明</h3><a href=''></a><p>" & vbCrLf
        strOutput = strOutput & "<ul><table class=""GENERAL""><tr><td class=""HEADERBAND"">名称</td>" & _
            "<td class=""HEADERBAND"">范围</td><td class=""HEADERBAND"">类型</td>" & _
            "<td class=""HEADERBAND"">描述</td></tr>" & vbCrLf
        For i = 0 To mintNumDeclarations - 1
            strOutput = strOutput & "<tr><td class=""CELL"">" & Split(mastrDeclarations(i), "|")(0) & "</td>"
            strOutput = strOutput & "<td class=""CELL"">" & Split(mastrDeclarations(i), "|")(1) & "</td>"
            strOutput = strOutput & "<td class=""CELL"">" & Split(mastrDeclarations(i), "|")(2) & "</td>"
            strOutput = strOutput & "<td class=""CELL"">" & Split(mastrDeclarations(i), "|")(3) & "</td></tr>"
        Next
        strOutput = strOutput & "</table><p>" & vbCrLf
    End If
    
    If mintNumTypes > 0 And mblnIncludeTypes = True Then
        If mintNumDeclarations = 0 Then
            strOutput = strOutput & "<h3>声明</h3><a href=''></a><p>" & vbCrLf
        End If
        For i = 0 To mintNumTypes - 1
            strOutput = strOutput & "<ul><b>类型: " & Split(mastrTypes(i), "|")(0) & " - " & Split(mastrTypes(i), "|")(1) & "</b></br>" & vbCrLf
            strExtra = Split(Split(mastrTypes(i), "|")(2), "~")
            strOutput = strOutput & "<ul><table class=""GENERAL""><tr><td class=""HEADERBAND"">Item Name</td>" & _
                "<td class=""HEADERBAND"">类型</td></tr>" & vbCrLf
            For j = 0 To UBound(strExtra)
                If strExtra(j) <> "" Then
                    strOutput = strOutput & "<tr><td class=""CELL"">" & Trim$(Split(strExtra(j), "^^^")(0)) & "</td>"
                    strOutput = strOutput & "<td class=""CELL"">" & Trim$(Split(strExtra(j), "^^^")(1)) & "</td></tr>"
                End If
            Next
            strOutput = strOutput & "</table></ul>" & vbCrLf
            strOutput = strOutput & "</ul><p>" & vbCrLf
        Next i
    End If
    
    If mintNumEnums > 0 And mblnIncludeTypes = True Then
        If mintNumTypes = 0 And mintNumDeclarations = 0 Then
            strOutput = strOutput & "<h3>声明</h3><a href=''></a><p>" & vbCrLf
        End If
        For i = 0 To mintNumEnums - 1
            strOutput = strOutput & "<ul><b>ENUM: " & Split(mastrEnums(i), "|")(0) & " - " & Split(mastrEnums(i), "|")(1) & "</b></br>" & vbCrLf
            strExtra = Split(Split(mastrEnums(i), "|")(2), "~")
            strOutput = strOutput & "<ul><table class=""GENERAL""><tr><td class=""HEADERBAND"">Item Name</td>" & _
                "<td class=""HEADERBAND"">Value</td></tr>" & vbCrLf
            For j = 0 To UBound(strExtra)
                If strExtra(j) <> "" Then
                    strOutput = strOutput & "<tr><td class=""CELL"">" & Trim$(Split(strExtra(j), "^^^")(0)) & "</td>"
                    strOutput = strOutput & "<td class=""CELL"">" & Trim$(Split(strExtra(j), "^^^")(1)) & "</td></tr>"
                End If
            Next
            strOutput = strOutput & "</table></ul>" & vbCrLf
            strOutput = strOutput & "</ul><p>" & vbCrLf
        Next i
    End If
    
    strOutput = strOutput & "</ul>" & vbCrLf
End If

If mintNumAPI > 0 And mblnIncludeAPI = True Then
    strOutput = strOutput & "<h3>API 声明</h3><a href=''></a><p>" & vbCrLf
    For i = 0 To mintNumAPI - 1
        strOutput = strOutput & ParseParamsHTML(mastrAPI(i), "")
    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

If mintNumEvents > 0 And mblnIncludeEvents = True Then
    strOutput = strOutput & "<h3>事件声明</h3><a href=''></a><p>" & vbCrLf
    For i = 0 To mintNumEvents - 1
        strOutput = strOutput & ParseParamsHTML(mastrEvents(i), "")
    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

If mintNumProperties > 0 And mblnIncludeSubs = True Then
    strOutput = strOutput & "<h3>属性</h3><a href=''></a><p>" & vbCrLf
    For i = 0 To mintNumProperties - 1
        strOutput = strOutput & ParseParamsHTML(mastrProperties(i), mastrPropDescr(i), mastrPropAttrib(i))
    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

If mintNumSubroutines > 0 And mblnIncludeSubs = True Then
    strOutput = strOutput & "<h3>子程序</h3><a href=''></a><p>" & vbCrLf
    For i = 0 To mintNumSubroutines - 1
        strOutput = strOutput & ParseParamsHTML(mastrSubroutines(i), mastrSubDescr(i), mastrSubAttrib(i))