最近有用到,顺便记录下来。呵呵
![](https://i-blog.csdnimg.cn/blog_migrate/8f900a89c6347c561fdf2122f13be562.gif)
![ExpandedBlockStart.gif](https://i-blog.csdnimg.cn/blog_migrate/961ddebeb323a10fe0623af514929fc1.gif)
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 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 WritePrivateProfileString Lib " kernel32 " Alias " WritePrivateProfileStringA " (ByVal lpApplicationName As String , ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String ) As Long
Private IniFileName As String
Public ErrorMsg As String
Private 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
Public Function ReadString(Section As String , key As String , Optional Size As Long ) As String
Dim ReturnStr As String
Dim ReturnLng As Long
If Size = 0 Then Size = 50
ReadString = vbNullString
If NoIniFile() Then
Exit Function
End If
ReturnStr = Space (Size)
ReturnLng = GetPrivateProfileString(Section, key, "" , ReturnStr, Size, IniFileName)
ReadString = Left (ReturnStr, ReturnLng)
End Function
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
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 WritePrivateProfileString Lib " kernel32 " Alias " WritePrivateProfileStringA " (ByVal lpApplicationName As String , ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String ) As Long
Private IniFileName As String
Public ErrorMsg As String
Private 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
Public Function ReadString(Section As String , key As String , Optional Size As Long ) As String
Dim ReturnStr As String
Dim ReturnLng As Long
If Size = 0 Then Size = 50
ReadString = vbNullString
If NoIniFile() Then
Exit Function
End If
ReturnStr = Space (Size)
ReturnLng = GetPrivateProfileString(Section, key, "" , ReturnStr, Size, IniFileName)
ReadString = Left (ReturnStr, ReturnLng)
End Function
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