Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Option Explicit
Private Sub Command1_Click()'读取[windows] programs字符串
Dim S As String, Length As Long
S = String(1024, 0)
Length = GetProfileString("windows", "programs", "", S, Len(S))
S = Left(S, Length)
List1.Clear
List1.AddItem "programs=" & S
End Sub
Private Sub Command2_Click()'读取[windows]的所有Key
Dim S As String, Length As Long, pos As Integer
S = String(1024, 0)
Length = GetProfileString("windows", vbNullString, "", S, Len(S))
S = Left(S, Length)
List1.Clear
While Len(S) > 0
pos = InStr(S, Chr(0))
List1.AddItem Left(S, pos - 1)
S = Mid(S, pos + 1)
Wend
End Sub
Private Sub Command3_Click()'读取Win.ini的所有Section
Dim S As String, Length As Long, pos As Integer
S = String(1024, 0)
Length = GetProfileString(vbNullString, vbNullString, "", S, Len(S))
S = Left(S, Length)
List1.Clear
While Len(S) > 0
pos = InStr(S, Chr(0))
List1.AddItem Left(S, pos - 1)
S = Mid(S, pos + 1)
Wend
End Sub
#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 If
'删除一个[OPITION]
Sub DeleteSection(ByVal Section As String)
End Function
'得到一个key值
Public Function GetSettingB(ByVal Section As String, ByVal KeyName As String) As String
Dim retval As Integer
Dim t As String * 255
retval = GetPrivateProfileString(Section, KeyName, "unknown value", t, Len(t), File)
If retval > 0 Then
GetSettingB = Left$(t, retval)
Else
GetSettingB = "Unknown section or key"
End If
End Function
'得到一个[OPITION]
Public Function GetSection(ByVal Section As String, KeyArray() As String) As Integer
Dim retval As Integer
Dim t As String * 2500
Dim lastpointer As Integer
Dim nullpointer As Integer
Dim ArrayCount As Integer
Dim keystring As String
' 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
Public Function PutToINI(ByVal sApp As String, ByVal sKey As String, ByVal sValue As String) As Boolean
Dim lReturn As Long
Dim sFilename As String
sFilename = App.Path & "\" & gcsINIFileName
lReturn = WritePrivateProfileString(sApp, sKey, sValue, sFilename)
PutToINI = (lReturn = 1)
End Function
Public Function GetInINI(ByVal sApp As String, ByVal sKey As String, ByRef sValue As String) As Boolean
Dim lReturn As Long
Dim sBuffer As String
Dim sFilename As String
On Error Resume Next
sFilename = App.Path & "\" & gcsINIFileName
sBuffer = String(1024, 0)
lReturn = GetPrivateProfileString(sApp, sKey, "", sBuffer, 1024, sFilename)
sValue = Left(sBuffer, lReturn)
GetInINI = (Err.Number = 0)
End Function