Attribute VB_Name = "TextReadWrite"
Option Explicit

' Wird benötigt, zum Ermitteln des temporären
' Verzeichnisses und zum Erstellen temporärer Dateien
Private Declare Function GetTempFileName Lib "kernel32" _
  Alias "GetTempFileNameA" (ByVal lpszPath As String, _
  ByVal lpPrefixString As String, _
  ByVal wUnique As Long, _
  ByVal lpTempFileName As String) As Long

Private Declare Function GetTempPath Lib "kernel32.dll" _
  Alias "GetTempPathA" (ByVal nBufferLength As Long, _
  ByVal lpBuffer As String) As Long

Private Declare Function DeleteFile Lib "kernel32.dll" Alias "DeleteFileA" _
  (ByVal lpFileName As String) As Long

Private winTempPath As String

' Ermittelt einen temporären Dateinamen
' im temporären Verzeichnis
Private Function txt_TempFilename() As String

  Dim myTempFileName As String
  Dim RetVal As Long
  
  If winTempPath = "" Then
    ' Temporäres Verzeichnis ermitteln
    winTempPath = Space$(256)
    RetVal = GetTempPath(Len(winTempPath), winTempPath)
    winTempPath = Left$(winTempPath, RetVal)
  End If
  
  ' Temporären Dateinamen ermitteln
  myTempFileName = Space$(256)
  Call GetTempFileName(winTempPath, "txt", 0&, myTempFileName)
  myTempFileName = Left$(myTempFileName, _
    InStr(myTempFileName, Chr$(0)) - 1)
  
  txt_TempFilename = myTempFileName

End Function

' Lesen des gesamten Inhaltes einer Textdatei
' sFilename:  vollständiger Dateiname
' =========================================================
Public Function txt_ReadAll(ByVal sFilename As String) _
  As String

  Dim F As Integer
  Dim sInhalt As String
  
  ' Existiert die Datei ?
  If Dir$(sFilename, vbNormal) <> "" Then
    ' Textdatei im Binärmodus öffnen und gesamten
    ' Inhalt in einem Rutsch auslesen
    F = FreeFile
    Open sFilename For Binary As #F
    sInhalt = Space$(LOF(F))
    Get #F, , sInhalt
    Close #F
  End If
  
  txt_ReadAll = sInhalt

End Function

' Beliebigen Text in eine Textdatei speichern, wobei
' der bisherige Inhalt der Textdatei vollständig
' überschrieben wird
'
' sFilename:  vollständiger Dateiname
' sLines   :  Inhalt, der gespeichert werden soll
' ===============================================
Public Sub txt_WriteAll(ByVal sFilename As String, _
  ByVal sLines As String)

  Dim F As Integer
  
  ' Datei zum Schreiben öffnen
  ' Achtung: bisheriger Inhalt wird gelöscht!
  F = FreeFile
  Open sFilename For Output As #F
  Print #F, sLines
  Close #F

End Sub

' Einzelne Zeile an eine Textdatei anhängen
' sFilename:  vollständiger Name der Datei
' sLine    :  Inhalt, der gespeichert werden soll
' ===============================================
Public Sub txt_AppendLine(ByVal sFilename As String, _
  ByVal sLine As String)

  Dim F As Integer
  
  ' Datei zum "Anhängen" von Daten öffnen
  ' und Textzeile ans Ende anfügen
  F = FreeFile
  Open sFilename For Append As #F
  Print #F, sLine
  Close #F

End Sub

' Lesen einer bestimmten Zeile einer Textdatei
' sFilename:  vollständiger Dateiname
' LineToRead: Zeile, deren Inhalt zurückgegeben werden soll
' =========================================================
Public Function txt_ReadLine(ByVal sFilename As String, _
  ByVal LineToRead As Long) As String

  Dim F As Integer
  Dim sLine As String
  Dim lRow As Long

  lRow = 0
  ' Existiert die Datei ?
  If Dir$(sFilename) <> "" Then
  
    ' Datei zum Lesen öffnen
    F = FreeFile
    Open sFilename For Input As #F
    
    ' Solange einlesen, bis entweder Dateiende
    ' oder gewünschte Zeilennummer erreicht
    While Not EOF(F) And lRow < LineToRead
      lRow = lRow + 1
      Line Input #F, sLine
    Wend
    Close #F
  End If
  
  ' Dateiende wurde frühzeitig erreicht,
  ' oder Datei war nicht vorhanden
  If lRow < LineToRead Then _
    sLine = ""

  txt_ReadLine = sLine

End Function

' Einzelne Zeile in eine Textdatei speichern
' sFilename:  vollständiger Name der Datei
' LinePos  :  Zeilenummer in der Textdatei
' sLine    :  Inhalt, der gespeichert werden soll
' ===============================================
Public Sub txt_WriteLine(ByVal sFilename As String, _
  ByVal LinePos As Long, ByVal sLine As String)

  Dim F As Integer
  Dim n As Integer
  Dim i As Long
  Dim lRow As Long
  Dim Zeile As String
  Dim myTempFile As String
  
  If Dir$(sFilename, vbNormal) = "" Then
    ' Wenn Datei nicht existiert, automatisch erstellen
    ' und Inhalt sofort speichern
    F = FreeFile
    Open sFilename For Output As #F
    
    ' Datei mit Leerzeilen füllen, bis gewünschte
    ' Schreibposition erreicht ist
    For i = 1 To LinePos - 1
      Print #F, ""
    Next i
    
    ' Inhalt speichern
    Print #F, sLine
    Close #F
    
  Else
    ' Temporäre Datei erstellen
    myTempFile = txt_TempFilename()
    
    ' Original-Datei zum Lesen und temporäre
    ' Datei zum Schreiben öffnen
    F = FreeFile: Open sFilename For Input As #F
    n = FreeFile: Open myTempFile For Output As #n
    
    ' Original-Datei einlesen und x. Zeile durch
    ' neuen Inhalt ersetzen
    lRow = 0
    While Not EOF(F)
      lRow = lRow + 1
      Line Input #F, Zeile
      
      If lRow = LinePos Then
        ' x. Zeile durch neuen Inhalt ersetzen
        Zeile = sLine
      End If
      
      Print #n, Zeile
    Wend
    
    ' sollte LinePos größer sein, als die bisherige
    ' Anzahl gespeicherter Zeilen in der Orginaldatei
    ' wurde der neue Inhalt noch nicht gespeichert
    ' und die Datei muss ggf. noch mit zusätzlichen
    ' Leerzeilen gefüllt werden!
    If lRow < LinePos Then
      ' Ggf. mit Leerzeilen füllen
      For i = lRow + 1 To LinePos - 1
        Print #n, ""
      Next i
      
      ' Neuen Zeilen-Inhalt speichern
      Print #n, sLine
    End If
    
    ' Dateien schliessen
    Close #F: Close #n
    
    ' Alte Datei löschen
    DeleteFile sFilename
    
    ' temporäre Datei in "alte" Datei umbenennen
    FileCopy myTempFile, sFilename
    DeleteFile myTempFile
  End If

End Sub


