下面是在一个类文件中几个封装好的函数,可能对你有用:' Exposes ' Function GetSetting ' Function SaveSetting ' Function GetSection ' ' CommentsOption Explicit' -------- ' Public ' -------- ' ' Property for file to read Public File As String' --------- ' Private ' --------- ' ' API to read/write ini's #If Win32 Then 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 Integer, ByVal lpFileName As String) As Integer Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal Filename As String) As Integer #Else Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal Filename As String) As Integer #End IfSub DeleteSection(ByVal Section As String)Dim retval As Integer retval = WritePrivateProfileString(Section, 0&, "", File)End Sub Public Function SaveSetting(ByVal Section$, ByVal key$, ByVal Value$)Dim retval As Integer SaveSetting = WritePrivateProfileString(Section$, key$, Value$, File)End FunctionPublic Function GetSetting(ByVal Section As String, ByVal KeyName As String) As StringDim retval As Integer Dim t As String * 255 ' Get the value retval = GetPrivateProfileString(Section, KeyName, "unknown value", t, Len(t), File) ' If there is one, return it If retval > 0 Then GetSetting = Left$(t, retval) Else GetSetting = "Unknown section or key" End IfEnd FunctionPublic Function GetSection(ByVal Section As String, KeyArray() As String) As IntegerDim retval As Integer ' Allocate space for return value Dim t As String * 2500 Dim lastpointer As Integer Dim nullpointer As Integer Dim ArrayCount As Integer Dim keystring As String
ReDim KeyArray(0)
' Get the value retval = GetPrivateProfileString(Section, 0&, "", t, Len(t), File)
' If there is one, return it If retval > 0 Then ' ' Separate the keys and store them in the array nullpointer = InStr(t, Chr$(0)) lastpointer = 1 Do While (nullpointer <> 0 And nullpointer > lastpointer + 1) ' ' Extract key string keystring = Mid$(t, lastpointer, nullpointer - lastpointer) ' ' Now add to array ArrayCount = ArrayCount + 1 ReDim Preserve KeyArray(ArrayCount) KeyArray(ArrayCount) = keystring ' ' Find next null lastpointer = nullpointer + 1 nullpointer = InStr(nullpointer + 1, t, Chr$(0)) Loop End If ' ' Return the number of array elements GetSection = ArrayCount
End Function
Option ExplicitPrivate 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 LongPrivate Sub Form_Load() Dim ResultString As String * 255 GetPrivateProfileString "Test", "Test", "", ResultString, 255, "C:\Q.ini" Dim s As String Dim i As Long
For i = 1 To 255 If Asc(Mid$(ResultString, i, 1)) = 0 Then Exit For Else s = s & Mid$(ResultString, i, 1) End If Next MsgBox s End Sub
GetPrivateProfileString VB声明 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) 说明 为初始化文件中指定的条目取得字串 返回值 Long,复制到lpReturnedString缓冲区的字节数量,其中不包括那些NULL中止字符。如lpReturnedString缓冲区不够大,不能容下全部信息,就返回nSize-1(若lpApplicationName或lpKeyName为NULL,则返回nSize-2) 参数表 参数 类型及说明 lpApplicationName String,欲在其中查找条目的小节名称。这个字串不区分大小写。如设为vbNullString,就在lpReturnedString缓冲区内装载这个ini文件所有小节的列表 lpKeyName String,欲获取的项名或条目名。这个字串不区分大小写。如设为vbNullString,就在lpReturnedString缓冲区内装载指定小节所有项的列表 lpDefault String,指定的条目没有找到时返回的默认值。可设为空("") lpReturnedString String,指定一个字串缓冲区,长度至少为nSize nSize Long,指定装载到lpReturnedString缓冲区的最大字符数量 lpFileName String,初始化文件的名字。如没有指定一个完整路径名,windows就在Windows目录中查找文件 注解 如lpKeyName参数为vbNullString,那么lpReturnedString缓冲区会载入指定小节所有设置项的一个列表。每个项都用一个NULL字符分隔,最后一个项用两个NULL字符中止。也请参考GetPrivateProfileInt函数的注解
其他 在vb的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 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 Sub Form_Load() 'KPD-Team 1999 'URL: http://www.allapi.net/ 'E-Mail: [email protected] Dim Ret As String, NC As Long 'Write the setting to the file (c:\test.ini) under ' Project1 -> Keyname WritePrivateProfileString App.Title, "KeyName", "This is the value", "c:\test.ini" 'Create a buffer Ret = String(255, 0) 'Retrieve the string NC = GetPrivateProfileString(App.Title, "KeyName", "Default", Ret, 255, "C:\test.ini") 'NC is the number of characters copied to the buffer If NC <> 0 Then Ret = Left$(Ret, NC) 'Show our string MsgBox Ret 'Delete the file Kill "c:\test.ini" End Sub
' Function GetSetting
' Function SaveSetting
' Function GetSection
'
' CommentsOption Explicit' --------
' Public
' --------
'
' Property for file to read
Public File As String' ---------
' Private
' ---------
'
' API to read/write ini's
#If Win32 Then
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 Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal Filename As String) As Integer
#Else
Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal Filename As String) As Integer
#End IfSub DeleteSection(ByVal Section As String)Dim retval As Integer retval = WritePrivateProfileString(Section, 0&, "", File)End Sub
Public Function SaveSetting(ByVal Section$, ByVal key$, ByVal Value$)Dim retval As Integer SaveSetting = WritePrivateProfileString(Section$, key$, Value$, File)End FunctionPublic Function GetSetting(ByVal Section As String, ByVal KeyName As String) As StringDim retval As Integer
Dim t As String * 255 ' Get the value
retval = GetPrivateProfileString(Section, KeyName, "unknown value", t, Len(t), File) ' If there is one, return it
If retval > 0 Then
GetSetting = Left$(t, retval)
Else
GetSetting = "Unknown section or key"
End IfEnd FunctionPublic Function GetSection(ByVal Section As String, KeyArray() As String) As IntegerDim retval As Integer
' Allocate space for return value
Dim t As String * 2500
Dim lastpointer As Integer
Dim nullpointer As Integer
Dim ArrayCount As Integer
Dim keystring As String
ReDim KeyArray(0)
' Get the value
retval = GetPrivateProfileString(Section, 0&, "", t, Len(t), File)
' If there is one, return it
If retval > 0 Then
'
' Separate the keys and store them in the array
nullpointer = InStr(t, Chr$(0))
lastpointer = 1
Do While (nullpointer <> 0 And nullpointer > lastpointer + 1)
'
' Extract key string
keystring = Mid$(t, lastpointer, nullpointer - lastpointer)
'
' Now add to array
ArrayCount = ArrayCount + 1
ReDim Preserve KeyArray(ArrayCount)
KeyArray(ArrayCount) = keystring
'
' Find next null
lastpointer = nullpointer + 1
nullpointer = InStr(nullpointer + 1, t, Chr$(0))
Loop
End If
'
' Return the number of array elements
GetSection = ArrayCount
End Function
Dim ResultString As String * 255
GetPrivateProfileString "Test", "Test", "", ResultString, 255, "C:\Q.ini"
Dim s As String
Dim i As Long
For i = 1 To 255
If Asc(Mid$(ResultString, i, 1)) = 0 Then
Exit For
Else
s = s & Mid$(ResultString, i, 1)
End If
Next
MsgBox s
End Sub
GetPrivateProfileString VB声明
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)
说明
为初始化文件中指定的条目取得字串
返回值
Long,复制到lpReturnedString缓冲区的字节数量,其中不包括那些NULL中止字符。如lpReturnedString缓冲区不够大,不能容下全部信息,就返回nSize-1(若lpApplicationName或lpKeyName为NULL,则返回nSize-2)
参数表
参数 类型及说明
lpApplicationName String,欲在其中查找条目的小节名称。这个字串不区分大小写。如设为vbNullString,就在lpReturnedString缓冲区内装载这个ini文件所有小节的列表
lpKeyName String,欲获取的项名或条目名。这个字串不区分大小写。如设为vbNullString,就在lpReturnedString缓冲区内装载指定小节所有项的列表
lpDefault String,指定的条目没有找到时返回的默认值。可设为空("")
lpReturnedString String,指定一个字串缓冲区,长度至少为nSize
nSize Long,指定装载到lpReturnedString缓冲区的最大字符数量
lpFileName String,初始化文件的名字。如没有指定一个完整路径名,windows就在Windows目录中查找文件
注解
如lpKeyName参数为vbNullString,那么lpReturnedString缓冲区会载入指定小节所有设置项的一个列表。每个项都用一个NULL字符分隔,最后一个项用两个NULL字符中止。也请参考GetPrivateProfileInt函数的注解
其他
在vb的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
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 Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim Ret As String, NC As Long
'Write the setting to the file (c:\test.ini) under
' Project1 -> Keyname
WritePrivateProfileString App.Title, "KeyName", "This is the value", "c:\test.ini"
'Create a buffer
Ret = String(255, 0)
'Retrieve the string
NC = GetPrivateProfileString(App.Title, "KeyName", "Default", Ret, 255, "C:\test.ini")
'NC is the number of characters copied to the buffer
If NC <> 0 Then Ret = Left$(Ret, NC)
'Show our string
MsgBox Ret
'Delete the file
Kill "c:\test.ini"
End Sub