clsproject.cls

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

    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 Each cFile In mcUserDocuments
        strOutput = strOutput & "    <li><object type=""text/sitemap"">" & vbCrLf
        strOutput = strOutput & "      <param name=""Name"" value=""" & FileOnly(ExtractFile(cFile.Filename, "")) & """>" & vbCrLf
        strOutput = strOutput & "      <param name=""Local"" value=""" & FileOnly(ExtractFile(cFile.Filename, "")) & ".html"">" & vbCrLf
        strOutput = strOutput & "    </object>" & vbCrLf
    Next
    strOutput = strOutput & "      </ul>" & vbCrLf
    strOutput = strOutput & "    </ul>" & vbCrLf
End If
    
strOutput = strOutput & "</ul>" & vbCrLf
strOutput = strOutput & "</html>" & vbCrLf

intFileNum = FreeFile

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

End Sub

Private Sub OutputHTMLHelpHHP()

Dim strOutput As String
Dim cFile As clsFile
Dim intFileNum As Integer

strOutput = strOutput & "[OPTIONS]" & vbCrLf
strOutput = strOutput & "Compiled File=" & mstrTitle & ".chm" & vbCrLf
strOutput = strOutput & "Title=" & mstrHelpTitle & vbCrLf
strOutput = strOutput & "Contents File=" & mstrTitle & ".hhc" & vbCrLf
strOutput = strOutput & "Index File=" & vbCrLf
strOutput = strOutput & "Default topic=" & FileOnly(ExtractFile(mstrVBPName, mstrVBPPath)) & ".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 & """,""" & mstrTitle & ".hhc"","""","""","""",,,,,0x420,0,0x200e,[0,0,900,600],0x0,0x0,,0,0,0" & vbCrLf
strOutput = strOutput & "" & vbCrLf
strOutput = strOutput & "[FILES]" & vbCrLf
strOutput = strOutput & FileOnly(ExtractFile(mstrVBPName, mstrVBPPath)) & ".html" & vbCrLf

If mintNumForms > 0 And mblnIncludeForms = True Then
    For Each cFile In mcForms
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumModules > 0 And mblnIncludeModules = True Then
    For Each cFile In mcModules
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumClasses > 0 And mblnIncludeClasses = True Then
    For Each cFile In mcClasses
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumUserControls > 0 And mblnIncludeUserControls = True Then
    For Each cFile In mcUserControls
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumPropertyPages > 0 And mblnIncludePropertyPages = True Then
    For Each cFile In mcPropertyPages
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumDesigners > 0 And mblnIncludeDesigners = True Then
    For Each cFile In mcDesigners
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If
If mintNumUserDocuments > 0 And mblnIncludeUserDocuments = True Then
    For Each cFile In mcUserDocuments
        strOutput = strOutput & FileOnly(ExtractFile(cFile.Filename, "")) & ".html" & vbCrLf
    Next
End If

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) = "\", "", "\") & mstrTitle & ".HHP" For Output As #intFileNum
Print #intFileNum, strOutput
Close #intFileNum

End Sub

Public Sub ParseVBPFile(Optional ByVal pstrFilename As String)

Dim astrForm() As String
Dim astrClass() As String
Dim astrModule() As String
Dim astrObject() As String
Dim astrUserControl() As String
Dim astrReference() As String
Dim astrRelatedDocs() As String
Dim astrDesigner() As String
Dim astrUserDocument() As String
Dim astrPropertyPage() As String

Dim intInFile As Integer
Dim strData As String
Dim i As Integer
Dim astrSort() As String
Dim cFile As clsFile
Dim cItem As clsItem

ReDim astrForm(0)
ReDim astrClass(0)
ReDim astrModule(0)
ReDim astrObject(0)
ReDim astrUserControl(0)
ReDim astrReference(0)
ReDim astrRelatedDocs(0)
ReDim astrDesigner(0)
ReDim astrUserDocument(0)
ReDim astrPropertyPage(0)

If pstrFilename <> "" Then
    mstrVBPName = pstrFilename
