clsproject.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 = "clsProject"
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

Private mstrHelpTitle As String
Private mcForms As Collection
Private mcModules As Collection
Private mcClasses As Collection
Private mcUserControls As Collection
Private mcReferences As Collection
Private mcObjects As Collection
Private mcRelatedDocs As Collection
Private mcDesigners As Collection
Private mcUserDocuments As Collection
Private mcPropertyPages As Collection
Private mstrVBPPath As String
Private mstrVBPName As String
Private mstrOutputPath As String
Private mintNumForms As Integer
Private mintNumObjects As Integer
Private mintNumUserControls As Integer
Private mintNumReferences As Integer
Private mintNumModules As Integer
Private mintNumClasses As Integer
Private mintNumRelatedDocs As Integer
Private mintNumDesigners As Integer
Private mintNumUserDocuments As Integer
Private mintNumPropertyPages As Integer
Private mstrTitle As String
Private mstrMajor As String
Private mstrMinor As String
Private mstrRevision As String
Private mstrDescription As String
Private mstrVersionInfo(5) As String
Private mstrEXEName As String
Private mintOutputType As OutputType
Private mblnIncludeNAVBar As Boolean
Private mblnOutputStyleSheet As Boolean
Private mstrGroupItem As String
Private mstrStyleSheetFile As String
Private mlngNumCodeLines As Long
Private mlngNumCommentLines As Long
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 mblnIncludeForms As Boolean
Private mblnIncludeModules As Boolean
Private mblnIncludeClasses As Boolean
Private mblnIncludeUserControls As Boolean
Private mblnIncludeUserDocuments As Boolean
Private mblnIncludeDesigners As Boolean
Private mblnIncludeRelatedDocs As Boolean
Private mblnIncludePropertyPages As Boolean
Private mblnIncludeAttributes As Boolean
Private mblnIncludeVersionInfo As Boolean

