VBA - IniFile配置文件类

Option Explicit
' =========================================================
' Class: cIniFile
' Author: Steve McMahon
' Date : 21 Feb 1997
'
' A nice class wrapper around the INIFile functions
' Allows searching,deletion,modification and addition
' of Keys or Values.
'
' Updated 10 May 1998 for VB5.
' * Added EnumerateAllSections method
' * Added Load and Save form position methods
' =========================================================

Private m_sPath As String '路径文件名
Private m_sKey As String '键
Private m_sSection As String '小节
Private m_sDefault As String '默认值
Private m_lLastReturnCode As Long '返回值

' Profile String functions:
Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long


Property Get LastReturnCode() As Long '返回值
   LastReturnCode = m_lLastReturnCode
End Property

Property Get Success() As Boolean '成功
   Success = (m_lLastReturnCode <> 0)
End Property
'=======================================
Property Let Default(sDefault As String) '默认
   m_sDefault = sDefault
End Property
Property Get Default() As String
   Default = m_sDefault
End Property
'======================================
Property Let Path(sPath As String) '路径
   m_sPath = sPath
End Property
Property Get Path() As String '路径
   Path = m_sPath
End Property

Property Get DocPath() As String '路径
   DocPath = IIf(Right(ActiveDocument.FilePath, 1) = "\", ActiveDocument.FilePath, ActiveDocument.FilePath & "\")
End Property
Property Let Key(sKey As String)
   m_sKey = sKey
End Property
Property Get Key() As String
   Key = m_sKey
End Property
'=======================================
Property Let Section(sSection As String) '小节
   m_sSection = sSection
End Property
Property Get Section() As String '小节
   Section = m_sSection
End Property
'=======================================
Property Get Value() As String '值
   Dim sBuf As String
   Dim iSize As String
   Dim iRetCode As Integer
   
   sBuf = Space$(255)
   iSize = Len(sBuf)
   iRetCode = GetPrivateProfileString(m_sSection, m_sKey, m_sDefault, sBuf, iSize, m_sPath)
   If (iSize > 0) Then
      Value = Trim(Replace(sBuf, Chr(0), ""))
   Else
      Value = ""
   End If
   
End Property

Property Let Value(sValue As String) '值
   Dim iPos As Integer
   ' Strip chr$(0):
   iPos = InStr(sValue, Chr$(0))
   Do While iPos <> 0
      sValue = Left$(sValue, (iPos - 1)) & Mid$(sValue, (iPos + 1))
      iPos = InStr(sValue, Chr$(0))
   Loop
   m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, sValue, m_sPath)
End Property

'=========================================
Public Sub DeleteKey() '删除键
   m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, 0&, m_sPath)
End Sub
Public Sub DeleteSection() '删除小节
   m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, 0&, m_sPath)
End Sub

Public Function ReadStr(mKey As String, Optional mSection As String, Optional mDefault As String) As String
Dim S As String
    If mSection <> "" Then
        Section = mSection
    End If
    Key = mKey
    S = Value
    S = IIf(Len(Trim(S)) = 0, mDefault, S)
    ReadStr = S
End Function
Public Sub WriteValue(mKey As String, mValue As String, Optional mSection As String)
    If mSection <> "" Then
        Section = mSection
    End If
    Key = mKey
    Value = mValue
End Sub

Property Get INISection() As String 'Ini小节
   Dim sBuf As String
   Dim iSize As String
   Dim iRetCode As Integer
   
   sBuf = Space$(8192)
   iSize = Len(sBuf)
   iRetCode = GetPrivateProfileString(m_sSection, 0&, m_sDefault, sBuf, iSize, m_sPath)
   If (iSize > 0) Then
      INISection = Left$(sBuf, iRetCode)
   Else
      INISection = ""
   End If
   
End Property

Property Let INISection(sSection As String) 'Ini小节
   m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, sSection, m_sPath)
End Property

Property Get Sections() As String '小节
   Dim sBuf As String
   Dim iSize As String
   Dim iRetCode As Integer
   
   sBuf = Space$(8192)
   iSize = Len(sBuf)
   iRetCode = GetPrivateProfileString(0&, 0&, m_sDefault, sBuf, iSize, m_sPath)
   'Debug.Print sBuf
   If (iSize > 0) Then
      Sections = Left$(sBuf, iRetCode)
   Else
      Sections = ""
   End If
End Property
'----------------------------------
'枚举小节，返回两个参数
'sKey --键字符串数组，1开始
'iCount --键总数
Public Sub EnumerateCurrentSection(ByRef sKey() As String, ByRef iCount As Long)
   Dim sSection As String
   Dim iPos As Long
   Dim iNextPos As Long
   Dim sCur As String
   
   iCount = 0
   Erase sKey
   sSection = INISection
   
   If (Len(sSection) > 0) Then
      iPos = 1
      iNextPos = InStr(iPos, sSection, Chr$(0))

      Do While iNextPos <> 0
         sCur = Mid$(sSection, iPos, (iNextPos - iPos))
         If (sCur <> Chr$(0)) Then
            iCount = iCount + 1
            ReDim Preserve sKey(1 To iCount) As String
            'Debug.Print sSection
            sKey(iCount) = Mid$(sSection, iPos, (iNextPos - iPos))
            
            iPos = iNextPos + 1
            iNextPos = InStr(iPos, sSection, Chr$(0))
         End If
      Loop
   End If
End Sub

'' ==========================================================
' 开发人员：夜的影子
' 编写时间：2007-1-20
' 过程名称：EnumerateAllSections
' 参数说明：sSections : 小节字符串数组，1开始
' iCount : 小节总数
' 功能说明：枚举所有小节，返回两个参数
'' ==========================================================
Public Sub EnumerateAllSections(ByRef sSections() As String, ByRef iCount As Long)
   Dim sIniFile As String
   Dim iPos As Long
   Dim iNextPos As Long
   Dim sCur As String
   
   iCount = 0
   Erase sSections
   sIniFile = Sections
   'Debug.Print Sections
   If (Len(sIniFile) > 0) Then
      iPos = 1
      iNextPos = InStr(iPos, sIniFile, Chr$(0))
      Do While iNextPos <> 0
         If (iNextPos <> iPos) Then
            sCur = Mid$(sIniFile, iPos, (iNextPos - iPos))
            iCount = iCount + 1
            ReDim Preserve sSections(1 To iCount) As String
            sSections(iCount) = sCur
         End If
         iPos = iNextPos + 1
         iNextPos = InStr(iPos, sIniFile, Chr$(0))
      Loop
   End If
   
End Sub


Public Function CLngDefault(ByVal sString As String, Optional ByVal lDefault As Long = 0) As Long
   Dim lR As Long
   On Error Resume Next
   lR = CLng(sString)
   If (Err.Number <> 0) Then
      CLngDefault = lDefault
   Else
      CLngDefault = lR
   End If
End Function


Private Sub Class_Initialize()
    m_sSection = "Main"
End Sub