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 :

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.

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.