 |
Option Explicit
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 Declare Function WritePrivateProfileSection Lib _
"kernel32" Alias "WritePrivateProfileSectionA" _
(ByVal lpAppName As String, ByVal lpString As _
String, ByVal lpFileName 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 File$, Field() As String
Private Sub Form_Load()
Dim X%
File = App.Path & "\Test.ini"
Frame1.Caption = File
Text1.Text = "Section1"
Text2.Text = "Key1"
Text3.Text = "Hallo wie gehts?"
Text5.Text = "Section1"
Text6.Text = "Key1"
Text7.Text = ""
Text8.Text = "Section2"
Text4.Text = "Section2"
ReDim Field(0 To 5)
Field(0) = "Bananen"
Field(1) = "Gurken"
Field(2) = "Erdbeeren"
Field(3) = "Bohnen"
Field(4) = "Äpfel"
Field(5) = "Kartoffeln"
For X = 0 To UBound(Field)
List1.AddItem Field(X)
Next X
List2.Clear
End Sub
Private Sub Command1_Click()
Call INISetValue(File, Text1.Text, Text2.Text, Text3.Text)
Call INISetArray(File, Text4.Text, Field)
End Sub
Private Sub Command2_Click()
Dim X%, xArray$()
Text7.Text = INIGetValue(File, Text5.Text, Text6.Text)
ReDim xArray(0)
Call INIGetArray(File, Text8.Text, xArray)
List2.Clear
If UBound(xArray) > 0 Then
For X = 0 To UBound(xArray) - 1
List2.AddItem xArray(X)
Next X
End If
End Sub
Private Sub Command3_Click()
Call INIDeleteKey(File, Text5.Text, Text6.Text)
Call Command2_Click
End Sub
Private Sub Command4_Click()
Call INIDeleteSection(File, Text5.Text)
Call INIDeleteSection(File, Text8.Text)
Call Command2_Click
End Sub
Private Sub INISetValue(ByVal Path$, ByVal Sect$, ByVal Key$, _
ByVal Value$)
Dim Result&
Result = WritePrivateProfileString(Sect, Key, Value, Path)
End Sub
Private Function INIGetValue(ByVal Path$, ByVal Sect$, ByVal Key$) _
As String
Dim Result&, Buffer$
Buffer = Space$(32)
Result = GetPrivateProfileString(Sect, Key, vbNullString, _
Buffer, Len(Buffer), Path)
INIGetValue = Left$(Buffer, Result)
End Function
Private Function INISetArray(ByVal Path$, ByVal Sect$, xArray() _
As String)
Dim X%, Buffer$, Result&
For X = LBound(xArray) To UBound(xArray)
Buffer = Buffer & xArray(X) & Chr$(0)
Next X
Buffer = Left$(Buffer, Len(Buffer) - 1)
Result = WritePrivateProfileSection(Sect, Buffer, Path)
End Function
Private Sub INIGetArray(ByVal Path$, ByVal Sect$, xArray() As String)
Dim Result&, Buffer$
Dim l%, p%, z%
Buffer = Space(32767)
Result = GetPrivateProfileSection(Sect, Buffer, Len(Buffer), Path)
Buffer = Left$(Buffer, Result)
If Buffer <> "" Then
l = 1
ReDim xArray(0)
Do While l < Result
p = InStr(l, Buffer, Chr$(0))
If p = 0 Then Exit Do
xArray(z) = Mid$(Buffer, l, p - l)
z = z + 1
ReDim Preserve xArray(0 To z)
l = p + 1
Loop
End If
End Sub
Private Sub INIDeleteKey(ByVal Path$, ByVal Sect$, ByVal Key$)
Call WritePrivateProfileString(Sect, Key, 0&, Path)
End Sub
Private Sub INIDeleteSection(ByVal Path$, ByVal Sect$)
Call WritePrivateProfileString(Sect, 0&, 0&, Path)
End Sub
|
