You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
355 lines
13 KiB
QBasic
355 lines
13 KiB
QBasic
Attribute VB_Name = "MVWIni"
|
|
Option Explicit
|
|
|
|
'Modul für den Zugriff auf INI-Dateien (Text-Dateien)
|
|
'© 2000-2002, INOSOFT GmbH
|
|
'Version 4.04.000
|
|
|
|
'Funktionen:
|
|
'-Read Liest einen Eintrag aus einem Bereich einer INI-Datei
|
|
'-ReadEx Liest einen Eintrag aus einem Bereich einer INI-Datei (mit Wertprüfung)
|
|
'-ReadLong Liest einen Eintrag aus einem Bereich einer INI-Datei (als Long-Wert)
|
|
'-Store Schreibt einen Eintrag in einem Bereich einer INI-Datei
|
|
'-Sections Listet alle Bereiche einer INI-Datei auf
|
|
'-Entries Ermittelt alle Einträge eines Bereiches mit Wert einer INI-Datei
|
|
'-DeleteSection Entfernt einen kompletten Bereich aus einer INI-Datei
|
|
'-DeleteEntry Entfernt einen Eintrag aus einem Bereich der INI-Datei
|
|
|
|
'Abhängigkeiten/zusätzliche Dateien:
|
|
'-CVWValue.cls Klassenmodul "CVWValue"
|
|
|
|
Private Declare Function GetPrivateProfileLong Lib "kernel32" Alias "GetPrivateProfileIntA" _
|
|
(ByVal lpApplicationName As String, _
|
|
ByVal lpKeyName As String, _
|
|
ByVal nDefault As Long, _
|
|
ByVal lpFileName As String _
|
|
) As Long
|
|
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 lpApplicationName As String, _
|
|
ByVal lpKeyName As String, _
|
|
ByVal lpString As String, _
|
|
ByVal lpFileName As String _
|
|
) As Long
|
|
|
|
|
|
|
|
Public Function Read(ByVal Section As String, _
|
|
ByVal Entry As String, _
|
|
Optional ByVal Default As String = "", _
|
|
Optional ByVal FileName As String = "" _
|
|
) As String
|
|
'Liest einen Eintrag aus einem Bereich einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' Entry: Name des Eintrags
|
|
' Default: Rückgabewert, wenn Datei, Eintrag oder Bereich nicht existiert
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden.
|
|
' FileName: Pfad und Name der INI-Datei
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden,
|
|
' dann wird der Programmpfad und -name verwendet.
|
|
'Ausgabe:
|
|
' Read: Wert des angegebenen Eintrags aus der Datei
|
|
' oder Wert des Parameters Default.
|
|
|
|
Dim lR As Long, scBuffer As String * 1000
|
|
|
|
lR = GetPrivateProfileString(Section, Entry, Default, scBuffer, Len(scBuffer), IniFileName(FileName))
|
|
If Len(Section) = 0 Or Len(Entry) = 0 Then
|
|
Read = Default
|
|
Else
|
|
Read = Left$(scBuffer, lR)
|
|
End If
|
|
End Function
|
|
|
|
Public Function ReadEx(ByVal Section As String, _
|
|
ByVal Entry As String, _
|
|
ByVal DataType As VbVarType, _
|
|
Optional ByVal Default As Variant = "", _
|
|
Optional ByVal FileName As String = "", _
|
|
Optional ByVal Minimum As Variant, _
|
|
Optional ByVal Maximum As Variant _
|
|
) As Variant
|
|
'Liest einen Eintrag aus einem Bereich einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' Entry: Name des Eintrags
|
|
' DataType: Festlegung des Visual-Basic-Datentyps für den Rückgabewert
|
|
' Default: Rückgabewert, wenn Datei, Eintrag oder Bereich nicht existiert
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden.
|
|
' FileName: Pfad und Name der INI-Datei
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden,
|
|
' dann wird der Programmpfad und -name verwendet.
|
|
'Ausgabe:
|
|
' ReadEx: Wert des angegebenen Eintrags aus der Datei
|
|
' oder Wert des Parameters Default
|
|
' oder False/0/0.0/""/00:00:00 (je nach Datentyp) wenn Default und Dateieintrag fehlen.
|
|
|
|
Dim lR As Long, scBuffer As String * 1000
|
|
Dim s As String
|
|
|
|
On Error GoTo errReadEx
|
|
|
|
lR = GetPrivateProfileString(Section, Entry, "", scBuffer, Len(scBuffer), IniFileName(FileName))
|
|
If lR = 0 Then
|
|
s = Default
|
|
Else
|
|
s = Left$(scBuffer, lR)
|
|
End If
|
|
Select Case DataType
|
|
Case vbBoolean, vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbDate
|
|
Select Case DataType
|
|
Case vbBoolean
|
|
'Boolean-Werte werden als 0 und 1 abgespeichert.
|
|
ReadEx = CBool(Val(s))
|
|
Case vbByte
|
|
ReadEx = CByte(Val(s))
|
|
Case vbInteger
|
|
ReadEx = CInt(Val(s))
|
|
Case vbLong
|
|
ReadEx = CLng(Val(s))
|
|
Case vbSingle
|
|
ReadEx = CSng(Val(s))
|
|
Case vbDouble
|
|
ReadEx = CDbl(Val(s))
|
|
Case vbCurrency
|
|
ReadEx = CCur(Val(s))
|
|
Case vbDecimal
|
|
ReadEx = CDec(Val(s))
|
|
Case vbDate
|
|
'Zeit/Datum wird als Kommazahl(!!) abgespeichert, das ist unabhängig von irgendeiner Spracheinstellung!
|
|
ReadEx = CDate(CDbl(Val(s)))
|
|
End Select
|
|
Case vbString
|
|
ReadEx = s
|
|
Case Else
|
|
ReadEx = Default
|
|
End Select
|
|
|
|
If Not IsMissing(Minimum) Then
|
|
If ReadEx < Minimum Then
|
|
If IsMissing(Default) Then
|
|
ReadEx = Minimum
|
|
Else
|
|
ReadEx = Default
|
|
End If
|
|
End If
|
|
End If
|
|
If Not IsMissing(Maximum) Then
|
|
If ReadEx > Maximum Then
|
|
If IsMissing(Default) Then
|
|
ReadEx = Maximum
|
|
Else
|
|
ReadEx = Default
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
Exit Function
|
|
|
|
errReadEx:
|
|
ReadEx = Default
|
|
End Function
|
|
|
|
Public Function ReadLong(ByVal Section As String, _
|
|
ByVal Entry As String, _
|
|
Optional ByVal Default As Long = 0, _
|
|
Optional ByVal FileName As String = "", _
|
|
Optional ByVal Minimum As Variant, _
|
|
Optional ByVal Maximum As Variant _
|
|
) As Long
|
|
'Liest einen Eintrag aus einem Bereich einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' Entry: Name des Eintrags
|
|
' Default: Rückgabewert, wenn Datei, Eintrag oder Bereich nicht existiert
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden.
|
|
' FileName: Pfad und Name der INI-Datei
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden,
|
|
' dann wird der Programmpfad und -name verwendet.
|
|
' Minimum/Maximum: Grenzen, in denen der Wert liegen muss,
|
|
' andernfalls wird der Default-Wert zurückgegeben
|
|
'Ausgabe:
|
|
' ReadLong: Wert des angegebenen Eintrags aus der Datei
|
|
' oder Wert des Parameters sVorgabe.
|
|
|
|
ReadLong = GetPrivateProfileLong(Section, Entry, Default, IniFileName(FileName))
|
|
If Not IsMissing(Minimum) Then
|
|
If ReadLong < Minimum Then
|
|
ReadLong = Default
|
|
End If
|
|
End If
|
|
If Not IsMissing(Maximum) Then
|
|
If ReadLong > Maximum Then
|
|
ReadLong = Default
|
|
End If
|
|
End If
|
|
End Function
|
|
|
|
Public Sub Store(ByVal Section As String, _
|
|
ByVal Entry As String, _
|
|
ByVal Value As Variant, _
|
|
Optional ByVal FileName As String = "" _
|
|
)
|
|
'Schreibt einen Eintrag in einem Bereich einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' Entry: Name des Eintrags
|
|
' Value: neuer Wert des Eintrags
|
|
' FileName: Pfad und Name der INI-Datei
|
|
' Dieser Parameter kann beim Aufruf weggelassen werden,
|
|
' dann wird der Programmpfad und -name verwendet.
|
|
'Ausgabe:
|
|
' keine
|
|
|
|
Dim s As String
|
|
|
|
If IsNull(Value) Or IsEmpty(Value) Then
|
|
Value = vbNullString
|
|
End If
|
|
|
|
Select Case VarType(Value)
|
|
Case vbBoolean
|
|
'Boolean-Werte werden als 0 und 1 abgespeichert.
|
|
s = Abs(Value)
|
|
Case vbByte, vbInteger, vbLong
|
|
s = CStr(Value)
|
|
Case vbSingle, vbDouble, vbCurrency, vbDecimal
|
|
'Kommazahlen werden mit Punkt (.) als Dezimalzeichen abgespeichert
|
|
s = Trim(Str(Value))
|
|
Case vbDate
|
|
'Zeit/Datum wird als Kommazahl(!!) abgespeichert, das ist unabhängig von irgendeiner Spracheinstellung!
|
|
s = Trim(Str(CDbl(Value)))
|
|
Case Else
|
|
s = Value
|
|
End Select
|
|
|
|
WritePrivateProfileString Section, Entry, s, IniFileName(FileName)
|
|
WritePrivateProfileString vbNullString, vbNullString, vbNullString, IniFileName(FileName)
|
|
End Sub
|
|
|
|
Public Function Sections(Optional ByVal FileName As String = "" _
|
|
) As Collection
|
|
'Listet alle Bereiche einer INI-Datei auf.
|
|
'Eingabe:
|
|
' FileName: Name der INI-Datei (siehe Funktion IniFileName)
|
|
'Ausgabe:
|
|
' Sections: Sammlung der Bereiche (Strings)
|
|
|
|
Dim scBuffer As String * 1000, lR As Long
|
|
Dim nPos1 As Integer, nPos2 As Integer
|
|
Dim col As New Collection
|
|
|
|
lR = GetPrivateProfileString(vbNullString, vbNullString, "", scBuffer, Len(scBuffer), IniFileName(FileName))
|
|
|
|
If lR Then
|
|
nPos1 = 0
|
|
Do
|
|
nPos2 = InStr(nPos1 + 1, scBuffer, vbNullChar)
|
|
If nPos2 = nPos1 + 1 Then Exit Do
|
|
col.Add Mid$(scBuffer, nPos1 + 1, nPos2 - nPos1 - 1)
|
|
nPos1 = nPos2
|
|
Loop
|
|
End If
|
|
Set Sections = col
|
|
End Function
|
|
|
|
Public Function Entries(ByVal Section As String, _
|
|
Optional ByVal FileName As String = "" _
|
|
) As Collection
|
|
'Ermittelt alle Einträge eines Bereiches mit Wert einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' FileName: Name der INI-Datei (siehe Funktion IniFileName)
|
|
'Ausgabe:
|
|
' Entries: Sammlung mit CVWValue-Einträgen, enthält jeweils Name und Wert des Eintrags
|
|
|
|
Dim scBuffer As String * 1000, lR As Long
|
|
Dim nPos1 As Integer, nPos2 As Integer
|
|
Dim col As New Collection, clsVWValue As CVWValue
|
|
|
|
lR = GetPrivateProfileString(Section, vbNullString, "", scBuffer, Len(scBuffer), IniFileName(FileName))
|
|
|
|
If lR Then
|
|
nPos1 = 0
|
|
Do
|
|
nPos2 = InStr(nPos1 + 1, scBuffer, vbNullChar)
|
|
If nPos2 = nPos1 + 1 Then Exit Do
|
|
Set clsVWValue = New CVWValue
|
|
clsVWValue.Name = Mid$(scBuffer, nPos1 + 1, nPos2 - nPos1 - 1)
|
|
clsVWValue.Value = Read(Section, clsVWValue.Name, , FileName)
|
|
col.Add clsVWValue
|
|
nPos1 = nPos2
|
|
Loop
|
|
End If
|
|
Set Entries = col
|
|
End Function
|
|
|
|
Public Sub DeleteSection(ByVal Section As String, _
|
|
Optional ByVal FileName As String = "" _
|
|
)
|
|
'Entfernt einen kompletten Bereich aus einer INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' FileName: Name der INI-Datei (siehe Funktion IniFileName)
|
|
'Ausgabe:
|
|
' keine
|
|
|
|
WritePrivateProfileString Section, vbNullString, vbNullString, IniFileName(FileName)
|
|
WritePrivateProfileString vbNullString, vbNullString, vbNullString, IniFileName(FileName)
|
|
End Sub
|
|
|
|
Public Sub DeleteEntry(ByVal Section As String, _
|
|
ByVal Entry As String, _
|
|
Optional ByVal FileName As String = "" _
|
|
)
|
|
'Entfernt einen Eintrag aus einem Bereich der INI-Datei.
|
|
'Eingabe:
|
|
' Section: Name des Bereiches
|
|
' Entry: Name des Eintrags
|
|
' FileName: Name der INI-Datei (siehe Funktion IniFileName)
|
|
'Ausgabe:
|
|
' keine
|
|
|
|
If Len(Section) = 0 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
WritePrivateProfileString Section, Entry, vbNullString, IniFileName(FileName)
|
|
WritePrivateProfileString vbNullString, vbNullString, vbNullString, IniFileName(FileName)
|
|
End Sub
|
|
|
|
Private Function IniFileName(ByVal FileName As String) As String
|
|
'Ermittelt den Dateinamen der Ini-Datei.
|
|
'Eingabe:
|
|
' FileName: Name der INI-Datei (siehe Funktion IniFileName)
|
|
'Ausgabe:
|
|
' IniFileName: Ermittelter Dateiname.
|
|
|
|
On Error GoTo errIniFileName
|
|
|
|
If Len(FileName) = 0 Then
|
|
'kein Dateiname angegeben => Applikationspfad und -name mit Endung .ini
|
|
IniFileName = App.Path & "\" & App.EXEName & ".ini"
|
|
Else
|
|
If InStr(FileName, "\") = 0 Then
|
|
'kein Pfad angegeben => Applikationspfad davorhängen
|
|
IniFileName = App.Path & "\" & FileName
|
|
Else
|
|
IniFileName = FileName
|
|
End If
|
|
End If
|
|
Exit Function
|
|
|
|
errIniFileName:
|
|
Err.Raise vbObjectError + 1000, , "Cannot determine INI file name. Use method VWSetHostApp to connect VWTools library to your application."
|
|
End Function
|
|
|