|
Option Explicit
Private 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) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" (ByVal Section As String, _
ByVal Key As String, ByVal Setting As String, ByVal FileName _
As String) As Long
Private Const TXT_DELIMITER As String = "~|~"
Private Function GetINIFileName() As String
Const INI_FILENAME As String = "Beispiel.ini"
Dim strPath As String
strPath = App.Path
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
GetINIFileName = strPath & INI_FILENAME
End Function
Public Function GetUserDataINI(ByVal Frm As Object) As Boolean
Dim strINIFileName As String
Dim strINISection As String
Dim ctl As Control
Dim strCtlName As String
Dim blnIsArray As Boolean
Dim strValue As String
Dim nRetVal As Long
strINIFileName = GetINIFileName
If Len(Dir(strINIFileName, vbNormal)) = 0 Then
Exit Function
End If
strINISection = Frm.Name
For Each ctl In Frm.Controls
strCtlName = ctl.Name
On Error Resume Next
blnIsArray = False
blnIsArray = CBool(Frm.Controls(strCtlName).Count)
On Error GoTo 0
If blnIsArray Then
strCtlName = strCtlName & "(" & CStr(ctl.Index) & ")"
End If
strValue = Space$(256)
nRetVal = GetPrivateProfileString(strINISection, _
strCtlName, vbNullString, strValue, Len(strValue), _
strINIFileName)
If nRetVal <> 0 Then
strValue = Left$(strValue, nRetVal)
If TypeOf ctl Is VB.TextBox Then
If InStr(1, strValue, TXT_DELIMITER) Then
strValue = VBA.Replace(strValue, TXT_DELIMITER, _
Chr$(13) + Chr$(10), 1)
End If
ctl.Text = strValue
ElseIf TypeOf ctl Is VB.ListBox Or _
TypeOf ctl Is VB.ComboBox Then
If CInt(strValue) > ctl.ListCount - 1 Then
ctl.ListIndex = 0
Else
ctl.ListIndex = CInt(strValue)
End If
ElseIf TypeOf ctl Is VB.CheckBox Or _
TypeOf ctl Is VB.OptionButton Then
ctl.Value = Int(strValue)
Else
End If
End If
Next
GetUserDataINI = True
End Function
Public Sub SaveUserDataINI(ByVal Frm As Object)
Dim strINIFileName As String
Dim strINISection As String
Dim ctl As Control
Dim strCtlName As String
Dim blnIsArray As Boolean
Dim varValue As Variant
strINIFileName = GetINIFileName
strINISection = Frm.Name
For Each ctl In Frm.Controls
strCtlName = ctl.Name
On Error Resume Next
blnIsArray = False
blnIsArray = CBool(Frm.Controls(strCtlName).Count)
On Error GoTo 0
If blnIsArray Then
strCtlName = strCtlName & "(" & CStr(ctl.Index) & ")"
End If
varValue = vbNullString
If TypeOf ctl Is VB.TextBox Then
varValue = ctl.Text
If InStr(1, varValue, Chr$(13) + Chr$(10)) Then
varValue = VBA.Replace(varValue, Chr$(13) + Chr$(10), _
TXT_DELIMITER, 1)
End If
ElseIf TypeOf ctl Is VB.ListBox Or _
TypeOf ctl Is VB.ComboBox Then
varValue = ctl.ListIndex
ElseIf TypeOf ctl Is VB.CheckBox Or _
TypeOf ctl Is VB.OptionButton Then
varValue = Int(ctl.Value)
Else
End If
varValue = CStr(varValue)
If Len(varValue) > 0 Then
WritePrivateProfileString strINISection, strCtlName, _
varValue, strINIFileName
End If
Next
End Sub
|
|