End If
mstrVBPPath = Left$(mstrVBPName, InStrRev(mstrVBPName, "\"))

intInFile = FreeFile

On Error GoTo Handler

Open mstrVBPName For Input As #intInFile

mintNumForms = 0
mintNumObjects = 0
mintNumUserControls = 0
mintNumReferences = 0
mintNumModules = 0
mintNumClasses = 0
mintNumRelatedDocs = 0
mstrTitle = ""
mstrMajor = ""
mstrMinor = ""
mstrRevision = ""

Do While Not EOF(intInFile)
    Line Input #intInFile, strData

    If InStr(strData, "Name=") = 1 Then
        mstrTitle = AfterEqual(strData)
    End If
    
    If InStr(strData, "ExeName32=") = 1 Then
        mstrEXEName = AfterEqual(strData)
    End If
    
    If InStr(strData, "MajorVer=") > 0 Then
        mstrMajor = AfterEqual(strData)
    End If
    
    If InStr(strData, "MinorVer=") > 0 Then
        mstrMinor = AfterEqual(strData)
    End If
    
    If InStr(strData, "RevisionVer=") > 0 Then
        mstrRevision = AfterEqual(strData)
    End If
    
    If InStr(strData, "Description=") = 1 Then
        mstrDescription = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionComments=") > 0 Then
        mstrVersionInfo(0) = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionCompanyName=") > 0 Then
        mstrVersionInfo(1) = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionFileDescription=") > 0 Then
        mstrVersionInfo(2) = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionLegalCopyright=") > 0 Then
        mstrVersionInfo(3) = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionLegalTrademarks=") > 0 Then
        mstrVersionInfo(4) = AfterEqual(strData)
    End If
    
    If InStr(strData, "VersionProductName=") > 0 Then
        mstrVersionInfo(5) = AfterEqual(strData)
    End If
    
    If InStr(strData, "Form=") = 1 Then
        If UBound(astrForm) < mintNumForms Then
            ReDim Preserve astrForm(UBound(astrForm) + 1)
        End If
        astrForm(mintNumForms) = AfterEqual(strData)
        mintNumForms = mintNumForms + 1
    End If
    
    If InStr(strData, "UserControl=") = 1 Then
        If UBound(astrUserControl) < mintNumUserControls Then
            ReDim Preserve astrUserControl(UBound(astrUserControl) + 1)
        End If
        astrUserControl(mintNumUserControls) = AfterEqual(strData)
        mintNumUserControls = mintNumUserControls + 1
    End If
    
    If InStr(strData, "PropertyPage=") = 1 Then
        If UBound(astrPropertyPage) < mintNumPropertyPages Then
            ReDim Preserve astrPropertyPage(UBound(astrPropertyPage) + 1)
        End If
        astrPropertyPage(mintNumPropertyPages) = AfterEqual(strData)
        mintNumPropertyPages = mintNumPropertyPages + 1
    End If
    
    If InStr(strData, "UserDocument=") = 1 Then
        If UBound(astrUserDocument) < mintNumUserDocuments Then
            ReDim Preserve astrUserDocument(UBound(astrUserDocument) + 1)
        End If
        astrUserDocument(mintNumUserDocuments) = AfterEqual(strData)
        mintNumUserDocuments = mintNumUserDocuments + 1
    End If
    
    If InStr(strData, "Designer=") = 1 Then
        If UBound(astrDesigner) < mintNumDesigners Then
            ReDim Preserve astrDesigner(UBound(astrDesigner) + 1)
        End If
        astrDesigner(mintNumDesigners) = AfterEqual(strData)
        mintNumDesigners = mintNumDesigners + 1
    End If
    
    If InStr(strData, "Object=") = 1 Then
        If UBound(astrObject) < mintNumObjects Then
            ReDim Preserve astrObject(UBound(astrObject) + 1)
        End If
        astrObject(mintNumObjects) = AfterEqual(strData)
        mintNumObjects = mintNumObjects + 1
    End If
    
    If InStr(strData, "Reference=") = 1 Then
        If UBound(astrReference) < mintNumReferences Then
            ReDim Preserve astrReference(UBound(astrReference) + 1)
        End If
        astrReference(mintNumReferences) = AfterEqual(strData)
        mintNumReferences = mintNumReferences + 1
    End If
    
    If InStr(strData, "RelatedDoc=") = 1 Or InStr(strData, "ResFile32=") = 1 Then
        If UBound(astrRelatedDocs) < mintNumRelatedDocs Then
            ReDim Preserve astrRelatedDocs(UBound(astrRelatedDocs) + 1)
        End If
        astrRelatedDocs(mintNumRelatedDocs) = RemoveQuotes(AfterEqual(strData))
        mintNumRelatedDocs = mintNumRelatedDocs + 1
    End If
    
    If InStr(strData, "Module=") = 1 Then
        If UBound(astrModule) < mintNumModules Then
            ReDim Preserve astrModule(UBound(astrModule) + 1)
        End If
        astrModule(mintNumModules) = AfterEqual(strData)
        mintNumModules = mintNumModules + 1
    End If
    
    If InStr(strData, "Class=") = 1 Then
        If UBound(astrClass) < mintNumClasses Then
            ReDim Preserve astrClass(UBound(astrClass) + 1)
        End If
        astrClass(mintNumClasses) = AfterEqual(strData)
        mintNumClasses = mintNumClasses + 1
    End If
Loop

Close #intInFile

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

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

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

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

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

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

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