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
Option Explicit

'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(ByVal Section As String, ByVal Key As String, ByVal 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(ByVal Section As String, ByVal 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(ByVal 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
Public Function ReadDouble(ByVal Section As String, ByVal Key As String) As Double
    Dim Str As String
    Str = ReadString(Section, Key, 20)
    ReadDouble = Val(Str)
End Function

Public Function ReadData(ByVal Section As String, ByVal Key As String, ByVal Size As Long) As Variant
    Select Case Size
        Case 0
            ReadData = ReadInt(Section, Key)
        Case 1
            ReadData = ReadDouble(Section, Key)
        Case Else
            ReadData = ReadString(Section, Key, Size)
    End Select
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

Public Function ReadState()
    Dim temp As String, i As Long
    Dim stateNum 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) & " " & "CalKit Number is out of range,Please Check Config File!"
            End
        End If
    Next i
    Close #1
End Function