[VB6]: Arbeiten mit Dateien

Im Folgenden ist eine Sammlung von Funktionen zu finden, die ich immer wieder benötige, wenn ich mit Dateien und Ordnern arbeite: aus Dateien lesen, schreiben usw.

Textdateien in Visual Basic

Um eine einzelne Zeile aus einer Textdatei zu lesen kann folgende Funktion benutzt werden:

Public Function ReadLine(ByVal sFile As String, _
  Optional ByVal nLine As Long = 1) As String

  Dim sLines() As String
  Dim oFSO As Object
  Dim oFile As Object
  
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrHandler
  
  ' Verweis auf das FileSystemObject erstellen
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  
  ' Existiert die Datei überhaupt?
  If oFSO.FileExists(sFile) Then
    ' Datei öffnen
    Set oFile = oFSO.opentextfile(sFile)
    
    ' Alles lesen und in Array zerlegen
    sLines = Split(oFile.ReadAll, vbCrLf)
    
    ' Datei schließen
    oFile.Close
    
    Select Case Sgn(nLine)
       ' (nLine > 0)
      Case 1
        ' n-te Zeile von vorne beginnend
        ReadLine = sLines(nLine - 1)
      
      ' (nLine < 0)
      Case -1
        ' n-te Zeile von hinten beginnend
        ReadLine = sLines(UBound(sLines) + nLine + 1)
    End Select
  End If
  
ErrHandler:
  ' Objekte zerstören
  Set oFile = Nothing
  Set oFSO = Nothing
End Function

Eine Zeite in eine Textdatei schreiben:

Binär-Dateien in Visual Basic

Um eine Binär-Datei auszulesen (also z.B. ein Bild oder eine Anwendungsdatei / .exe usw.) kann dieser Code benutzt werden:

Set fs = CreateObject("Scripting.filesystemobject")

indexfile="textdatei.txt"

fs.createtextfile (indexfile)
Set settings = fs.opentextfile(indexfile, 2, True, 0)


settings.writeline "Zeile schreiben"


settings.Close

Private Function ReadFile(ByVal sFilename As String) _
  As String
  Dim F As Integer
  Dim sInhalt As String
 
  ' Prüfen, ob Datei existiert
  If Dir$(sFilename, vbNormal) <> "" Then
    ' Datei im Binärmodus öffnen
    F = FreeFile: Open sFilename For Binary As #F
 
    ' Größe ermitteln und Variable entsprechend
    ' mit Leerzeichen füllen
    sInhalt = Space$(LOF(F))
 
    ' Gesamten Inhalt in einem "Rutsch" einlesen
    Get #F, , sInhalt
 
    ' Datei schliessen
    Close #F
  End If
 
  ReadFile = sInhalt
End Function

'read binary file As a string value
Function GetFile(FileName As String) As String
  Dim FileContents() As Byte, FileNumber As Integer
  ReDim FileContents(FileLen(FileName) - 1)
  FileNumber = FreeFile
  Open FileName For Binary As FileNumber
    Get FileNumber, , FileContents
  Close FileNumber
  GetFile = StrConv(FileContents, vbUnicode)
End Function

So ermittelt man, ob eine Datei existiert:

Public Function FileExists(ByVal FileName As String) As Boolean
    On Error Resume Next
    FileExists = Not CBool(GetAttr(FileName) And (vbDirectory Or vbVolume))
    On Error GoTo 0
End Function

Ordner in Visual Basic

Einen Ordner kann man mit folgender Funbktion vollständig löschen:

Public Function KillFolder(ByVal FullPath As String) _
   As Boolean
   
'******************************************
'PURPOSE: DELETES A FOLDER, INCLUDING ALL SUB-
'         DIRECTORIES, FILES, REGARDLESS OF THEIR
'         ATTRIBUTES

'PARAMETER: FullPath = FullPath of Folder to Delete

'RETURNS:   True is successful, false otherwise

'REQUIRES:  'VB6
            'Reference to Microsoft Scripting Runtime
            'Caution in use for obvious reasons

'EXAMPLE:   'KillFolder("D:\MyOldFiles")

'******************************************
On Error Resume Next
'Dim oFso As New Scripting.FileSystemObject
Set oFSO = CreateObject("Scripting.filesystemobject")
'deletefolder method does not like the "\"
'at end of fullpath

If Right(FullPath, 1) = "\" Then FullPath = _
    Left(FullPath, Len(FullPath) - 1)

If oFSO.FolderExists(FullPath) Then
    
    'Setting the 2nd parameter to true
    'forces deletion of read-only files
    oFSO.deletefolder FullPath, True
    
    KillFolder = Err.Number = 0 And _
      oFSO.FolderExists(FullPath) = False
End If

End Function

So ermittel man, ob ein Ordner existiert:

Public Function DirExists(ByVal DirectoryName As String) As Boolean
    On Error Resume Next
    DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
    On Error GoTo 0
End Function