'// Private member that holds a reference to
'// the path of our ini file
Private strInI As String
'// Win API Declares
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
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 Function MakePath(ByVal strDrv As String, _
ByVal strDir As String) As String
'// Makes an INI file: Guarantees a sub dir
Do While Right$(strDrv, 1) = "\"
strDrv = Left$(strDrv, Len(strDrv) - 1)
Loop
Do While Left$(strDir, 1) = "\"
strDir = Mid$(strDir, 2)
Loop
'// Return the path
MakePath = strDrv & "\" & strDir
End Function
Public Sub CreateIni(strDrv As String, strDir As String)
'// Make a new ini file
strInI = MakePath(strDrv, strDir)
End Sub
Public Sub WriteFile(strSection As String, _
strKey As String, _
strValue As String)
'// Write to strINI
WritePrivateProfileString strSection, _
strKey, strValue, strInI
End Sub
Public Function GetFile(strSection As String, _
strKey As String) As String
Public Property Let INIFile(ByVal New_IniPath As String)
'// Sets the new ini path
strInI = New_IniPath
End Property
Public Property Get INIFile() As String
'// Returns the current ini path
INIFile = strInI
End Property
使用的时候是这样的
'****************读取短信账号**************************
Dim myIniFile As New cIniFile
'---指定访问的ini文件
If Len(App.Path) > 3 Then
'under disk root dir , eg: "C:\"
myIniFile.INIFile = App.Path & "\setting.ini"
Else
myIniFile.INIFile = App.Path & "setting.ini"
End If
'---读出ini文件的数据,注意,如果是字符串,则去掉末尾一个字符
'declares for ini controlling
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
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 WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, 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
'when form is loaded
Private Sub Form_Load()
'if error occures resume still
On Error Resume Next
'local variables
Dim File As String, OFLen As Double, _
Str As String
'reads ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v - 1)
End Function
'reads ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v - 1)
End Function
'writes ini
Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String)
WritePrivateProfileString Section, Key, Value, Filename
End Sub
'writes ini section
Public Sub WriteIniSection(Filename As String, Section As String, Value As String)
WritePrivateProfileSection Section, Value, Filename
End Sub
'********************************************************************************
'** 函数功能:从ini配置文件中读取指定段名、关键字名的值
'** 调用语法: GetInIKeyValue(SectionName as string,KeyName As String,FileName As String)
'** 参数说明:
'** SectionName :段名
'** KeyName :关键字名
'** FileName :ini文件名包括路径
'** 返 回 值:
'** String :返回关键字值
'** 处理说明:
'** 调用API函数GetPrivateProfileString
'******************************************************************************
Public Function GetInIKeyValue(ByVal SectionName As String, _
ByVal KeyName As String, _
ByVal FileName As String) As String
Dim KeyValue$
Dim strTmp As String
'********************************************************************************
'** 函数功能:从ini配置文件中写入指定段名、关键字名及值
'** 调用语法: SetInIKeyValue(SectionName as string,KeyName As String,KeyValue as string ,FileName As String)
'** 参数说明:
'** SectionName :段名
'** KeyName :关键字名
'** KeyValue :关键字值
'** FileName :ini文件名包括路径
'** 返 回 值:
'** 处理说明:
'** 调用API函数WritePrivateProfileString
'******************************************************************************
Public Sub SetInIKeyValue(ByVal SectionName As String, _
ByVal KeyName As String, _
ByVal KeyValue As String, _
ByVal FileName As String)
Dim lng As Long
lng = WritePrivateProfileString(SectionName, KeyName, KeyValue, FileName)
End Sub
'两个函数 , 先在一个模快中定义API函数
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal LpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
'如果是读INT值可以用字符串转化,所以没有另外定义函数
'Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, ByVal LpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal LpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'定义读与写INI文件的函数
'****读INI文件****
'文件名 lpFileName 如果不存在会自己创建,如果只有文件名,默认在Windows\system目录下
'[lpAppName]
'lpKeyName=取回的设置值
'lpDefault 当键值不存在时的默认值
Public Function ReadINI(lpFileName As String, lpAppName As String, LpKeyName As String) As String
Dim Temp As String * 20
Dim lpDefault As String
lpDefault = ""
If GetPrivateProfileString(lpAppName, LpKeyName, lpDefault, Temp, Len(Temp), lpFileName) <= 0 Then
ReadINI = ""
Else
ReadINI = MyTrim(Temp) 'MyTrim函数见下
End If
End Function
'****写INI文件****
'[lpAppName]
'lpKeyName=lpString
Public Function WriteINI(lpFileName As String, lpAppName As String, LpKeyName As String, lpString As String) As Boolean
If WritePrivateProfileString(lpAppName, LpKeyName, lpString, lpFileName) = 0 Then
WriteINI = False
Else
WriteINI = True
End If
End Function
'包含三个函数,分别取Rtrim,Ltrim,Trim
'可以去字符串中如ASC码为0,10,13,32的字符
Public Function MyRtrim(Tmpstr As String)
Dim i, s As Integer
i = Len(Tmpstr)
If i = 0 Then
MyRtrim = ""
Exit Function
End If
s = Asc(Right(Tmpstr, 1))
While (s = 0 Or s = 13 Or s = 10 Or s = 32) And i > 0
i = i - 1
Tmpstr = Left(Tmpstr, i)
If Len(Tmpstr) = 0 Then
MyRtrim = ""
Exit Function
End If
s = Asc(Right(Tmpstr, 1))
Wend
MyRtrim = Tmpstr
End Function
Public Function MyLtrim(Tmpstr As String)
Dim i, s As Integer
i = Len(Tmpstr)
If i = 0 Then
MyLtrim = ""
Exit Function
End If
s = Asc(Left(Tmpstr, 1))
While (s = 0 Or s = 13 Or s = 10 Or s = 32) And i > 0
i = i - 1
Tmpstr = Right(Tmpstr, i)
If Len(Tmpstr) = 0 Then
MyLtrim = Tmpstr
Exit Function
End If
s = Asc(Left(Tmpstr, 1))
Wend
MyLtrim = Tmpstr
End Function
Public Function MyTrim(Tmpstr As String)
Tmpstr = MyLtrim(Tmpstr)
Tmpstr = MyRtrim(Tmpstr)
MyTrim = Tmpstr
End Function