VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "vbFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Klasa File
'Enkapsuluje operacje odczytu i zapisu do pliku,
'Sprawdzania istnienia pliku oraz usuwania pliku
'Działające na plikach tekstowych
Private f As Integer                'Uchwyt pliku
Private opened As Boolean   'True gdy plik otwarty
Private end_file As Boolean  'True gdy koniec pliku
Private errDesc As String      'Tekst ostatniej informacji i błędach
Private File_name As String 'Nazwa pliku
'-----
Public Function OpenForRead(Filename As String) As Boolean
  'Otwiera plik do odczytu
  f = FreeFile                         'Pobierz uchwyt
  File_name = Filename        'Przechowaj nazwę pliku

  On Local Error GoTo nofile  'Obsługa błędów
  Open Filename For Input As #f
  opened = True           'Ustaw true jeśli otwarcie pliku się powiodło
oexit:
  OpenForRead = opened    'Powróć do programu głównego
  Exit Function
'--Obsługa błędów--
nofile:
  end_file = True                'Ustaw flagę końca pliku
  errDesc = Err.Description 'Przechowaj informację o błędzie
  opened = False                'Poinformuj, że plik nie został otwarty
  Resume oexit                   'Wykonaj resztę funkcji
End Function

Public Function fEof() As Boolean
  'Sprawdza czy został osiągnięty koniec pliku
  If opened Then
    fEof = EOF(f)
  Else
    fEof = True    'Gdy plik nie jest otwarty, to zawsze wartość true
  End If
End Function

Public Function readLine() As String
  Dim s As String
  'Wczytaj jeden wiersz z pliku
  If opened Then
    Line Input #f, s
    readLine = s
  Else
    readLine = ""
  End If
End Function

Public Function readToken() As String
  Dim s As String
  'Wczytaj następny token ograniczony znakiem przecinka
  If opened Then
    Input #f, s
    readToken = s
  Else
    readToken = ""
  End If
End Function

Public Sub closeFile()
  'Zamknij plik
  If opened Then
    Close #f
    opened = False
  End If
End Sub

Public Function exists(Filename As String) As Boolean
  'Zwraca wartość true gdy plik o podanej nazwie istnieje
  On Local Error GoTo exerr
  exists = Len(Dir$(Filename)) > 0
  Exit Function
exerr:
  errDesc = Err.Description
  Resume Next
End Function

Public Function getLastError() As String
  'Zwraca informację o ostatnim błędzie
  getLastError = errDesc
End Function
Public Function delete() As Boolean
  Dim success As Boolean
  'Usuwa plik
  On Local Error GoTo nodel
  If opened Then           'Zamknij przed usunięciem
    Close #f
  End If
  If exists(File_name) Then
    Kill File_name        'Usuń plik
    success = True
  Else
    errDesc = "File not found"    'Zapisz informację o błędzie
  End If
delex:
  delete = success    'Ustaw flagę
  Exit Function
'---Obsługa błędów
nodel:
  errDesc = Err.Description
  success = False
  Resume Next
End Function

Public Function OpenForWrite(fname As String) As Boolean
  File_name = fname
  On Local Error GoTo nowfile
  Open fname For Output As #f
  opened = True
owexit:
  OpenForWrite = opened
  Exit Function
nowfile:
  end_file = True
  errDesc = Err.Description
  Resume owexit
  opened = False
End Function

Public Sub printText(s As String)
  Print #f, s;
End Sub

Public Sub printLine(s As String)
  Print #f, s
End Sub

Public Sub writeText(s As String)
  Print #f, s;
End Sub

Public Sub writeLine(s As String)
  Print #f, s
End Sub

Public Sub setFilename(fname As String)
  File_name = fname
End Sub

Public Function getFilename() As String
  getFilename = File_name
End Function
