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