Caricare documenti e articoli online 
INFtub.com è un sito progettato per cercare i documenti in vari tipi di file e il caricamento di articoli online.
Meneame
 
Non ricordi la password?  ››  Iscriviti gratis
 

Program fusione

informatica




Inviare l'articolo a Facebook Inviala documento ad un amico Appunto e analisi gratis - tweeter Scheda libro l'a WhatsApp - corso di

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


Hits: 1096
Apprezzato: scheda appunto

Commentare questo articolo:

Non sei registrato
Devi essere registrato per commentare

ISCRIVITI

E 'stato utile?



Copiare il codice

nella pagina web del tuo sito.


Copyright InfTub.com 2021