![]() | ![]() |
|
|
w;
uses crt,dos;
type uno=record
cogn:string[20];
nome:string[20];
ind:string[50];
ntel:string[12];
end;
var file1:file of uno;
scelta:integer;
mat1,mat2,mat3:array[1..5,1..4] of string;
procedure crea1;
var reap:uno;
risp:char;
scelta:char;
a:Integer;
begin
assign(file1,'c:\tp\uno.dat');
reset(file1); 646i86g
if IOresult=0 then
begin
Writeln('Il File e'' gia''esistente! ');
readln;
close(file1);
end
else
begin
rewrite(file1);
repeat
repeat
clrscr;
writeln('Ricorda : Premi * per uscire');
write('Inserisci il cognome : ');
readln(reap.cogn);
if reap.cogn<>'*' then
begin
write('Inserisci il nome: ');
readln(reap.nome);
write('Inserisci l''indirizzo: ');
readln(reap.ind);
write('Inserisci il numero di telefono: ');
readln(reap.ntel);
write('I dati inseriti sono corretti? : ');
readln(risp);
end;
until (risp='s') or (reap.nome='*');
if reap.cogn<>'*' then write(file1,reap);
until reap.cogn='*';
close(file1);
end;
end;
procedure crea2;
var reap:uno;
risp:char;
scelta:char;
a:integer;
begin
assign(file1,'c:\tp\due.dat');
reset(file1); 646i86g
if IOresult=0 then
begin
Writeln('Il File e'' gia'' esistente');
readln;
close(file1);
end
else
begin
rewrite(file1);
repeat
repeat
clrscr;
writeln('Ricorda : Premi * per uscire');
write('Inserisci il cognome : ');
readln(reap.cogn);
if reap.cogn<>'*' then
begin
write('Inserisci il nome: ');
readln(reap.nome);
write('Inserisci l''indirizzo: ');
readln(reap.ind);
write('Inserisci il numero di telefono: ');
readln(reap.ntel);
write('I dati inseriti sono corretti? : ');
readln(risp);
end;
until (risp='s') or (reap.nome='*');
if reap.cogn<>'*' then write(file1,reap);
until reap.cogn='*';
close(file1);
end;
end;
procedure leggi1;
var ricerca:string;
reap:uno;
a:integer;
begin
clrscr;
a:=0;
assign(file1,'c:\tp\uno.dat');
writeln('Ora cercheremo l''alunno richiesto');
write('Inserire il cognome dell''alunno: ');
readln(Ricerca);
reset(file1); 646i86g
while not eof(file1) do
begin
read(file1,reap);
if reap.cogn=ricerca then
begin
a:=1;
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
readln;
end;
end;
writeln('La ricerca S terminata ');
if a=0 then
begin
writeln('L''alunno cercato non S stato trovato');
writeln('DATI MANCANTI');
readln;
end;
close(file1);
end;
procedure leggi2;
var ricerca:string;
reap:uno;
a:integer;
begin
clrscr;
a:=0;
assign(file1,'c:\tp\due.dat');
writeln('Ora cercheremo l''alunno richiesto');
write('Inserire il cognome dell''alunno: ');
readln(Ricerca);
reset(file1); 646i86g
while not eof(file1) do
begin
read(file1,reap);
if reap.cogn=ricerca then
begin
a:=1;
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
readln;
end;
end;
writeln('La ricerca S stata terminata ');
if a=0 then
begin
writeln('L''alunno cercato non S stato trovato');
writeln('DATI MANCANTI');
readln;
end;
close(file1);
end;
procedure aggiungi1;
var reap:uno;
risp:char;
begin
assign(file1,'c:\tp\uno.dat');
reset(file1); 646i86g
seek(file1,filesize(file1));
clrscr;
repeat
repeat
clrscr;
writeln('Ricorda : Premi * per uscire');
write('Inserisci il Cognome: ');
readln(reap.cogn);
if reap.cogn<>'*' then
begin
write('Inserisci il nome: ');
readln(reap.nome);
write('Inserisci l''indirizzo: ');
readln(reap.ind);
write('Inserisci il numero di telefono: ');
readln(reap.ntel);
write('I dati inseriti sono corretti? : ');
readln(risp);
end;
until (risp='s') or (reap.cogn='*');
if reap.cogn<>'*' then write(file1,reap);
until reap.cogn='*';
close(file1);
end;
procedure aggiungi2;
var reap:uno;
risp:char;
begin
assign(file1,'c:\tp\due.dat');
reset(file1); 646i86g
seek(file1,filesize(file1));
clrscr;
repeat
repeat
clrscr;
writeln('Ricorda : Premi * per uscire');
write('Inserisci il Cognome: ');
readln(reap.cogn);
if reap.cogn<>'*' then
begin
write('Inserisci il nome: ');
readln(reap.nome);
write('Inserisci l''indirizzo: ');
readln(reap.ind);
write('Inserisci il numero di telefono: ');
readln(reap.ntel);
write('I dati inseriti sono corretti? : ');
readln(risp);
end;
until (risp='s') or (reap.cogn='*');
if reap.cogn<>'*' then write(file1,reap);
until reap.cogn='*';
close(file1);
end;
procedure leggitutt1;
var reap:uno;
scelta:char;
a:integer;
begin
clrscr;
assign(file1,'c:\tp\uno.dat');
writeln('Stanno per essere visualizzati tutti i dati presenti sul file ');
writeln('Si puo'' uscire in qualsiasi momento premendo *');
writeln;
reset(file1); 646i86g
if IOresult<>0 then
begin
Writeln('Il File NON ESISTE. Si prega di crearlo se necessario.');
readln;
end
ELSE
BEGIN
repeat
read(file1,reap);
writeln('Cognome : ',reap.cogn);
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
readln;
writeln('Continui? S/N');
readln(scelta);
clrscr;
until eof(file1) or (scelta='N');
writeln('La ricerca e'' terminata.');
READLN;
close(file1);
END;
end;
procedure leggitutt2;
var reap:uno;
scelta:char;
a:integer;
begin
clrscr;
assign(file1,'c:\tp\due.dat');
writeln('Stanno per essere visualizzati tutti i dati presenti sul file ');
writeln('Si puo'' uscire in qualsiasi momento premendo *');
writeln;
reset(file1); 646i86g
if IOresult<>0 then
begin
Writeln('Il File NON ESISTE. Si prega di crearlo se necessario.');
readln;
end
ELSE
BEGIN
repeat
read(file1,reap);
writeln('Cognome : ',reap.cogn);
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
readln;
writeln('Continui? S/N');
readln(scelta);
clrscr;
until eof(file1) or (scelta='N');
writeln('La ricerca e'' terminata.');
READLN;
close(file1);
END;
end;
procedure leggi3;
var reap:uno;
scelta:char;
a:integer;
begin
clrscr;
assign(file1,'c:\tp\tre.dat');
writeln('Stanno per essere visualizzati tutti i dati presenti sul file ');
writeln('Si puo'' uscire in qualsiasi momento premendo *');
writeln;
reset(file1); 646i86g
if IOresult<>0 then
begin
Writeln('Il File NON ESISTE. Si prega di crearlo se necessario.');
readln;
end
ELSE
BEGIN
repeat
read(file1,reap);
writeln('Cognome : ',reap.cogn);
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
readln;
writeln('Continui? S/N');
readln(scelta);
clrscr;
until eof(file1) or (scelta='N');
writeln('La ricerca e'' terminata.');
READLN;
close(file1);
END;
end;
Procedure modifica1;
var ricerca:string;
reap:uno;
nr,a:integer;
scelta:char;
begin
clrscr;
a:=0;
assign(file1,'c:\tp\uno.dat');
writeln('Ora cercheremo l''alunno da lei richiesto');
writeln('Attenzione, se il nome era scritto con lettere maiuscole e lei inserisce');
writeln('il nome da cercare in lettere minuscole, il progr. non trover. ci. che cerca');
writeln;
write('Inserire il cognome dell''alunno: ');
readln(Ricerca);
reset(file1); 646i86g
while not eof(file1) do
begin
read(file1,reap);
if reap.cogn=ricerca then
begin
a:=1;
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
writeln('modifichi l''indirizzo o il numero di telefono ?');
readln(scelta);
if (scelta='s') or (scelta='S') then
begin
nr:=filepos(file1)-1;
seek(file1,nr);
clrscr;
write('Inserisci il nuovo indirizzo: ');
readln(reap.ind);
write('Inserisci il nuovo numero telefonico: ');
readln(reap.ntel);
write(file1,reap);
readln;
end;
end;
end;
writeln('La ricerca S stata terminata ');
if a=0 then
begin
writeln('La ricerca si e'' rivelata un insuccesso');
writeln('DATI MANCANTI')
end;
close(file1);
end;
Procedure modifica2;
var ricerca:string;
reap:uno;
nr,a:integer;
scelta:char;
begin
clrscr;
a:=0;
assign(file1,'c:\tp\due.dat');
writeln('Ora cercheremo l''alunno da lei richiesto');
writeln('Attenzione, se il nome era scritto con lettere maiuscole e lei inserisce');
writeln('il nome da cercare in lettere minuscole, il progr. non trover. ci. che cerca');
writeln;
write('Inserire il cognome dell''alunno: ');
readln(Ricerca);
reset(file1); 646i86g
while not eof(file1) do
begin
read(file1,reap);
if reap.cogn=ricerca then
begin
a:=1;
writeln('Nome : ',reap.nome);
writeln('Indirizzo : ',reap.ind);
writeln('Numero telefonico: ',reap.ntel);
writeln('modifichi l''indirizzo o il numero di telefono ?');
readln(scelta);
if (scelta='s') or (scelta='S') then
begin
nr:=filepos(file1)-1;
seek(file1,nr);
clrscr;
write('Inserisci il nuovo indirizzo: ');
readln(reap.ind);
write('Inserisci il nuovo numero telefonico: ');
readln(reap.ntel);
write(file1,reap);
readln;
end;
end;
end;
writeln('La ricerca S stata terminata ');
if a=0 then
begin
writeln('La ricerca si e'' rivelata un insuccesso');
writeln('DATI MANCANTI')
end;
close(file1);
end;
procedure Fondi;
var ricerca:string;
reap:uno;
w,x,b,k,i,j,a:integer;
file2,file3:file of uno;
begin
repeat
k:=10;
a:=0;
i:=0;
assign(file1,'c:\tp\uno.dat');
assign(file2,'c:\tp\due.dat');
assign(file3,'c:\tp\tre.dat');
rewrite(file3);
close(file3);
reset(file1); 646i86g
repeat
begin
i:=i+1;
mat1[i,1]:=reap.cogn[i];
mat1[i,2]:=reap.nome[i];
mat1[i,3]:=reap.ind[i];
mat1[i,4]:=reap.ntel[i];
end;
until (i=k) or (eof(file1));
j:=0;
reset(file2);
repeat
begin
j:=j+1;
mat2[j,1]:=reap.cogn[i];
mat2[j,2]:=reap.nome[i];
mat2[j,3]:=reap.ind[i];
mat2[j,4]:=reap.ntel[i];
end;
until (j=k) or (eof(file2));
a:=i;
b:=j;
i:=1;
j:=1;
x:=0;
repeat
if mat1[i,1]<mat2[j,1] then
begin
x:=x+1;
mat3[x,1]:=mat2[j,1];
mat3[x,2]:=mat2[j,2];
mat3[x,3]:=mat2[j,3];
mat3[x,4]:=mat2[j,4];
j:=j+1;
end;
if mat1[i,1]>mat2[j,1] then
begin
x:=x+1;
mat3[x,1]:=mat1[i,1];
mat3[x,2]:=mat1[i,2];
mat3[x,3]:=mat1[i,3];
mat3[x,4]:=mat1[i,4];
i:=i+1;
end;
if mat1[i,1]=mat2[j,1] then
begin
if mat1[i,2]<mat2[j,2] then
begin
x:=x+1;
mat3[x,1]:=mat2[j,1];
mat3[x,2]:=mat2[j,2];
mat3[x,3]:=mat2[j,3];
mat3[x,4]:=mat2[j,4];
j:=j+1;
end;
if mat1[i,2]>mat2[j,2] then
begin
x:=x+1;
mat3[x,1]:=mat1[i,1];
mat3[x,2]:=mat1[i,2];
mat3[x,3]:=mat1[i,3];
mat3[x,4]:=mat1[i,4];
i:=i+1;
end;
end;
until (j=b) and (i=a);
w:=a+b;
i:=0;
repeat
begin
reset(file3);
seek(file3,filesize(file3));
i:=i+1;
reap.cogn:=mat3[i,1];
reap.nome:=mat3[i,2];
reap.ind:=mat3[i,3];
reap.ntel:=mat3[i,4];
write(file3,reap);
close(file3);
end;
until i=w;
until Eof(file1) or Eof(file2);
close(file1);
close(file2);
end;
Procedure Menu3;
var scelta:integer;
begin
repeat
clrscr;
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln(' Creazione nuovi file');
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln;
Writeln('1. Crea file Uno.dat');
Writeln('2. Crea file Due.dat');
Writeln('3. Menu'' precedente');
readln(scelta);
case scelta of
1:crea1;
2:crea2;
end;
until scelta=3;
end;
Procedure Menu4;
var scelta:integer;
begin
repeat
clrscr;
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln(' Aggiunta dati in memoria');
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln;
Writeln('1. Aggiungi a Uno.dat');
Writeln('2. Aggiungi a Due.dat');
Writeln('3. Menu'' precedente');
readln(scelta);
case scelta of
1:Aggiungi1;
2:Aggiungi2;
end;
until scelta=3;
end;
Procedure Menu5;
var scelta:integer;
begin
repeat
clrscr;
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln(' Modifica dati in memoria');
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln;
Writeln('1. Modifica a Uno.dat');
Writeln('2. Modifica a Due.dat');
Writeln('3. Menu'' precedente');
readln(scelta);
case scelta of
1:Modifica1;
2:Modifica2;
end;
until scelta=3;
end;
Procedure Menu2;
var scelta:integer;
begin
repeat
clrscr;
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln(' Lettura dati in memoria');
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln;
Writeln('1. Ricerca per Cognome del file uno.dat');
Writeln('2. Leggi tutti i dati del file uno.dat');
Writeln;
Writeln('3. Ricerca per Cognome del file due.dat');
Writeln('4. Leggi tutti i dati del file due.dat');
Writeln;
Writeln('5. Leggi il file Tre.dat dato dalla fusione dei file Uno.dat e Due.dat');
Writeln('6. Menu'' precedente');
readln(scelta);
case scelta of
1:leggi1;
2:leggitutt1;
3:leggi2;
4:leggitutt2;
5:leggi3;
end;
until scelta=6;
end;
begin
repeat
clrscr;
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln(' Menu'' di scelta principale');
Writeln('ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ');
Writeln;
Writeln('1. Crea Nuovo File');
Writeln('2. Aggiungi dati');
Writeln('3. Leggi dati');
Writeln('4. Modifica dati');
Writeln('5. Fondi i due file');
Writeln('6. Esci');
readln(scelta);
case scelta of
1:Menu3;
2:Menu4;
3:Menu2;
4:Menu5;
5:Fondi;
end;
until scelta=6;
writeln;
Writeln('Grazie per aver scelto questo programma');
writeln;
readln;
end.
Privacy |
Articolo informazione
Commentare questo articolo:Non sei registratoDevi essere registrato per commentare ISCRIVITI |
Copiare il codice nella pagina web del tuo sito. |
Copyright InfTub.com 2025