Public Property Get Classes(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcClasses.Count Then Exit Property
Set Classes = mcClasses(plngItem + 1)
End Property

Public Property Get ClassesCount() As Long
ClassesCount = mintNumClasses
End Property

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

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

Public Property Get Designers(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcDesigners.Count Then Exit Property
Set Designers = mcDesigners(plngItem + 1)
End Property

Public Property Get DesignersCount() As Long
DesignersCount = mintNumDesigners
End Property

Public Property Let Filename(ByVal pstrFile As String)
mstrVBPName = ExtractFile(pstrFile, mstrVBPPath)
End Property
Public Property Get Filename() As String
Filename = mstrVBPName
End Property

Public Property Let FileOutputType(ByVal pintType As OutputType)
mintOutputType = pintType
End Property

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

Public Property Get Forms(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcForms.Count Then Exit Property
Set Forms = mcForms(plngItem + 1)
End Property

Public Property Get FormsCount() As Long
FormsCount = mintNumForms
End Property

Public Property Let GroupItem(ByVal pstrData As String)
mstrGroupItem = pstrData
End Property

Public Property Let HelpTitle(ByVal pstrData As String)
mstrHelpTitle = 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 IncludeClasses(ByVal pblnData As Boolean)
mblnIncludeClasses = 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 IncludeDesigners(ByVal pblnData As Boolean)
mblnIncludeDesigners = pblnData
End Property

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

Public Property Let IncludeForms(ByVal pblnData As Boolean)
mblnIncludeForms = pblnData
End Property

Public Property Let IncludeModules(ByVal pblnData As Boolean)
mblnIncludeModules = pblnData
End Property

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

Public Property Let IncludePropertyPages(ByVal pblnData As Boolean)
mblnIncludePropertyPages = pblnData
End Property

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

Public Property Let IncludeRelatedDocs(ByVal pblnData As Boolean)
mblnIncludeAPI = 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 IncludeVersionInfo(ByVal pblnData As Boolean)
mblnIncludeVersionInfo = pblnData
End Property

Public Property Let IncludeUserControls(ByVal pblnData As Boolean)
mblnIncludeUserControls = pblnData
End Property

Public Property Let IncludeUserDocuments(ByVal pblnData As Boolean)
mblnIncludeUserDocuments = pblnData
End Property

Public Property Get Modules(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcModules.Count Then Exit Property
Set Modules = mcModules(plngItem + 1)
End Property

Public Property Get ModulesCount() As Long
ModulesCount = mintNumModules
End Property

Public Property Let OutputPath(ByVal pstrData As String)
mstrOutputPath = pstrData
End Property

Public Property Let OutputStyleSheetFile(ByVal pblnData As Boolean)
mblnOutputStyleSheet = pblnData
End Property

Public Property Get PropertyPages(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcPropertyPages.Count Then Exit Property
Set PropertyPages = mcPropertyPages(plngItem + 1)
End Property

Public Property Get PropertyPagesCount() As Long
PropertyPagesCount = mintNumPropertyPages
End Property

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

Public Property Get UserControls(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcUserControls.Count Then Exit Property
Set UserControls = mcUserControls(plngItem + 1)
End Property

Public Property Get UserControlsCount() As Long
UserControlsCount = mintNumUserControls
End Property

Public Property Get UserDocuments(ByVal plngItem As Long) As clsFile
If (plngItem + 1) > mcUserDocuments.Count Then Exit Property
Set UserDocuments = mcUserDocuments(plngItem + 1)
End Property

Public Property Get UserDocumentsCount() As Long
UserDocumentsCount = mintNumUserDocuments
End Property

Private Function AddHTMLHeader() As String

Dim strOutput As String

strOutput = "<html>" & vbCrLf
strOutput = strOutput & "<head>" & vbCrLf
strOutput = strOutput & "<title>Project " & mstrTitle & "</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 & "<h1>工程名称: " & mstrTitle & "</h1><br>" & vbCrLf
strOutput = strOutput & "<b>EXE/DLL 名称: " & mstrEXEName & "</b><br>" & vbCrLf
strOutput = strOutput & "<b>版本: " & mstrMajor & "." & mstrMinor & "." & mstrRevision & "</b><br>" & vbCrLf
strOutput = strOutput & "<b>报表日期: " & Format$(Now, "yyyy-mm-dd") & "</b><P>" & vbCrLf
strOutput = strOutput & "<a href=#summary></a>" & vbCrLf
strOutput = strOutput & "<h3>工程摘要</h3>" & vbCrLf
strOutput = strOutput & "<table class=""INTROPAGE"">" & vbCrLf
strOutput = strOutput & "<tr>" & IIf(mintNumForms > 0, "<td class=""INTROHEADER"">窗体</td>", "") & _
    IIf(mintNumModules > 0, "<td class=""INTROHEADER"">模块</td>", "") & _
    IIf(mintNumClasses > 0, "<td class=""INTROHEADER"">类模块</td>", "") & _
    IIf(mintNumUserControls > 0, "<td class=""INTROHEADER"">用户控件</td>", "") & _
    IIf(mintNumPropertyPages > 0, "<td class=""INTROHEADER"">属性页</td>", "") & _
    IIf(mintNumDesigners > 0, "<td class=""INTROHEADER"">报表设计</td>", "") & _
    IIf(mintNumUserDocuments > 0, "<td class=""INTROHEADER"">用户文档</td>", "") & _
    IIf(mintNumObjects > 0, "<td class=""INTROHEADER"">控件</td>", "") & _
    IIf(mintNumReferences > 0, "<td class=""INTROHEADER"">参数</td>", "") & _
    IIf(mintNumRelatedDocs > 0, "<td class=""INTROHEADER"">有关文件</td>", "") & "</td>" & vbCrLf
strOutput = strOutput & "<tr>" & IIf(mintNumForms > 0, "<td class=""INTROCELL"">" & mintNumForms & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumModules > 0, "<td class=""INTROCELL"">" & mintNumModules & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumClasses > 0, "<td class=""INTROCELL"">" & mintNumClasses & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumUserControls > 0, "<td class=""INTROCELL"">" & mintNumUserControls & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumPropertyPages > 0, "<td class=""INTROCELL"">" & mintNumPropertyPages & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumDesigners > 0, "<td class=""INTROCELL"">" & mintNumDesigners & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumUserDocuments > 0, "<td class=""INTROCELL"">" & mintNumUserDocuments & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumObjects > 0, "<td class=""INTROCELL"">" & mintNumObjects & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumReferences > 0, "<td class=""INTROCELL"">" & mintNumReferences & "</td>", "") & vbCrLf
strOutput = strOutput & IIf(mintNumRelatedDocs > 0, "<td class=""INTROCELL"">" & mintNumRelatedDocs & "</td>", "") & "</tr></table><p>" & vbCrLf

If Trim$(mstrDescription) <> "" Then
    strOutput = strOutput & "工程描述: " & mstrDescription & "<p>" & vbCrLf
End If

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

If Trim$(Join(mstrVersionInfo, "")) <> "" And mblnIncludeVersionInfo = True Then
    strOutput = strOutput & "<b>产品信息</b><ul>" & vbCrLf
    If Trim$(mstrVersionInfo(0)) <> "" Then
        strOutput = strOutput & "注释: " & mstrVersionInfo(0) & "<br>" & vbCrLf
    End If
    If Trim$(mstrVersionInfo(1)) <> "" Then
        strOutput = strOutput & "公司名: " & mstrVersionInfo(1) & "<br>" & vbCrLf
    End If
    If Trim$(mstrVersionInfo(2)) <> "" Then
        strOutput = strOutput & "文件描述: " & mstrVersionInfo(2) & "<br>" & vbCrLf
    End If
    If Trim$(mstrVersionInfo(3)) <> "" Then
        strOutput = strOutput & "合法版权: " & mstrVersionInfo(3) & "<br>" & vbCrLf
    End If
    If Trim$(mstrVersionInfo(4)) <> "" Then
        strOutput = strOutput & "合法商标: " & mstrVersionInfo(4) & "<br>" & vbCrLf
    End If
    If Trim$(mstrVersionInfo(5)) <> "" Then
        strOutput = strOutput & "程序名称: " & mstrVersionInfo(5) & "<br>" & vbCrLf
    End If
    strOutput = strOutput & "</ul><p>" & vbCrLf
End If

AddHTMLHeader = strOutput

End Function

Private Function AddHTMLBody() As String