====== File tipati in pascal ======
Autore: **//Fabio Di Matteo//** \\ Ultima revisione: **//06/05/2007//**
PresenterĂ² la gestione dei file tipati mediante un esempio concreto, la classica rubrica.
L'esempio che segue tiene conto di due file main.pas e rubrica.pas,per adesso andiamo cominciamo con il guardare il blocco principale, il file main.pas :
===== Main.pas =====
program MainFile;
uses rubrica; //usa un file chiamato rubrica.pas
var scelta,i : integer;
contatto : persona;
nom :string[20];
Vecchionum,NuovoNum : string[10];
l : char;
begin
scelta:=-1;
while scelta<>0 do begin
for i:=0 to 5 do writeln('');
writeln(' - Menu del programma - ');
writeln('');
writeln('1) Aggiungi nominativo');
writeln('2) Visualizza rubrica');
writeln('3) Cerca numeri per nominativo');
writeln('4) Modifica numero');
writeln('5) Cancella contatto');
writeln('6) Ricerca per prima lettera');
writeln('');
writeln(' 0) Esci');
write('>> ');
readln(scelta);
if scelta=1 then
begin
write('Nominativo -> ');
readln(contatto.nominativo);
write('tel -> ');
readln(contatto.tel);
Inserisci(contatto);
end;
if scelta=2 then visualizza(contatto);
if scelta=3 then
begin
write('Inserisci nominativo -> ');
readln(nom);
CercaNumeri(contatto,nom);
end;
if scelta=4 then
begin
write('Inserisci numero da modificare -> ');
readln(VecchioNum);
writeln('Inserisci NUOVO numero -> ');
readln(NuovoNum);
ModificaNumero(contatto,Vecchionum,NuovoNum);
end;
if scelta=5 then
begin
Write('Inserisci Nominativo da eliminare -> ');
readln(nom);
CancellaContatto(contatto,nom);
end;
if scelta=6 then
begin
write('Inserisci una lettera -> ');
readln(l);
Unalettera(contatto,l)
end;
end;
writeln('programma terminato.')
end.
===== rubrica.pas =====
unit rubrica;
interface
uses sysutils;
type persona = record
nominativo : string[20];
tel : string[10];
end;
rubricas = file of persona;
procedure Inserisci(p :persona);
procedure Visualizza(var p :persona );
procedure CercaNumeri(var p : persona; nom:string[20]);
procedure ModificaNumero(var p : persona; vecchionum:string[10];NuovoNum:string[10]);
procedure CancellaContatto(var p : persona; Nom:string[20]);{da rivedere}
procedure Unalettera(var p : persona; l:char );
implementation
procedure Inserisci(p :persona );
var a : rubricas;
begin
assign(a,'rubrica.dat');
if fileExists('rubrica.dat') then
begin
reset(a); {apre senza sovrascivere}
seek(a,filesize(a));{va alla fine}
write(a,p);{non usare readln o writeln per i file tipati}
close(a);
end
else begin
rewrite(a);
write(a,p);
write(a,p);
close(a);
end;
end; { Inserisci }
procedure Visualizza(var p : persona);
var a : rubricas;
begin
assign(a,'rubrica.dat');
if not fileExists('rubrica.dat') then
begin
writeln('La rubrica risulta vuota');
end
else begin
reset(a);
writeln('Nom. telefono ');
writeln('______________________');
while not eof(a) do
begin
read(a,p);{non usare readln o writeln per i file tipati}
if p.nominativo <> '' then writeln(p.nominativo,' | ',p.tel);
end;
close(a);
end;
end; { Visualizza }
procedure CercaNumeri(var p : persona; nom:string[20]);
var a : rubricas;
begin
assign(a,'rubrica.dat');
if not fileExists('rubrica.dat') then
begin
writeln('la rubrica risulta essere vuota!');
end
else begin
reset(a);
while not eof(a) do
begin
read(a,p);
if p.nominativo=nom then writeln(p.nominativo,' | ',p.tel);
end;
close(a);
end;
end; { CercaNumeri }
procedure ModificaNumero(var p : persona; vecchionum:string[10];NuovoNum:string[10]);
var a : rubricas;
begin
assign(a,'rubrica.dat');
writeln('Ricerca numero in corso...');
reset(a);
while not eof(a) do
begin
read(a,p);
if p.tel=Vecchionum then
begin
write('Inserisci nuovo numero per ',p.nominativo, ' -> ');
p.tel:=NuovoNum;
seek(a,filepos(a)-1);{mi sposto di una riga indietro}
write(a,p); {scrivo il campo}
end;
end;
close(a);
end; { ModificaNumero }
procedure CancellaContatto(var p : persona; Nom:string[20]);
var a : rubricas;
begin
assign(a,'rubrica.dat');
reset(a);
while not( eof(a)) do
begin
read(a,p);
if (p.nominativo=Nom) then
begin
p.nominativo:='';
p.tel:='';
seek(a,filepos(a)-1);
write(a,p);
end;
end;
close(a);
end; { CancellaContatto }
procedure Unalettera(var p : persona; l:char );
var a : rubricas;
begin
assign(a,'rubrica.dat');
reset(a);
while not eof(a) do
begin
read(a,p);
if p.nominativo[1]=l then writeln(p.nominativo,' | ',p.tel);
end;
close(a);
end;
end.