clsgroup.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 = "clsGroup"
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 mstrFile As String
Private mstrPath As String
Private mstrOutputPath As String
Private mintNumProjects As Integer
Private mcProjects As Collection
Private mblnIncludeNAVBar As Boolean
Private mintOutputType As OutputType
Private mblnOutputStyleSheet As Boolean
Private mstrHelpTitle 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 Let FileOutputType(ByVal pintType As OutputType)
mintOutputType = pintType
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 Let OutputPath(ByVal pstrData As String)
mstrOutputPath = pstrData
End Property

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

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

Private Function AddHTMLHeader() As String

Dim strOutput As String

strOutput = "<html>" & vbCrLf
strOutput = strOutput & "<head>" & vbCrLf
strOutput = strOutput & "<title>工程组: " & ExtractName(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 & "<h1>工程组: " & ExtractName(mstrFile) & "</h1><br>" & vbCrLf

AddHTMLHeader = strOutput

End Function

Private Function AddHTMLBody() As String

Dim cProject As clsProject
Dim strOutput As String

If mintNumProjects > 0 Then
    strOutput = strOutput & "<h3>工程</h3><a href=''></a><p>" & vbCrLf
    For Each cProject In mcProjects
        strOutput = strOutput & "<a href='" & FileOnly(ExtractFile(cProject.Filename, mstrPath)) & ".html'>" & ExtractName(cProject.Filename) & "</a> <BR> " & vbCrLf
    Next
    strOutput = strOutput & "<p>" & vbCrLf
End If

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

AddHTMLBody = strOutput

End Function

Private Function AddHTMLFooter() As String

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

End Function

Private Sub Class_Initialize()

Set mcProjects = New Collection

End Sub

Private Sub OutputHTMLHelpHHC()

Dim intFileNum As Integer
Dim strOutput As String
Dim cProject As clsProject
Dim i As Long

strOutput = strOutput & "<html>" & vbCrLf
strOutput = strOutput & "<!-- Sitemap 1.0 -->" & vbCrLf
strOutput = strOutput & "<object type=""text/site properties"">" & vbCrLf
strOutput = strOutput & "  <param name=""SiteType"" value=""toc"">" & vbCrLf
strOutput = strOutput & "  <param name=""Image Width"" value=""16"">" & vbCrLf
strOutput = strOutput & "  <param name=""Window Styles"" value=""0x800002"">" & vbCrLf
strOutput = strOutput & "  <param name=""ExWindow Styles"" value=""0x100"">" & vbCrLf
strOutput = strOutput & "</object>" & vbCrLf
strOutput = strOutput & "<ul>" & vbCrLf
strOutput = strOutput & "  <li><object type=""text/sitemap"">" & vbCrLf
strOutput = strOutput & "    <param name=""Name"" value=""" & ExtractName(mstrFile) & """>" & vbCrLf
strOutput = strOutput & "    <param name=""Local"" value=""" & FileOnly(mstrFile) & ".html"">" & vbCrLf
strOutput = strOutput & "  </object>" & vbCrLf
strOutput = strOutput & "  <ul>" & vbCrLf

For Each cProject In mcProjects
    strOutput = strOutput & "    <li><object type=""text/sitemap"">" & vbCrLf
    strOutput = strOutput & "      <param name=""Name"" value=""" & ExtractName(cProject.Filename) & """>" & vbCrLf
    strOutput = strOutput & "      <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.Filename, "")) & ".html"">" & vbCrLf
    strOutput = strOutput & "    </object>" & vbCrLf
    
    If cProject.FormsCount > 0 And mblnIncludeForms = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""Forms"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.FormsCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.Forms(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.Forms(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
    If cProject.ModulesCount > 0 And mblnIncludeModules = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""Modules"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.ModulesCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.Modules(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.Modules(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
    If cProject.ClassesCount > 0 And mblnIncludeClasses = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""Classes"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.ClassesCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.Classes(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.Classes(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
    
    If cProject.UserControlsCount > 0 And mblnIncludeUserControls = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""User Controls"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.UserControlsCount - 1