INI-Datei

Neben der Registry bietet auch eine INI-Datei, d. h. eine strukturierte Textdatei, die Möglichkeit Werte abzuspeichern und wieder auszulesen.

  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 hier beschrieben - um einen weiteren Parameter ergänzt werden.

  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 <DELETE_THIS_VALUE>)
      '
      ' Returns:
      ' N/A
      '
      ' CAVEAT:     WriteIni function needs ReadIni function to run
      '
      'To delete a key in an INI file, use WriteINI with a value "<DELETE_THIS_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 <> "<DELETE_THIS_VALUE>" 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 <> "<DELETE_THIS_VALUE>" 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 <> "<DELETE_THIS_VALUE>" 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", "<DELETE_THIS_VALUE>" ' einen Schlüssel löschen
  Msgbox ReadIni ("D:\1\test.ini", "Section1", "Key1")                ' eine Wert auslesen

  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

  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

  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