VB读写INI文件

'******************************************************************************************
'*                                       需要注意的问题                                   *
'******************************************************************************************
'1.INI文件的路径必须完整,文件名前面的各级目录必须存在,否则写入不成功,该函数返回 FALSE 值.
'2.文件名的路径中必须为 // ,因为在VC++中, // 才表示一个 / .
'3.也可将INI文件放在程序所在目录,此时 lpFileName 参数为: ".//student.ini".
'4.使用前请先初始化变量ProfileName

'******************************************************************************************
'*                                         API 函数声明                                   *
'******************************************************************************************
'为初始化文件中指定的条目取得字串
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

'为初始化文件中指定的条目获取一个整数值
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
                               
'在初始化文件指定小节内设置一个字串
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
                                
'配置文件名（包含完整路径名）
Public ProfileName As String

'******************************************************************************************
'函数名称： iniProfileName
'函数说明： 初始化配置文件名（包括完整路径名）
'******************************************************************************************
Public Sub iniProfileName(strProfileName As String)
ProfileName = strProfileName
End Sub
'******************************************************************************************
'过程名称： GetProfileValueString
'过程说明： 获取配置文件中子键的值（字符串）
'参数说明： SectionName - [部分]
'           KeyWord     - [关键词]
'           DefString   - [默认值]
'返回值：   返回子键值（字符串）
'******************************************************************************************
Public Function GetProfileValueString(ByVal SectionName As String, ByVal KeyWord As String, _
                                    ByVal DefString As String) As String
On Error GoTo errhandle
Dim ResultString As String * 144, Temp As Integer
Dim s As String, i As Integer
Dim filename As String

Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, ProfileName)

'检索关键词的值
If Temp% > 0 Then   '关键词的值不为空
    s = ""
    For i = 1 To 144
        If Asc(Mid$(ResultString, i, 1)) = 0 Then
            Exit For
        Else
            s = s & Mid$(ResultString, i, 1)
        End If
    Next
Else
    Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, ProfileName)
    
    '将缺省值写入INI文件
    s = DefString
End If

GetProfileValueString = s

errhandle:
    If Err.Number Then
        MsgBox "读取配置文件出错：" & Err.Description
    End If
End Function
'******************************************************************************************
'过程名称： GetProfileValueInt
'过程说明： 获取配置文件中子键的值（整型）
'参数说明： SectionName - [部分]
'           KeyWord     - [关键词]
'           DefString   - [默认值]
'返回值：   返回子键值（整型）
'******************************************************************************************
Public Function GetProfileValueInt(ByVal SectionName As String, ByVal KeyWord As String, _
                                    ByVal DefValue As Integer) As Integer
On Error GoTo errhandle
Dim d As Long, s As String

d = DefValue

GetProfileValueInt = GetPrivateProfileInt(SectionName, KeyWord, DefValue, ProfileName)

If d <> DefValue Then
    s = "" & d
    d = WritePrivateProfileString(SectionName, KeyWord, s, ProfileName)
End If

errhandle:
    If Err.Number Then
        MsgBox "读取配置文件出错：" & Err.Description
    End If
End Function
'******************************************************************************************
'过程名称： SetProfileValueString
'过程说明： 设置配置文件关键词的值（字符串）
'参数说明： SectionName - [部分]
'           KeyWord     - [关键词]
'           DefString   - [默认值]
'******************************************************************************************
Sub SetProfileValueString(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)
On Error GoTo errhandle
Dim res%

res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, ProfileName)

errhandle:
    If Err.Number Then
        MsgBox "写入配置文件出错：" & Err.Description
    End If
End Sub
'******************************************************************************************
'过程名称： SetProfileValueInt
'过程说明： 设置配置文件关键词的值（整型）
'参数说明： SectionName - [部分]
'           KeyWord     - [关键词]
'           DefString   - [默认值]
'******************************************************************************************
Sub SetProfileValueInt(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Integer)
On Error GoTo errhandle
Dim res%, s$

s$ = Str$(ValInt)
res% = WritePrivateProfileString(SectionName, KeyWord, s$, ProfileName)

errhandle:
    If Err.Number Then
        MsgBox "写入配置文件出错：" & Err.Description
    End If
End Sub