modgeneral.bas

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

GetAPIItemName = Mid$(pstrData, InStrRev(pstrData, " ", InStr(LCase$(pstrData), " lib ") - 1) + 1, _
    InStr(pstrData, " Lib ") - InStrRev(pstrData, " ", InStr(LCase$(pstrData), " lib ") - 1) - 1)

End Function

Public Sub OutputStyleSheet(ByVal pstrPath As String, Optional pstrFile As String)
' Outputs a standard style sheet, or copies the specified file

Dim intFileNum As Integer
Dim strOutput As String

If pstrFile <> "" Then
    FileCopy pstrFile, pstrPath & IIf(Right$(pstrPath, 1) = "\", "", "\") & FileOnly(pstrFile)
    Exit Sub
End If
    
strOutput = "<STYLE TYPE=""text/css"">" & vbCrLf
strOutput = strOutput & "A" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #003399;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "A:link" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #b03d91;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "A:visited" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #b03d91;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "A:active" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #b03d91;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "A:hover" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    COLOR: #ff6600;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: underline" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "B" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 12px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "P" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & ".copy" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & ".smlcopy" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 9px;" & vbCrLf
strOutput = strOutput & "    COLOR: #c6c3c6;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "EM" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-STYLE: italic;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "BODY" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    BACKGROUND-COLOR: white;" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TABLE.GENERAL" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    BORDER-RIGHT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-TOP: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-LEFT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-BOTTOM: 0px;" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.CELL" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    WIDTH: 260px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.HEADERBAND" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    WIDTH: 260px;" & vbCrLf
strOutput = strOutput & "    COLOR: white;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    BACKGROUND-COLOR: teal;" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TABLE.INTROPAGE" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    BORDER-RIGHT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-TOP: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-LEFT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-BOTTOM: 0px;" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.INTROCELL" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    COLOR: #336699;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.INTROHEADER" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    WIDTH: 15%;" & vbCrLf
strOutput = strOutput & "    COLOR: white;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    BACKGROUND-COLOR: teal;" & vbCrLf
strOutput = strOutput & "    TEXT-DECORATION: none" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TABLE.LAYOUT" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    BORDER-RIGHT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-TOP: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-LEFT: 0px;" & vbCrLf
strOutput = strOutput & "    BORDER-BOTTOM: 0px;" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.LAYOUTNAV" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    WIDTH: 20%;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    BACKGROUND-COLOR: #eeeeee;" & vbCrLf
strOutput = strOutput & "    vertical-align: top;" & vbCrLf
strOutput = strOutput & "    padding: 10;" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "TD.LAYOUTCELL" & vbCrLf
strOutput = strOutput & "{" & vbCrLf
strOutput = strOutput & "    FONT-SIZE: 11px;" & vbCrLf
strOutput = strOutput & "    WIDTH: 100%;" & vbCrLf
strOutput = strOutput & "    FONT-FAMILY: ""Verdana"";" & vbCrLf
strOutput = strOutput & "    vertical-align: top;" & vbCrLf
strOutput = strOutput & "    padding: 10;" & vbCrLf
strOutput = strOutput & "}" & vbCrLf
strOutput = strOutput & "</STYLE>" & vbCrLf

intFileNum = FreeFile
Open pstrPath & IIf(Right$(pstrPath, 1) = "\", "", "\") & "general.css" For Output As #intFileNum
Print #intFileNum, strOutput
Close #intFileNum

End Sub

Public Function RemoveEndComment(ByVal pstrData As String) As String

RemoveEndComment = Left$(pstrData, Len(pstrData) - InStr(pstrData, "'"))

End Function

Public Function RemoveQuotes(ByVal pstrData As String) As String
' Removes quotes from a string

RemoveQuotes = Replace(pstrData, Chr(34), "")

End Function

Public Sub SortList(ByRef pstrList() As String, ByRef pstrRef() As String, Optional ByRef pstrRef2 As Variant, Optional ByRef pstrRef3 As Variant)

Dim blnCheck As Boolean
Dim strTemp As String, i As Long

Do
    blnCheck = False
    For i = 0 To UBound(pstrList) - 1
        If StrComp(pstrList(i), pstrList(i + 1), vbTextCompare) > 0 And pstrList(i + 1) <> "" Then
            blnCheck = True
            strTemp = pstrList(i)
            pstrList(i) = pstrList(i + 1)
            pstrList(i + 1) = strTemp
            strTemp = pstrRef(i)
            pstrRef(i) = pstrRef(i + 1)
            pstrRef(i + 1) = strTemp
            If IsArray(pstrRef2) = True Then
                strTemp = pstrRef2(i)
                pstrRef2(i) = pstrRef2(i + 1)
                pstrRef2(i + 1) = strTemp
            End If
            If IsArray(pstrRef3) = True Then
                strTemp = pstrRef3(i)
                pstrRef3(i) = pstrRef3(i + 1)
                pstrRef3(i + 1) = strTemp
            End If
        End If
    Next i
Loop Until blnCheck = False

End Sub

Public Function IsNumber(ByVal pstrText As String) As Boolean

Dim i As Long, blnCheck As Boolean

For i = 1 To Len(pstrText)
    If InStr("0123456789.-", Mid$(pstrText, i, 1)) = 0 Then blnCheck = True
Next i

If blnCheck = False Then IsNumber = True

End Function