Code:
Option Explicit'Standardname der Ini - datei:
' Ist bei Funktionsaufrufen dann Optional
Private Const cmIniStandardname = "C:\Einstellungen.ini"
'Max Länge der Werte
Private Const cmMaxStringLength = 50
'Wert, der Zurückgegeben wird, falls der Wert nicht gefunden wird
Public Const cmIniFaultValue = "!!!IniError!!!"
'Public, damit man den Fehler in anderen Prozeduren abfragen kann
'-------------------------------------------------
Private Declare PtrSafe 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 PtrSafe Function WritePrivateProfileString Lib _
"kernel32" Alias "WritePrivateProfileStringA" (ByVal _
lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpString As Any, ByVal lpFileName As String) _
As Long
' Wofür mag das sein? Na egal lassen wir's mal lieber drinne...
Private vmWert As String * cmMaxStringLength 'Es muß ein String fester Länge sein
'-------------------------------------------------
'Liest aus [section] den Wert für "zulesenderwert=" aus und gibt ihn zurueck
'Beispiel: back = getinivalue("schalter", "defosmode")
Function GetIniValue(section As String, zulesenderwert As String, Optional IniFileName As String = cmIniStandardname) As String
Call GetPrivateProfileString(section, zulesenderwert, cmIniFaultValue, vmWert, cmMaxStringLength, IniFileName)
GetIniValue = Left$(vmWert, InStr(vmWert, Chr(0)) - 1)
End Function
'Schreibt in [section] dem wert "zusetzenderwert=" den gegenwert zu.
'Beispiel: call PutIniValue("schalter", "defosmode", "20517")
'OHNE "Call" geht's nicht !!!!!! Dann krieg ich 'nen Fehler!
Sub PutIniValue(section As String, zusetzenderwert As String, ByVal gegenwert As String, Optional IniFileName As String = cmIniStandardname)
If gegenwert = "" Then gegenwert = Chr(0)
'Die Funktion schreibt den Wert nur, falls es auch einen Gegenwert gibt
'Beim Laden eines Wertes wuerde jedoch ein Fehler zurückgegeben, falls der Wert nicht existiert
Call WritePrivateProfileString(section, zusetzenderwert, gegenwert, IniFileName)
End Sub