modgeneral.bas

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

Attribute VB_Name = "modGeneral"
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：05/11/15
'描    述：VB工程文档自动产生器
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************
Option Explicit

Public Enum OutputType
    HTML = 0
    HTMLHelp = 1
End Enum

Public Type Struct_BrowseInfo
    hwndOwner As Long
    pidlRoot As Long
    sDisplayName As String
    mstrTitle As String
    Flags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Declare Function SHBrowseForFolder Lib "shell32.dll" (bBrowse As Struct_BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal lngItem As Long, ByVal sDir As String) As Long

Public Function AfterEqual(ByVal pstrData As String) As String
' Grabs everything after the equals

AfterEqual = RemoveQuotes(Mid$(pstrData, InStr(pstrData, "=") + 1))

End Function

Public Function CheckForValidInfo(ByVal pstrData As String) As Boolean

Dim blnCheck As Boolean

blnCheck = False

If InStr(LCase$(pstrData), "public ") > 0 Then blnCheck = True
If InStr(LCase$(pstrData), "private ") > 0 Then blnCheck = True
If InStr(LCase$(pstrData), "friend ") > 0 Then blnCheck = True
If Trim$(pstrData) = "" Then blnCheck = True

CheckForValidInfo = blnCheck

End Function

Public Function SpecialSplit(ByVal pstrData As String, ByVal pstrSep As String) As String()

Dim i As Long, blnOpenItem As Boolean, lngPos As Long
Dim lngCount As Long
Dim strReturn() As String

ReDim strReturn(0)

blnOpenItem = False
lngPos = 1
lngCount = 0

If InStr(pstrData, pstrSep) = 0 Then
    strReturn(0) = pstrData
Else
    pstrData = pstrData & pstrSep
    For i = 1 To Len(pstrData)
        Select Case Mid$(pstrData, i, 1)
        Case "(", Chr$(34)
            blnOpenItem = True
        Case ")", Chr$(34)
            blnOpenItem = False
        Case pstrSep
            If blnOpenItem = False Then
                If UBound(strReturn) < lngCount Then
                    ReDim Preserve strReturn(lngCount)
                End If
                strReturn(lngCount) = Trim$(Mid$(pstrData, lngPos, i - lngPos))
                lngPos = i + 1
                lngCount = lngCount + 1
            End If
        End Select
    Next i
    If lngCount = 0 Then
        strReturn(0) = Left$(pstrData, Len(pstrData) - 1)
    End If
End If

SpecialSplit = strReturn

End Function

Public Sub CompileHTMLHelp(ByVal pstrHelpProject As String, ByVal pstrCompiler As String)
' Runs the HTML Help compiler file to create the .CHM file

Dim strEXE As String

If FileExists(pstrCompiler) = False Then
    MsgBox "帮助编译器不存在!", vbExclamation, "文件不存在"
    Exit Sub
End If

strEXE = pstrCompiler & " " & pstrHelpProject

Shell strEXE, vbMaximizedFocus

End Sub

Public Function ExtractFile(ByVal pstrData As String, ByVal pstrVBPPath As String) As String

Dim intCount As Integer, intPos As Integer
Dim strSubPath As String, i As Integer

If InStr(pstrData, ";") > 0 Then
    ExtractFile = Trim(Right$(pstrData, Len(pstrData) - InStr(pstrData, ";")))
Else
    ExtractFile = Trim$(pstrData)
End If

If InStr(ExtractFile, "\") > 0 Then
    If InStr(ExtractFile, ":") > 0 Then
        ' do nothing - the full path has been specified
    ElseIf InStr(ExtractFile, "..") > 0 Then
        intCount = 0
        intPos = 1
        Do
            If InStr(intPos, ExtractFile, "..") > 0 Then
                intCount = intCount + 1
                intPos = InStr(intPos, ExtractFile, "..") + 2
            End If
        Loop Until InStr(intPos, ExtractFile, "..") = 0
        strSubPath = Left$(pstrVBPPath, Len(pstrVBPPath) - 1)
        For i = 1 To intCount
            strSubPath = Left$(strSubPath, InStrRev(strSubPath, "\") - 1)
        Next i
        ExtractFile = strSubPath & Mid$(ExtractFile, InStrRev(ExtractFile, "..") + 2)
    Else
        ExtractFile = pstrVBPPath & IIf(Right$(pstrVBPPath, 1) = "\", "", "\") & ExtractFile
    End If
Else
    ExtractFile = pstrVBPPath & IIf(Right$(pstrVBPPath, 1) = "\", "", "\") & ExtractFile
End If

End Function

Public Function ExtractName(ByVal pstrData As String) As String

If InStr(pstrData, ";") = 0 Then
    ExtractName = pstrData
Else
    ExtractName = Trim$(Left$(pstrData, InStr(pstrData, ";") - 1))
End If

If InStr(ExtractName, "\") > 0 Then
    ExtractName = Mid$(ExtractName, InStrRev(ExtractName, "\") + 1)
End If
If InStrRev(ExtractName, ".") > 0 Then
    ExtractName = Left$(ExtractName, InStr(ExtractName, ".") - 1)
End If

End Function

Public Function FileExists(ByVal sFilename As String) As Boolean

' this function checks that a file exists

Dim i As Integer

On Error Resume Next

i = Len(Dir$(sFilename))
If Err Or i = 0 Then
    FileExists = False
Else
    FileExists = True
End If

On Error GoTo 0

End Function

Public Function FileOnly(ByVal pstrFullFile As String) As String
' Returns the filename part from a fully defined file (ie file with path info)

If InStr(pstrFullFile, "\") = 0 Then
    FileOnly = pstrFullFile
Else
    FileOnly = Mid$(pstrFullFile, InStrRev(pstrFullFile, "\") + 1)
End If

End Function

Public Function GetFolder(pstrTitle As String, pfrmOwnerForm As Form) As String

Dim browse_info As Struct_BrowseInfo
Dim lngItem As Long
Dim strDirName As String

browse_info.hwndOwner = pfrmOwnerForm.hWnd
browse_info.pidlRoot = 0
browse_info.sDisplayName = Space$(260)
browse_info.mstrTitle = pstrTitle
browse_info.Flags = 1
browse_info.lpfn = 0
browse_info.lParam = 0
browse_info.iImage = 0

lngItem = SHBrowseForFolder(browse_info)
If lngItem Then
    strDirName = Space$(260)
    If SHGetPathFromIDList(lngItem, strDirName) Then
        GetFolder = Left$(strDirName, InStr(strDirName, Chr$(0)) - 1)
    Else
        GetFolder = ""
    End If
End If

End Function

Public Function GetItemName(ByVal pstrData As String) As String

If InStr(pstrData, "(") = 0 Then Exit Function
GetItemName = Mid$(pstrData, InStrRev(pstrData, " ", InStr(pstrData, "(")) + 1, _
    InStr(pstrData, "(") - InStrRev(pstrData, " ", InStr(pstrData, "(")) - 1)

End Function

Public Function GetAPIItemName(ByVal pstrData As String) As String

If InStr(LCase$(pstrData), "(") = 0 Then Exit Function