mdlinifile.bas

数据库连接封装控件 可以连接Access

Attribute VB_Name = "mdlIniFile"

'-----------------------------------------------------------
' FUNCTION:
'
'
'
' IN: [
'
' RETURNS:
'
'-----------------------------------------------------------
' Core Utilities for VB 的参数定义无法实现删除
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Option Explicit
Public gs_DBPath As String

'
'-----------------------------------------------------------
' FUNCTION: SplitEx
'
' Split的增强版本，可以指定多个分隔符。
' 与SplitEx类似，只不过返回的是一个String数组而不是一个集合。
'
' IN: [Expression] - 要分隔的源串
'     [Delimiters] - 多个分隔符组成的一个字符串，缺省参数由
'                    常量gsSEP_CHARS定义。
'     [IncludeEmptyString] - 是否包括空串。缺省：False
'
' RETURNS: 分隔后的字符串数组。如果Expression为空串，则返回的是一个
'   空的字符串数组。因此，返回以后必须使用IsArrayEmpty函数加以判断。
'   另外，与原先的Split函数不同的是，如果Split(Expression, vbNullString)
'   将返回一个仅包含源串的长度为1的数组。而本函数将会返回一个将源串
'   切割成每个元素为一个字符的数组。
'
' REMARKS:
'   有一个重要的差别：Split函数会返回空串，而本函数是否返回空串
'   则由参数IncludeEmptyString决定。
'
'-----------------------------------------------------------
'
Function SplitEx(Expression As String, Optional Delimiters As String = "/", _
    Optional Count As Long = -1, Optional Compare As VbCompareMethod = vbBinaryCompare, _
    Optional IncludeEmptyString As Boolean = False) As String()
    
    Dim sArray() As String
    Dim nCount As Integer
    Dim i As Integer, j As Integer
    Dim nLenExpression As Integer
    Dim nLenDelimiters As Integer
    Dim sPart As String
    Dim C As String
    
    nLenExpression = Len(Expression)
    If nLenExpression = 0 Then Exit Function    ' 返回一个空数组
    If Count = 0 Then Exit Function             ' 返回一个空数组
    
    nLenDelimiters = Len(Delimiters)
    If nLenDelimiters = 0 Then
        ' 如果指定的分隔符为空串，则将源串分割成单个的字符序列。
        
        ' 如果指定了返回的子串的个数，则需要确定sArray的下界。
        If Count > 0 And Count <= nLenExpression Then
            ReDim sArray(Count - 1) As String
            j = Count
        Else
            ReDim sArray(nLenExpression - 1) As String
            j = nLenExpression
        End If
        
        For i = 1 To j
            sArray(i - 1) = Mid$(Expression, i, 1)
        Next
        SplitEx = sArray
        Exit Function
    End If
    
    For i = 1 To nLenExpression
        C = Mid$(Expression, i, 1)
        If InStr(1, Delimiters, C, Compare) > 0 Then
            If IncludeEmptyString Or (Not IncludeEmptyString And Len(sPart) > 0) Then
                ReDim Preserve sArray(nCount) As String
                sArray(nCount) = sPart
                nCount = nCount + 1
                
                ' nCount = 目前已经获取的子串的个数
                If Count > 0 And nCount = Count Then Exit For   ' 已经获取足够的子串
            End If
            sPart = vbNullString
        Else
            sPart = sPart & C
        End If
    Next
    
    If i = nLenExpression + 1 Then
        ' 表示是For循环的正常退出，表示没有获取足够多的子串
        If IncludeEmptyString Or (Not IncludeEmptyString And Len(sPart) > 0) Then
            ReDim Preserve sArray(nCount) As String
            sArray(nCount) = sPart
        End If
    Else
        ' 否则，表示是由于获取了足够多的子串而退出的，没有必要再加上最后一个子串。
        ' Do nothing
    End If
    
    SplitEx = sArray
End Function

'-----------------------------------------------------------
' FUNCTION: IniRead
'
' Read a key's value of an INI file.
'
' IN: [FileName] - .ini file name.
'     [SectionName] - section name
'     [KeyName] - Key name
'
' RETURNS: The value of the key. If the key doesn't exist, return
'   a null string.
'
'-----------------------------------------------------------
Public Function IniRead(ByVal FileName As String, ByVal SectionName As String, ByVal KeyName As String) As String
    Dim retStr As String
    
    If Len(SectionName) = 0 Then Err.Raise 450, "IniRead", _
        "Parameter ""SectionName"" of function ""IniRead"" must not be an empty string, use function ""IniReadSectionList"" if you want to get all sections list."
    If Len(KeyName) = 0 Then Err.Raise 450, "IniRead", _
        "Parameter ""KeyName"" of function ""IniRead"" must not be an empty string, use function ""IniReadKeyList"" if you want to get all keys list."
        
    retStr = String(255, vbNullChar)
    GetPrivateProfileString SectionName, KeyName, vbNullString, retStr, 255, FileName
    IniRead = StripTerminator(retStr)
End Function



'-----------------------------------------------------------
' FUNCTION: StripTerminator
'
' Returns a string without any zero terminator.  Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
'          terminating zero.
'
'-----------------------------------------------------------
'
Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, vbNullChar)
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

'-----------------------------------------------------------
' FUNCTION: IniReadSectionList
'
' Returns an array of sections of an ini file.
'
' IN: [FileName]
'
' RETURNS:
'
' REMARKS: Use IsArrayEmpty to determine if no sections in this file.
'
'-----------------------------------------------------------
'
Public Function IniReadSectionList(ByVal FileName As String, Optional BufferSize As Long = 4096) As String()
    Dim strSectionList As String
    
    strSectionList = String(BufferSize, vbNullChar)  ' Default buffer size: 4K bytes
    GetPrivateProfileString vbNullString, 0&, vbNullString, strSectionList, BufferSize, FileName

    IniReadSectionList = SplitEx(strSectionList, vbNullChar)
End Function

'-----------------------------------------------------------
' FUNCTION: IniReadKeyList
'
' Returns an array of keys of a section of an ini file.
'
' IN: [FileName, SectionName]
'
' RETURNS:
'
' REMARKS: Use IsArrayEmpty to determine if no Keys in this section.
'
'-----------------------------------------------------------
'
Public Function IniReadKeyList(ByVal FileName As String, ByVal SectionName As String, Optional BufferSize As Long = 4096) As String()
    Dim strKeyList As String
    
    strKeyList = String(BufferSize, vbNullChar)
    GetPrivateProfileString SectionName, vbNullString, vbNullString, strKeyList, BufferSize, FileName
        
    IniReadKeyList = SplitEx(strKeyList, vbNullChar)
End Function