Cls_Ini.cls：VB写的操作ini配置文件的类

主要源程序：
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Cls_Ini"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'EXAMPLE
'ini.Path = "LampKensaki.ini"
'ini.Read
'strT10ComPortNo = ini.GetValue("T-10_COM_NO","T-10_Com_No")    'T-10_Com_No=6
'intT10WaitTime = ini.GetValue("T-10_WAIT_TIME","T10WaitTime")  'T10WaitTime=3000
'intShoudoSokuteiTimming = ini.GetValue("SHOUDO_SOKUTEI_TIMMING","ShoudoSokuteiTimming")    'ShoudoSokuteiTimming=15
'Ad_Ch = ini.GetValue("AD_CH","Ad_Ch")
 
 
'all the functions and variables in this file are used to operate(read/write) the .ini file
Option Explicit
Option Compare Binary
 
Private Const SP As String = "["
Private Const EP As String = "]"
Private Const CP As String = "="
Private Const CB As String = ";"
 
Private Type INISection
    Name    As String
    Keys()  As String
    KeysCnt As Long
End Type
 
 
 
Private INI_Path    As String
Private INI_Mode    As Boolean
 
Private INI_SectCnt As Long
 
Private INI_Sect()  As INISection
Private INI_File()  As String
 
 
 
Private Function CheckSect(ByVal Sect As String) As Boolean
If Left$(Sect,1) = SP And Right$(Sect,1) = EP Then
    CheckSect = 1
End If
End Function
 
Private Function CheckKey(ByVal Key As String) As Boolean
If Left$(Key,1) <> CB Then
    If InStr(Key,CP) Then
        CheckKey = 1
    End If
End If
End Function
 
Private Function GetSectName(ByVal Sect As String) As String
GetSectName = Mid$(Sect,2,Len(Sect) - 2)
End Function
 
Private Function GetKeyName(ByVal Key As String) As String
Dim i As Long
 
i = InStr(Key,CP)
If i > 0 Then
    GetKeyName = Left$(Key,i - 1)
End If
End Function
 
Private Function GetValueName(ByVal Key As String) As String
Dim i As Long
 
i = InStr(Key,CP)
If i > 0 Then
    GetValueName = Right$(Key,Len(Key) - i)
End If
End Function
 
Private Function ChangeSect(ByVal Sect As String) As String
ChangeSect = SP & Sect & EP
End Function
 
Private Function ChangeKey(ByVal Key As String,ByVal Value As String) As String
ChangeKey = Key & CP & Value
End Function
 
Private Sub StrectToAry()
Dim File() As String
Dim i As Long,t As Long,w As Long
Dim s As Long
Const Dumy As String = SP & "Dummy" & EP
 
On Error Resume Next
 
If INI_SectCnt <= 0 Then
    ReDim INI_File(0) As String
    Exit Sub
End If
 
If INI_File(0) = "" Then
    If Err.Number Then
        ReDim INI_File(0) As String
        INI_File(0) = Dumy
'       Err.Clear
    End If
End If
 
Do
    If s >= INI_SectCnt Then Exit Do
    If CheckSect(INI_File(w)) Or w > UBound(INI_File) Then
        ReDim Preserve File(i) As String
        If s > 0 Then
            If File(i - 1) <> "" Then
                File(i) = ""
                i = i + 1
                ReDim Preserve File(i) As String
            End If
        End If
        File(i) = INI_Sect(s).Name
        For t = 0 To INI_Sect(s).KeysCnt - 1
            i = i + 1
            ReDim Preserve File(i) As String
            File(i) = INI_Sect(s).Keys(t)
        Next
        s = s + 1
        i = i + 1
    ElseIf Not CheckKey(INI_File(w)) Then
        ReDim Preserve File(i) As String
        File(i) = INI_File(w)
        i = i + 1
    End If
    w = w + 1
Loop
 
ReDim INI_File(i - 1) As String
INI_File = File
 
Err.Clear
End Sub
 
 
 
Public Property Get Path() As String
Path = INI_Path
End Property
 
