====== INI-Datei ======
Neben der [[/Registry|Registry ]]bietet auch eine INI-Datei, d. h. eine strukturierte Textdatei, die Möglichkeit Werte abzuspeichern und wieder auszulesen.
==== Werte aus einer INI-Datei lesen ====
Function ReadIni( myFilePath, mySection, myKey )
' www.robvanderwoude.com/vbstech_files_ini.php
' This function returns a value read from an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be returned
'
' Returns:
' the [string] value for the specified key in the specified section
'
' CAVEAT: Will return a space if key exists but value is blank
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
' Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
' Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
' Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
' Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
' In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
' Abort loop when item is found
Exit Do
End If
End If
' Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
' Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
End If
End Function
**Hinweis**: Die Datei wird als ASCII geöffnet. Um die Datei zwingen als ASCII- oder Unicode-Datei oder entsprechend dem Systemstandard zu öffnen, kann //OpenTextFile// - wie [[http://msdn.microsoft.com/en-us/library/314cz14s(v=vs.85).aspx|hier]] beschrieben - um einen weiteren Parameter ergänzt werden.
==== Werte in eine INI-Datei schreiben ====
Sub WriteIni( myFilePath, mySection, myKey, myValue )
' http://www.robvanderwoude.com/vbstech_files_ini.php
' This subroutine writes a value to an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be written
' myValue [string] the value to be written (myKey will be
' deleted if myValue is )
'
' Returns:
' N/A
'
' CAVEAT: WriteIni function needs ReadIni function to run
'
'To delete a key in an INI file, use WriteINI with a value "".
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
Dim intEqualPos
Dim objFSO, objNewIni, objOrgIni, wshShell
Dim strFilePath, strFolderPath, strKey, strLeftString
Dim strLine, strSection, strTempDir, strTempFile, strValue
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
strValue = Trim( myValue )
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set wshShell = CreateObject( "WScript.Shell" )
strTempDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
blnInSection = False
blnSectionExists = False
' Check if the specified key already exists
blnKeyExists = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
blnWritten = False
' Check if path to INI file exists, quit if not
strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
If Not objFSO.FolderExists ( strFolderPath ) Then
WScript.Echo "Error: WriteIni failed, folder path (" _
& strFolderPath & ") to ini file " _
& strFilePath & " not found!"
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
WScript.Quit 1
End If
While objOrgIni.AtEndOfStream = False
strLine = Trim( objOrgIni.ReadLine )
If blnWritten = False Then
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
blnSectionExists = True
blnInSection = True
ElseIf InStr( strLine, "[" ) = 1 Then
blnInSection = False
End If
End If
If blnInSection Then
If blnKeyExists Then
intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
If LCase( strLeftString ) = LCase( strKey ) Then
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
End If
If Not blnWritten Then
objNewIni.WriteLine strLine
End If
Else
objNewIni.WriteLine strLine
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
Else
objNewIni.WriteLine strLine
End If
Wend
If blnSectionExists = False Then ' section doesn't exist
objNewIni.WriteLine
objNewIni.WriteLine "[" & strSection & "]"
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
End If
objOrgIni.Close
objNewIni.Close
' Delete old INI file
objFSO.DeleteFile strFilePath, True
' Rename new INI file
objFSO.MoveFile strTempFile, strFilePath
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
Set wshShell = Nothing
End Sub
**Beispiel:**
'FFSubmenu=Test
'FFName=INI bearbeiten
' die Datei test.ini muss bereits existieren!
WriteIni "D:\1\test.ini", "Section1", "Key1", "2000" ' einen Schlüssel anlegen und Wert schreiben
WriteIni "D:\1\test.ini", "Section1", "Key2", "" ' einen Schlüssel löschen
Msgbox ReadIni ("D:\1\test.ini", "Section1", "Key1") ' eine Wert auslesen
==== INI-Section expotieren ====
Sub INISectionExport (inifile, section, exportfile)
' kopiert eine INI-Section mit allen Untereinträgen in eine Datei
' der bisherige Inhalt der Datei wird überschrieben
Const ForReading = 1, ForWriting = 2
Dim fso, f1, f2
Dim saveline, iniarray, i
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.OpenTextFile(inifile, ForReading)
If fso.FileExists(exportfile) Then
Set f2 = fso.OpenTextFile(exportfile, ForWriting)
Else
fso.CreateTextFile exportfile, True
Set f2 = fso.OpenTextFile(exportfile, ForWriting)
End If
iniarray = Split(f1.ReadAll, vbNewLine)
saveline = 0
For i = 0 to UBound(iniarray)
If InStr(iniarray(i), section) Then saveline = 1 ' Sektion beginnt
If InStr(iniarray(i), "[") and Not InStr(iniarray(i), section) Then saveline = 0 ' Sektion endet
If saveline = 1 Then
f2.WriteLine iniarray(i)
End If
Next
f1.Close
f2.Close
Set f2 = Nothing
Set f1 = Nothing
End Sub
==== INI-Section importieren ====
Sub INISectionImport (inifile, importfile)
' importiert eine INI-Section aus eine Datei
' es wird nicht geprüft, ob eine gleichnamige Section bereits vorhanden ist
Const ForReading = 1, ForAppending = 8
Dim fso, f1, f2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.OpenTextFile(inifile, ForAppending)
Set f2 = fso.OpenTextFile(importfile, ForReading)
Do While f2.AtEndOfStream <> True
f1.WriteLine f2.ReadLine
Loop
f1.Close
f2.Close
Set f1 = Nothing
Set f2 = Nothing
End Sub
==== INI-Section löschen ====
Sub INISectionDelet (inifile, section)
' löscht eine INI-Section mit allen Untereinträgen
Const ForReading = 1, ForWriting = 2
Dim fso, f1
Dim delline, iniarray, i
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.OpenTextFile(inifile, ForReading)
iniarray = Split(f1.ReadAll, vbNewLine)
For i = 0 to UBound(iniarray)
If InStr(iniarray(i), section) Then delline = 1 ' Sektion beginnt
If InStr(iniarray(i), "[") and Not InStr(iniarray(i), section) Then delline = 0 ' Sektion endet
If delline = 1 Then
iniarray(i) = "##delline**"
End If
Next
Set f1 = fso.OpenTextFile(inifile, ForWriting)
For i = 0 to UBound(iniarray)
If iniarray(i) <> "##delline**" Then
f1.WriteLine iniarray(i)
End If
Next
f1.Close
Set f1 = Nothing
End Sub