VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CIniFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'API函数声明
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
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'读写ini文件的名字
Public IniFileName As String

'出错信息
Public ErrorMsg As String

'属性初始化
Public Sub Class_Initialize()

    IniFileName = vbNullString
    ErrorMsg = vbNullString
    
End Sub

'指定文件名
Public Sub SpecifyIni(FilePathName)

    IniFileName = Trim(FilePathName)
    
End Sub

'检查是否指定了文件名
Private Function NoIniFile() As Boolean
    NoIniFile = True
    If IniFileName = vbNullString Then
        ErrorMsg = "没有指定 INI 文件"
        Exit Function
    End If
    ErrorMsg = vbNullString
    NoIniFile = False
End Function

'写文件
Public Function WriteString(section As String, key As String, Value As String) As Boolean
    WriteString = False
    If NoIniFile() Then
        Exit Function
    End If
    If WritePrivateProfileString(section, key, Value, IniFileName) = 0 Then
        ErrorMsg = "写入失败"
        Exit Function
    End If
    WriteString = True
End Function

'从ini文件读string
Public Function ReadString(section As String, key As String, Size As Long) As String

    Dim ReturnStr As String
    Dim ReturnLng As Long
    ReadString = vbNullString
    If NoIniFile() Then
        Exit Function
    End If
    ReturnStr = Space(Size)
    ReturnLng = GetPrivateProfileString(section, key, vbNullString, ReturnStr, Size, IniFileName)
    ReadString = Left(ReturnStr, ReturnLng)

End Function

'从ini文件读Int
Public Function ReadInt(section As String, key As String) As Long
    Dim ReturnLng As Long
    ReadInt = 0
    ReturnLng = GetPrivateProfileInt(section, key, 0, IniFileName)
    If ReturnLng = 0 Then
        ReturnLng = GetPrivateProfileInt(section, key, 1, IniFileName)
        If ReturnLng = 1 Then
            ErrorMsg = "不能读取"
            Exit Function
        End If
    End If
    ReadInt = ReturnLng
End Function

'从ini文件读double
Public Function ReadDouble(section As String, key As String) As Double
    Dim str As String
    str = ReadString(section, key, 20)
    ReadDouble = Val(str)
End Function

'返回ini文件中测试项的数目
Public Function CurItmNum() As Integer
    Dim num As Integer
    num = 0
    CurItmNum = 1
    While ReadString(num + 1, "message", 4) <> vbNullString
          num = num + 1
    Wend
    CurItmNum = num
End Function

'initializing the array ReadIndex()
Public Function Read_WriOrder()
    ReDim WriteIndex(ItemNum - 1) As String
    Open IniFileName For Input As #1
    For i = 0 To ItemNum - 1
    Input #1, WriteIndex(i)
    If WriteIndex(i) = "" Then
       i = i - 1
    End If
    Next i
    Close #1
End Function

Public Function ReadState()
    Dim temp As String
    Open IniFileName For Input As #1
    Input #1, temp
    StateNum = Right(temp, 1)
    ReDim StateName(StateNum - 1) As String
    ReDim CalKit(StateNum - 1) As Integer
    For i = 0 To StateNum - 1
        Input #1, StateName(i), CalKit(i)
        If CalKit(i) > 8 Or CalKit(i) < 1 Then
            MsgBox "The " & (i + 1) & " " & "Cal Kit Number is out of range,Please Check ini File!", vbOKOnly + vbCritical, "Error!"
            End
        End If
    Next i
    Close #1
End Function

'---To be strick,the design of two member functions above
'---violates the OOP.If time permits, which shoule
'---be improved._ Added by XiongWenjun,2007,08,11