|
Option Explicit
Private Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal sSectionName As _
String, ByVal sKeyName As String, ByVal sDefault As String, _
ByVal sReturnedString As String, ByVal lSize As Long, _
ByVal sFileName As String) As Long
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
Dim nRetVal As Long
Dim strValue As String
Dim lngX As Long
Dim strINIFileName As String
Private Sub Form_Load()
Dim strSections() As String
On Error Resume Next
strINIFileName = ApplicationPath & "Test.ini"
strValue = Space$(8192)
nRetVal = GetPrivateProfileString(vbNullString, vbNullString, _
vbNullString, strValue, Len(strValue), strINIFileName)
If nRetVal <> 0 Then
strSections() = Split(strValue, Chr$(0))
For lngX = 0 To UBound(strSections()) - 2
List1.AddItem strSections(lngX)
Next
End If
End Sub
Function ApplicationPath() As String
ApplicationPath = App.Path & _
IIf(Right$(App.Path, 1) = "\", "", "\")
End Function
Private Sub List1_Click()
Dim strSections() As String
Dim intX As Integer
On Error Resume Next
List2.Clear
Text1.Text = ""
strValue = Space$(16384)
nRetVal = GetPrivateProfileSection(List1.List(List1.ListIndex), _
strValue, Len(strValue), strINIFileName)
If nRetVal <> 0 Then
strSections() = Split(strValue, Chr$(0))
For lngX = 0 To UBound(strSections()) - 2
intX = InStr(1, strSections(lngX), "=")
List2.AddItem Left$(strSections(lngX), intX - 1)
Next
End If
End Sub
Private Sub List2_Click()
On Error Resume Next
strValue = Space$(512)
nRetVal = GetPrivateProfileString(List1.List(List1.ListIndex), _
List2.List(List2.ListIndex), vbNullString, strValue, _
Len(strValue), strINIFileName)
If nRetVal <> 0 Then
Text1.Text = Trim$(strValue)
End If
End Sub
|
|