Public Property Let Path(ByVal nv As String)
INI_Path = nv
End Property
 
Public Property Get Mode() As Boolean
Mode = INI_Mode
End Property
 
Public Property Let Mode(ByVal nv As Boolean)
INI_Mode = nv
End Property
 
Public Property Get SectCount() As Long
SectCount = INI_SectCnt
End Property
 
Public Property Get KeyCount(Optional ByVal SectionNo As Long = -1,_
                             Optional ByVal SectionName As String) As Long
Dim i As Long
 
If INI_SectCnt <= SectionNo Then Exit Property
If INI_SectCnt < 1 Then Exit Property
 
If SectionNo >= 0 Then
    KeyCount = INI_Sect(SectionNo).KeysCnt
ElseIf SectionName <> "" Then
    For i = 0 To (INI_SectCnt - 1)
        If GetSectName(INI_Sect(i).Name) = SectionName Then
            KeyCount = INI_Sect(i).KeysCnt
            Exit For
        End If
    Next
Else
    For i = 0 To (INI_SectCnt - 1)
        KeyCount = KeyCount + INI_Sect(i).KeysCnt
    Next
End If
 
End Property
 
Public Property Get GetSect(ByVal SectionNo As Long) As String
 
If SectionNo < 0 Then Exit Property
If INI_SectCnt > SectionNo Then
    GetSect = GetSectName(INI_Sect(SectionNo).Name)
End If
 
End Property
 
Public Property Get GetKey(ByVal SectionName As String,ByVal KeyNo As Long) As String
Dim i As Long
 
If INI_SectCnt < 1 Then Exit Property
If KeyNo < 0 Then Exit Property
 
For i = 0 To (INI_SectCnt - 1)
    With INI_Sect(i)
        If GetSectName(.Name) = SectionName Then
            If .KeysCnt > KeyNo Then
                GetKey = GetKeyName(.Keys(KeyNo))
            End If
            Exit For
        End If
    End With
Next
 
End Property
 
Public Property Get GetValue(ByVal SectionName As String,ByVal KeyName As String,_
                             Optional ByVal Default As String = "") As String
Dim i As Long,t As Long
 
GetValue = Default
 
If INI_SectCnt < 1 Then
    Exit Property
End If
 
For i = 0 To (INI_SectCnt - 1)
    With INI_Sect(i)
        If GetSectName(.Name) = SectionName Then
            For t = 0 To (.KeysCnt - 1)
                If GetKeyName(.Keys(t)) = KeyName Then
                    GetValue = GetValueName(.Keys(t))
                    Exit Property
                End If
            Next
        End If
    End With
Next
 
End Property
 
Public Function SetValue(ByVal SectionName As String,_
                                                      ByVal Value As String) As Boolean
Dim File() As String
Dim i As Long,w As Long,z As Long
 
 
If INI_Path = "" Then Exit Function
 
If INI_SectCnt > 0 Then
    For i = 0 To (INI_SectCnt - 1)
        If GetSectName(INI_Sect(i).Name) = SectionName Then
            If INI_Sect(i).KeysCnt > 0 Then
                For t = 0 To (INI_Sect(i).KeysCnt - 1)
                    If GetKeyName(INI_Sect(i).Keys(t)) = KeyName Then
                        INI_Sect(i).Keys(t) = ChangeKey(KeyName,Value)
                        Exit For
                    End If
                Next
                If INI_Sect(i).KeysCnt < 1 Or t > (INI_Sect(i).KeysCnt - 1) Then
                    With INI_Sect(i)
                        ReDim Preserve .Keys(t) As String
                        .Keys(t) = ChangeKey(KeyName,Value)
                        .KeysCnt = .KeysCnt + 1
                    End With
                End If
                SetValue = 1
                Exit For
            End If
        End If
    Next
End If
 
