unit lima;
{$mode objfpc}{$H+}
{ unita per gestire i file di testo}
interface
type tlima=class
private
lima:text;
percorso:string;
apertura:char;
public
constructor crea;
function ApriFile(nome:string; modo:char):boolean;
procedure scrivi(fr:string);
procedure ScriviLn(fr:string);
function leggi:string;
function fine:boolean;
function GetNomeFile:string;
procedure ChiudiFile;
end;
// function cartella:string;
implementation
// uses dos;
constructor tlima.crea;
begin
percorso:='';
apertura:='X';
end;
function tlima.ApriFile(nome:string; modo:char):boolean;
var ch:boolean;
begin
percorso:=nome;
ch:=true;
apertura:=UpCase(modo);
case apertura of
'W': begin
assign(lima, percorso);
{$I-}
rewrite(lima);
{$I+}
ch:=(IOResult=0);
end;
'A': begin
assign(lima, percorso);
{$I-}
append(lima);
{$I+}
ch:=(IOResult=0);
end;
'R': begin
assign(lima, percorso);
{$I-}
reset(lima);
{$I+}
ch:=(IOResult=0);
end;
else ch:=false;
end; // fine case of
if not ch then apertura:='X';
ApriFile:=ch;
end;
procedure tlima.scrivi(fr:string);
begin
if (apertura='W') or (apertura='A') then
begin
write(lima, fr);
end;
end;
procedure tlima.ScriviLn(fr:string);
begin
if (apertura='W') or (apertura='A') then
begin
write(lima, fr+#13+#10);
end;
end;
function tlima.fine:boolean;
begin
if (apertura='W') or (apertura='A') or (apertura='R') then
begin
fine:=EOF(lima);
end
else
begin
fine:=true;
end;
end;
function tlima.GetNomeFile:string;
begin
GetNomeFile:=percorso;
end;
procedure tlima.ChiudiFile;
begin
if (apertura='W') or (apertura='A') or (apertura='R') then
begin
close(lima);
apertura:='X';
end;
end;
function tlima.leggi:string;
var fr:string;
begin
fr:='';
if apertura='R' then
begin
readln(lima, fr);
end;
leggi:=fr;
end;
function cartella:string;
var borsa:string;
begin
GetDir(0, borsa);
cartella:=borsa;
end;
begin
end.
