主要源程序：
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
【更多阅读】