If INI_SectCnt < 1 Or i > (INI_SectCnt - 1) Then
    If INI_SectCnt < 1 Then i = 0
    ReDim Preserve INI_Sect(i) As INISection
    With INI_Sect(i)
        ReDim .Keys(0) As String
        .Name = ChangeSect(SectionName)
        .Keys(0) = ChangeKey(KeyName,Value)
        .KeysCnt = 1
    End With
    INI_SectCnt = INI_SectCnt + 1
    SetValue = 1
End If
 
 
If INI_Mode Then
    SetValue = Save
End If
 
End Function
 
Public Function Delete(ByVal Section As String,Optional ByVal Key As String) As Boolean
Dim iniSect() As INISection
Dim iniKey()  As String
Dim i As Long,w As Long
 
If INI_SectCnt <= 0 Then
    Exit Function
End If
 
If Key = "" Then
    For t = 0 To INI_SectCnt - 1
        If GetSectName(INI_Sect(t).Name) <> Section Then
            ReDim Preserve iniSect(w) As INISection
            iniSect(w) = INI_Sect(t)
            w = w + 1
        End If
    Next
    If w < t Then
        ReDim INI_Sect(w - 1) As INISection
        INI_Sect = iniSect
        INI_SectCnt = w
        Delete = 1
    End If
Else
    For i = 0 To INI_SectCnt - 1
        If GetSectName(INI_Sect(i).Name) = Section Then
            If INI_Sect(i).KeysCnt <= 0 Then
                Exit For
            End If
            For t = 0 To INI_Sect(i).KeysCnt - 1
                If GetKeyName(INI_Sect(i).Keys(t)) <> Key Then
                    ReDim Preserve iniKey(t) As String
                    iniKey(w) = INI_Sect(i).Keys(t)
                    w = w + 1
                End If
            Next
            If w < t Then
                ReDim INI_Sect(i).Keys(t - 1) As String
                INI_Sect(i).Keys = iniKey
                INI_Sect(i).KeysCnt = w
                Delete = 1
            End If
        End If
    Next
End If
 
If INI_Mode Then
    Delete = Save
End If
End Function
 
Public Function Read() As Boolean
Dim rl   As String
Dim NO   As Integer
Dim i As Long,w As Long
 
On Error Resume Next
 
NO = FreeFile()
Open INI_Path For Input As #NO
    If Err.Number Or LOF(NO) = 0 Then
        Close #NO
        Exit Function
    End If
    Do While Not EOF(NO)
        ReDim Preserve INI_File(i) As String
        Line Input #NO,INI_File(i)
        i = i + 1
    Loop
Close #NO
 
INI_SectCnt = -1
For t = LBound(INI_File) To UBound(INI_File)
    If CheckSect(INI_File(t)) Then
        w = 0
        INI_SectCnt = INI_SectCnt + 1
        ReDim Preserve INI_Sect(INI_SectCnt) As INISection
        INI_Sect(INI_SectCnt).Name = INI_File(t)
    ElseIf CheckKey(INI_File(t)) Then
        ReDim Preserve INI_Sect(INI_SectCnt).Keys(w) As String
        INI_Sect(INI_SectCnt).Keys(w) = INI_File(t)
        INI_Sect(INI_SectCnt).KeysCnt = INI_Sect(INI_SectCnt).KeysCnt + 1
        w = w + 1
    End If
Next
 
INI_SectCnt = INI_SectCnt + 1
Read = 1
End Function
 
Public Function Save() As Boolean
Dim NO As Integer
Dim i  As Long
 
On Error Resume Next
 
Call StrectToAry
 
NO = FreeFile()
Open INI_Path For Output As #NO
    If Err.Number Then
        Close #NO
        Exit Function
    End If
    For i = LBound(INI_File) To UBound(INI_File)
        If Err.Number Then
            Exit For
        End If
        Print #NO,INI_File(i)
    Next
Close #NO
 
Save = 1
End Function
 
Public Sub Release()
 
INI_Path = ""
INI_Mode = 0
 
INI_SectCnt = 0
 
Erase INI_File
Erase INI_Sect
 
End Sub
【更多阅读】
Cls_Ini.cls：VB写的操作ini配置文件的类

猜你在找的VB相关文章
