clsgroup.cls

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

            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.UserControls(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.UserControls(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
    If cProject.PropertyPagesCount > 0 And mblnIncludePropertyPages = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""Property Pages"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.PropertyPagesCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.PropertyPages(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.PropertyPages(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
    If cProject.DesignersCount > 0 And mblnIncludeDesigners = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""Designers"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.DesignersCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.Designers(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.Designers(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
    If cProject.UserDocumentsCount > 0 And mblnIncludeUserDocuments = True Then
        strOutput = strOutput & "    <ul>" & vbCrLf
        strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "        <param name=""Name"" value=""User Documents"">" & vbCrLf
        strOutput = strOutput & "      </object>" & vbCrLf
        strOutput = strOutput & "      <ul>" & vbCrLf
        For i = 0 To cProject.UserDocumentsCount - 1
            strOutput = strOutput & "      <li><object type=""text/sitemap"">" & vbCrLf
            strOutput = strOutput & "        <param name=""Name"" value=""" & FileOnly(ExtractFile(cProject.UserDocuments(i).Filename, "")) & """>" & vbCrLf
            strOutput = strOutput & "        <param name=""Local"" value=""" & FileOnly(ExtractFile(cProject.UserDocuments(i).Filename, "")) & ".html"">" & vbCrLf
            strOutput = strOutput & "      </object>" & vbCrLf
        Next i
        strOutput = strOutput & "      </ul>" & vbCrLf
        strOutput = strOutput & "    </ul>" & vbCrLf
    End If
        
Next
strOutput = strOutput & "    </ul>" & vbCrLf
strOutput = strOutput & "</ul>" & vbCrLf
strOutput = strOutput & "</html>" & vbCrLf

intFileNum = FreeFile

Open mstrOutputPath & IIf(Right$(mstrOutputPath, 1) = "\", "", "\") & ExtractName(mstrFile) & ".HHC" For Output As #intFileNum
Print #intFileNum, strOutput
Close #intFileNum

End Sub

Private Sub OutputHTMLHelpHHP()

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

strOutput = strOutput & "[OPTIONS]" & vbCrLf
strOutput = strOutput & "Compiled File=" & ExtractName(mstrFile) & ".chm" & vbCrLf
strOutput = strOutput & "Title=" & mstrHelpTitle & vbCrLf
strOutput = strOutput & "Contents File=" & ExtractName(mstrFile) & ".hhc" & vbCrLf
strOutput = strOutput & "Index File=" & vbCrLf
strOutput = strOutput & "Default topic=" & FileOnly(ExtractFile(mstrFile, "")) & ".html" & vbCrLf
strOutput = strOutput & "Default Window=NewWindow" & vbCrLf
strOutput = strOutput & "Error log file=" & vbCrLf
strOutput = strOutput & "Display compile progress=No" & vbCrLf
strOutput = strOutput & "Display compile notes=No" & vbCrLf
strOutput = strOutput & "Full-text search=Yes" & vbCrLf
strOutput = strOutput & "Binary Index=No" & vbCrLf
strOutput = strOutput & "Auto Index=No" & vbCrLf
strOutput = strOutput & "Enhanced decompilation=No" & vbCrLf
strOutput = strOutput & "Binary TOC=No" & vbCrLf
strOutput = strOutput & "Flat=No" & vbCrLf
strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[WINDOWS]" & vbCrLf
strOutput = strOutput & "NewWindow=""" & mstrHelpTitle & """,""" & ExtractName(mstrFile) & ".hhc"","""","""","""",,,,,0x420,0,0x200e,[0,0,500,400],0x0,0x0,,0,0,0" & vbCrLf
strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[FILES]" & vbCrLf
strOutput = strOutput & FileOnly(ExtractFile(mstrFile, "")) & ".html" & vbCrLf

For Each cProject In mcProjects
    strOutput = strOutput & FileOnly(ExtractFile(cProject.Filename, "")) & ".html" & vbCrLf
    
    If cProject.FormsCount > 0 And mblnIncludeForms = True Then
        For i = 0 To cProject.FormsCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.Forms(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.ModulesCount > 0 And mblnIncludeModules = True Then
        For i = 0 To cProject.ModulesCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.Modules(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.ClassesCount > 0 And mblnIncludeClasses = True Then
        For i = 0 To cProject.ClassesCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.Classes(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.UserControlsCount > 0 And mblnIncludeUserControls = True Then
        For i = 0 To cProject.UserControlsCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.UserControls(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.PropertyPagesCount > 0 And mblnIncludePropertyPages = True Then
        For i = 0 To cProject.PropertyPagesCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.PropertyPages(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.DesignersCount > 0 And mblnIncludeDesigners = True Then
        For i = 0 To cProject.DesignersCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.Designers(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
    If cProject.UserDocumentsCount > 0 And mblnIncludeUserDocuments = True Then
        For i = 0 To cProject.UserDocumentsCount - 1
            strOutput = strOutput & FileOnly(ExtractFile(cProject.UserDocuments(i).Filename, "")) & ".html" & vbCrLf
        Next
    End If
Next

strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[ALIAS]" & vbCrLf
strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[MAP]" & vbCrLf
strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[TEXT POPUPS]" & vbCrLf

intFileNum = FreeFile

Open mstrOutputPath & IIf(Right$(mstrOutputPath, 1) = "\", "", "\") & ExtractName(mstrFile) & ".HHP" For Output As #intFileNum
Print #intFileNum, strOutput
Close #intFileNum

End Sub

Public Sub ParseGroup(ByVal pstrFile As String)

Dim intFileNum As Integer
Dim strLine As String
Dim blnOK As Boolean
Dim cProject As clsProject
Dim astrSort() As String
Dim astrProjects() As String
Dim i As Long

ReDim astrProjects(0)

On Error GoTo Handler

intFileNum = FreeFile

mstrFile = pstrFile
mstrPath = Left$(mstrFile, InStrRev(mstrFile, "\"))

Open pstrFile For Input As #intFileNum

Do While Not EOF(intFileNum)
    Line Input #intFileNum, strLine
    If Left$(UCase$(strLine), 11) = "VBGROUP 5.0" Then blnOK = True
    If Left$(UCase$(strLine), 7) = "PROJECT" Then
        If UBound(astrProjects) < mintNumProjects Then
            ReDim Preserve astrProjects(UBound(astrProjects) + 1)
        End If
        astrProjects(mintNumProjects) = AfterEqual(strLine)
        mintNumProjects = mintNumProjects + 1
    End If
    If Left$(UCase$(strLine), 14) = "STARTUPPROJECT" Then
        If UBound(astrProjects) < mintNumProjects Then
            ReDim Preserve astrProjects(UBound(astrProjects) + 1)
        End If
        astrProjects(mintNumProjects) = AfterEqual(strLine)
        mintNumProjects = mintNumProjects + 1
    End If
Loop

Close #intFileNum

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

For i = 0 To UBound(astrProjects)
    If Trim$(astrProjects(i)) <> "" Then
        Set cProject = New clsProject
        cProject.FilePath = mstrPath
        cProject.Filename = astrProjects(i)
        cProject.OutputPath = mstrOutputPath
        cProject.GroupItem = mstrFile
        cProject.IncludeNAVBar = mblnIncludeNAVBar
        cProject.IncludeAPI = mblnIncludeAPI
        cProject.IncludeCounts = mblnIncludeCounts
        cProject.IncludeDeclarations = mblnIncludeDeclarations
        cProject.IncludeEvents = mblnIncludeEvents
        cProject.IncludeReferences = mblnIncludeReferences
        cProject.IncludeSubs = mblnIncludeSubs
        cProject.IncludeTypes = mblnIncludeTypes
        cProject.IncludeForms = mblnIncludeForms
        cProject.IncludeClasses = mblnIncludeClasses
        cProject.IncludeDesigners = mblnIncludeDesigners
        cProject.IncludeModules = mblnIncludeModules
        cProject.IncludeRelatedDocs = mblnIncludeRelatedDocs
        cProject.IncludeUserControls = mblnIncludeUserControls
        cProject.IncludeUserDocuments = mblnIncludeUserDocuments
        cProject.IncludePropertyPages = mblnIncludePropertyPages
        cProject.IncludeAttributes = mblnIncludeAttributes
        cProject.IncludeVersionInfo = mblnIncludeVersionInfo
        cProject.FileOutputType = mintOutputType
        cProject.StyleSheetFile = mstrStyleSheetFile
        mcProjects.Add cProject
        Set cProject = Nothing
    End If
Next

For Each cProject In mcProjects
    cProject.ParseVBPFile
    mlngNumCodeLines = mlngNumCodeLines + cProject.CodeLineCount
    mlngNumCommentLines = mlngNumCommentLines + cProject.CommentLineCount
Next

Exit Sub

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

End Sub

Public Sub SaveHTML()

Dim intFileNum As Integer
Dim cProject As clsProject

intFileNum = FreeFile

Open mstrOutputPath & IIf(Right$(mstrOutputPath, 1) = "\", "", "\") & FileOnly(ExtractFile(mstrFile, mstrPath)) & ".html" For Output As #intFileNum

Print #intFileNum, AddHTMLHeader
Print #intFileNum, AddHTMLBody
Print #intFileNum, AddHTMLFooter

Close #intFileNum

For Each cProject In mcProjects
    cProject.SaveHTML
Next

If mblnOutputStyleSheet = True Then
    Call OutputStyleSheet(mstrOutputPath, mstrStyleSheetFile)
End If

If mintOutputType = HTMLHelp Then
    Call OutputHTMLHelpHHC
    Call OutputHTMLHelpHHP
End If

End Sub