Fisiere text si fisiere cu tip - probleme rezolvate

Fisiere text si fisiere cu tip

1. Prelucrare fisier text-varianta 1-a

program Cea_mai_lunga_linie_text_var_1 ;
type numef=string[14];

linie=string[80] ;

var    f: text ;

l: linie ;
ll: integer ;
sursa: numef ;

sf:char;
begin
sf := 'D';

repeat
write('nume fisier:');
readln(sursa) ;
assign(f,sursa) ;
reset(f);
ll:=0;
while not eof(f) do begin

readln(f,l);

if length(l)>ll then ll:=length(l)
end;
if ll=0 then writeln ('fisierul vid')
else begin

writeln('cea mai lunga linie are ',ll:2,' caract.');
reset(f);
while not eof(f) do begin

readln(f,l);
if length(l)=ll then writeln(l)

end
end;
close(f);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

2. Prelucrare fisier text-varianta a-2-a

program Cea_mai_lunga_linie_text_var2 ;
type numef=string[14];

linie=string[80] ;

var f,temp :text;
l :linie ;
ll :integer ;
sursa :numef ;

sf:char;

begin
sf := 'D';

repeat
write('nume fisier:');
readln(sursa) ;

assign(f,sursa) ;
reset(f);
assign(temp,'temp.tmp');
rewrite(temp);
ll:=0;
while not eof(f) do begin

readln(f,l);

if length(l)>ll then begin
ll:=length(l);
rewrite(temp);
writeln(temp,l);

end else if length(l)=ll then

writeln(temp,l)
end;
if ll=0 then writeln ('fisierul vid')

else begin
writeln('cea mai lunga linie are',ll:2,' caractere');
reset(temp);
while not eof(temp) do begin

readln(temp,l);
writeln(l)
end

end;
close(f);
close(temp);
erase(temp);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

Creare fisier studenti din facultate

program creare_fisier_studenti_din_facultate;
type numef=string[14];

numeg=string[6];
fac=file of numeg;

var     nf:numef;
f:fac;
ng:numeg;
n,i:integer;

sf:char;

begin

sf := 'D';

repeat
write('numef:');
readln(nf);
assign(f,nf);
rewrite(f);
write('nr.grupe:');
readln(n);
for i:=1 to n do

begin
write('grupa ',i,':');
readln(ng);
write(f,ng);

end;
close(f);
reset(f);
while not eof(f) do

begin
read(f,ng);
writeln(ng);

end;
close(f);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

4. Actualizare in acces direct fisier studenti

program accesare_directa_fisiere;
const nm=15;
type numes=string[25];

note=0..10;

student =record
nume:numes;
m:array[1..nm]of note;

end;
grupa=file of student;
numeg=string[6];

var g:grupa;
ng:numeg;
ns,nn,no,nr,i,j:integer;
s:student;

sf:char;
procedure modi_nota(var g:grupa;is,im:integer; noua:note);
var s:student;
begin

seek(g,is-1);
read(g,s);
s.m[im] :=noua ;
seek(g,is-1);
write(g,s);

end;
procedure list_note(var g:grupa;x,y:integer);
var s:student;

i:integer;

begin
seek(g,x-1);
read(g,s);
write(x:2, '.',s.nume);
for i:=1 to nn do write(s.m[i]:3);
writeln;

end;

begin
sf := 'D';

repeat
write('numeg:'); readln(ng);
assign(g,ng);
rewrite(g);
write('numar studenti si note:');
readln(ns,nn);
for i:=1 to ns do

with s do begin
write('nume',i:2,' :');

readln(nume);
write('notele:');
for j:=1 to nn do read(m[j]);

readln;
writeln;
write(g,s);

end;
close(g);
reset(g);
write('modif. Nota nr pt stud', ns,':');
readln(nr,ns);
write('noua nota :') ;
readln(no);

writeln('note vechi stud. Cu nr.',ns:2);
list_note(g,ns,nr);
modi_nota(g,ns,nr,no);
writeln('note noi stud. Cu nr.',ns:2);
list_note(g,ns,nr);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';.

end.

5. Numarare studenti din facultate

program Numarare_studenti_din_facultate;
const nm=15;
type numes=string[25];

note=0..10;

student = record
nume:numes;
m:array[1..nm]of note;

end;
grupa=file of student;
numeg=string[6];
facultate=file of numeg;
numef=string[14];

var f:facultate;
nf:numef;
g:grupa;
ng:numeg;
s:student;
n:longint;

sf:char;

begin
sf := 'D';

repeat
write('numefac=');
readln(nf);
assign(f,nf);
reset(f);
n:=0;
while not eof(f) do begin

read(f,ng);
assign(g,ng);
reset(g);
while not eof(g) do begin

read(g,s);

writeln(s.nume);
end;
reset(g);
n:=n+filesize(g);
close(g);

end;
close(f);
writeln('facultatea are ', n:4, ' stud');

writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';
end.

6. Ordonare fisier studenti-varianta 1-a

program ordonare_studenti_varianta1;
const maxstud=30;

maxnote=15;

type     nume=string[24];
note=array[1..maxnote]of 0..10;
student=record

stud_nume:nume;
n:note;
restante:0..maxnote;
absente:0..maxnote;

end;
studenti=array[1..maxstud]of student;

var     s:studenti;
ns,nn,o:integer;
c:char;

sf:char;

procedure read_st;
var i,j:integer;
begin

repeat
write('Numar studenti si note:');
readln(ns,nn)

until (ns in [1..maxstud]) and (nn in [1..maxnote]);

for i:=1 to ns do

with s[i] do begin
write ('Nume student ',i,' :');
readln(stud_nume);

write('note: ');
for j:=1 to nn do
read(n[j]);
readln

end
end;
procedure write_st;
var i,j:integer;
begin

sf := 'D';

repeat
writeln('Nume student Note');
for i:=1 to ns do

with s[i] do begin
write(stud_nume,' ':25-length(stud_nume));
for j:=1 to nn do write(n[j]:3);
writeln

end
end;
procedure order (o:integer);
var i,j:integer;

temp:student;
begin
for i:=1 to ns-1 do begin
for j:=i+1 to ns do
if (s[j].n[o]>s[i].n[o]) or
(s[j].n[o]=s[i].n[o]) and
(s[j].stud_nume=s[i].stud_nume)

then begin
temp:=s[i];
s[i]:=s[j];
s[j]:=temp

end
end;
write_st

end;

begin
sf := 'D'; repeat
read_st;
repeat

write('Index nota[1..', nn,']:');
o:=0;
readln(o);

if o in [1..nn] then order(o)
else writeln ('Eroare');
write ('Stop? [D/N]:');
readln(c)

until upcase(c)='D';
writeln('Press any key');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

7. Ordonare fisier studenti varianta a 2-a

program ordonare_studenti_varianta2;
const maxstud=30;

maxnote=15;

type     nume=string[24];
note=array[1..maxnote]of 0..10;
student=record

stud_nume:nume;
n:note;
restante:0..maxnote;
absente:0..maxnote;

end;
studenti=array[1..maxstud]of student;

var     s:studenti;
ns,nn,o:integer;
c:char;
o_list:array[1..maxstud]of integer;

sf:char;

procedure read_st;
var i,j:integer;
begin

repeat
write('Numar studenti si note:');
readln(ns,nn)

until (ns in [1..maxstud]) and
(nn in [1..maxnote]);
for i:=1 to ns do

with s[i] do begin
write ('Nume student ',i,' :');
readln(stud_nume);
write('note: ');
for j:=1 to nn do

read(n[j]);
readln;
o_list[i]:=i;

end
end;
procedure write_st;
var i,j:integer;
begin

sf := 'D';

repeat
writeln('Nume student Note');
for i:=1 to ns do

with s[o_list[i]] do begin
write(stud_nume,' ':25-length(stud_nume));
for j:=1 to nn do write(n[j]:3);
writeln

end
end;
procedure order (o:integer);
var i,j:integer;

temp:student;
begin
for i:=1 to ns-1 do begin
for j:=i+1 to ns do

if
(s[o_list[j]].n[o]>s[o_list[i]].n[o]) or
(s[o_list[j]].n[o]=s[o_list[i]].n[o])and
(s[o_list[j]].stud_nume=s[o_list[i]].stud_nume)
then begin

temp:=s[o_list[i]];
s[o_list[i]]:=s[o_list[j]];
s[o_list[j]]:=temp

end
end;
write_st

end;

begin
sf := 'D'; repeat
read_st;
repeat

write('Index nota [1..', nn,']:');
o:=0;
readln(o);

if o in [1..nn] then order(o)
else writeln ('Eroare');
write ('Stop? [D/N]:');
readln(c)

until upcase(c)='D';
writeln('Press any key');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.1. Cautare drumuri de iesire din labirint

program labirinturi;
const n=8;

maxl=5;

spa=' ';
type labirint=array[0..n,0..n]of char;
var l:labirint;

t:array[1..maxl]of labirint;

k,nrd,i,j:integer;

sf:char;
procedure afis_ini;
var i,j,lg,sp:integer;
begin

lg:=maxl*(n+4)-3;
sp:=(lg-n-1)div 2;
writeln;
writeln(' ':sp,'LABIRINTUL:');
writeln;
for i:=0 to n do begin
write(' ':sp);
for j:=0 to n do write(l[i,j]);
writeln;
end;
writeln;
readln;

end;
procedure titlu;
var i:integer;
begin

for i:=nrd-k+2 to nrd do

write('Drum:':n-2,i:3,spa);
writeln;
writeln;

end;
procedure scriet;
var i,j,p:integer;
begin

titlu;
for i:=0 to n do begin
for p:=1 to k-1 do begin
for j:=0 to n do
write(t[p][i,j]);

write(spa);
end;
writeln;

end;
writeln;
writeln;
writeln(' Continuati (D / N) ? '); read(sf); until sf = 'N';

end;
procedure scriel;
begin

if k>maxl then begin
scriet;
k:=1

end;
t[k] :=l ;
k:=k+1;
nrd:=nrd+1;

end;
procedure caut(x,y:integer);
begin

if l[x,y]=' ' then begin
l[x,y] :='+' ;
if (x mod n=0)or(y mod n=0) then scriel

else begin
caut(x+1,y) ;
caut(x,y+1) ;
caut(x-1,y) ;
caut(x,y-1) ;

end;
l[x,y] :=' ' ;

end
end;
begin

sf := 'D';

repeat

for i:=0 to n do begin
for j:=0 to n do read(l[i,j]);
readln

end;
k:=1;
nrd :=0 ;
afis_ini ;
caut(n div 2, n div 2) ;
if k>1 then scriet;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.2. Livada cu meri

program Livada_cu_mere;
const nmax=100;
type matr=array[1..nmax,1..nmax]of longint;

lo=record
v:integer;
linia:1..nmax;
coloana:1..nmax;
latura:1..nmax;

end;

var a:matr;
s:array[1..nmax]of lo;
li,co,la,m,n,i,j,k,l,nm,smax:integer;

sf:char;

begin
sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
for i:= 1 to n do

for j:=1 to m do begin
write('a[',i:2,',',j:2,']=');
readln(a[i,j]);

end;
for i:= 1 to n do begin

for j:=1 to m do write(a[i,j]:4);

writeln;
end;
if n>m then nm:=m else nm:=n;
l:=0;
for i:=1 to n do

for j:=1 to m do
for k:=1 to nm do

if (i+k<=n)and(j+k<=m) then begin
l:=l+1;
with s[l] do begin

v:=a[i,j]+a[i+k,j]+

a[i,j+k]+a[i+k,j+k];
linia:=i;
coloana:=j;
latura:=k;

end

end;
smax:=s[1].v;
for i:=2 to l do

if s[i].v>=smax then smax:=s[i].v;
write('S=(');
for i:=1 to l do write(s[i].v:4);
write(')');
writeln;
for i:=1 to l do

if smax=s[i].v then
writeln('smax=',s[i].v, ' linia=',

s[i].linia:3,'coloana=',
s[i].coloana:3,' latura=',
s[i].latura:3);

writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';
end.

14.3 Conversie text in alfabetul Morse

program morse;
const a:array[48..122]of string=

'____.',':',';','<','=','>','?','@',
'._','_','_._.','_..','.','.._.','__.',
'.','..','.___','_._','._..','__','_.','___','._
_.','__._','_._','','_','.._',
'_','.__','_.._','_.__','__..','[','',']','^','
_','`','._','_','_._.','_..','.','.._.','__.','.
','..','.___','_._','._..','__','_.','___','.__.
','__._','_._','','_','.._','_','.__','_.._',
'_.__','__..');

var     sir:string[120];
i,j,n:integer;
c:char;

sf:char;

begin
sf := 'D';

repeat
write('n='); readln(n);
writeln('introduceti cele ',n,' car.:');
for i:=1 to n do write(i:1);
writeln;
for i:=1 to n do read (sir[i]);
writeln;
for i:=1 to n do

if sir[i]=' ' then begin
write(' ':4);
delay(500);

end

else begin
delay(300);
write(a[ord(sir[i])],' ');
for j:=1 to ord(a[ord(sir[i])][0])

do begin
c:=a[ord(sir[i])][j];
sound(512);
if c='_' then delay(300);
if c='.' then delay(100);
nosound;
delay(100);

end;

end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.4. Reconstituire cuvant introdus de la tastatura

program reconstituire_cuvant;
const nmax=100;
var a,b:array[1..nmax]of char;

i,k,n:byte;
c,co:char;
ok:boolean;

sf:char;
begin

sf:='D';

repeat

repeat
sf := 'D'; repeat
write('n='); readln(n);
write('Dati cuvant de ',n,' caract:');
for i:=1 to n do begin

a[i]:=readkey;
end;
writeln;
for i:=1 to n do begin

b[i]:='-';

write (b[i])
end;
writeln;
write('Numar de incercari=');

readln(k);

repeat
writeln('Mai aveti ',k,' incerc');
write('Introd. un caracter:');
readln(c);
for i:=1 to n do

if a[i]=c then b[i]:=c;

for i:=1 to n do begin
write(b[i]);
if b[i]<>'-' then begin

sound(512);
delay(500);
nosound

end
end;

writeln;
k:=k-1;
ok:=true;
i:=1;
while (i<=n) and ok do begin

if a[i]<>b[i] then ok:=false;

i:=i+1

end
until (k=0) or ok;
if ok then writeln ('Ati reusit sa reconstituiti cuvantul')
else writeln('Ati esuat: mai
incerati');
write('Continuati (D/N)?:');

readln(co)
until upcase (co)<>'D';
write(,Gata: Press any Key!:');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.5. Construire careu magic de ordin impar

program careul_magic_de_ordin_impar;
var n,m1,m2,i,j,k:integer;

a:array[1..19,1..19] of integer;

sf:char;
begin
sf := 'D';

repeat
writeln('Se construieste un careu magic cu n linii');

repeat
write('n=');
readln(n);

until (n in [1..19]) and (odd(n));
for i:=1 to n do
for j:=1 to n do

a[i,j]:=0;
i:=(n div 2)+2;
j:=(n div 2)+1;

for k:=1 to n*n do begin
a[i,j]:=k;
m1:=i+1;
m2:=j+1;
if m1=n+1 then m1:=1;
if m2=n+1 then m2:=1;
if a[m1,m2]=0 then begin

i:=m1;

j:=m2;
end
else begin

i:=i+2;
if i>n then i:=i-n

end;
end;
for i:=1 to n do begin

writeln;

for j:=1 to n do write(a[i,j]:4);
end;
writeln;
writeln('Suma magica=',n*(n*n+1) div 2);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.6. Determinare numar zi din an

program zile_din_an;

type luna=1..12;

zi=1..31;

var a,k,nr_zi:integer;
e:luna;
z:zi;

sf:char;

begin
sf := 'D';

repeat
write('introduceti anul:'); readln(a);

write('introduceti luna 1..12:');

readln(e);
write('introduceti ziua 1..31:');
readln(z);

k:=e-1;
nr_zi:=30*k;
if k>0 then begin

if k<=7 then nr_zi:=nr_zi+(k+1) div 2;
if k>=2 then
if(a mod 4=0)and(a mod 100<>0)
or (a mod 400=0)then nr_zi:=nr_zi-1

else nr_zi:=nr_zi-2;
end;
nr_zi:=nr_zi+z;
write('Au trecut',nr_zi:4,'

zile din anul ',a:4);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.7. Utilizarea memoriei cache

program memoria_cache;
var sf:char;
n,lin,bpm,a,k,m,p,i:integer;

s:array[0..22]of integer;

begin
sf := 'D';

repeat
write('n='); readln(n);
write('a='); readln(a);
k:=0;
while n>0 do begin

s[k]:=n mod a;
n:=n div a;
k:=k+1

end;

lin:=0;
p:=1;
for i:=2 to 11 do begin

lin:=lin+s[i]*p;

p:=p*a
end;

bpm:=0;
p:=1;
for i:=12 to 22 do begin

bpm:=bpm+s[i]*p;

p:=p*a
end;
writeln('Linia in cache:',lin);
writeln('Bitii de pondere mare:',bpm);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.8 Conversii intre sistemele roman si arab

14.8.1 Conversie din sistemul roman in sistem arab

program roman_arab;
var sf:char;
cifra:char;

val_prec, val_urm:1..1000;
n:integer;
corect:boolean;

begin
sf := 'D';

repeat
n:=0;
write('Numarul din cifre romane:');
read(cifra);
corect:=true;
case cifra of

'M':val_prec:=1000;
'D':val_prec:=500;
'C':val_prec:=100;
'L':val_prec:=50;
'X':val_prec:=10;
'V':val_prec:=5;
'I':val_prec:=1;

else corect:=false
end;
while corect and not eoln do begin

read(cifra);

case cifra of
'M':val_urm:=1000;
'D':val_urm:=500;
'C':val_urm:=100;
'L':val_urm:=50;
'X':val_urm:=10;

'V':val_urm:=5;

'I':val_urm:=1;
else corect:=false
end;
if corect then begin

if val_prec<val_urm then
n:=n-val_prec
else n:=n+val_prec;
val_prec:=val_urm;

end;
end;
if corect then writeln
('Numarul in scriere araba:',n+val_prec)
else writeln('Eroare: ',cifra,' nu este cifra romana');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.8.2. Conversie din sistemul arab in sistem roman

program arab_roman;
var sf:char;
x,y:integer;
begin

sf := 'D';

repeat
y:=1;
while y<=5000 do begin

x:=y;
write(y,':');
while x>1000 do begin
write('M');
x:=x-1000;

end;

if x>=900 then begin
write('CM');
x:=x-900;

end;

if x>=500 then begin
write('D');
x:=x-500;

end;
if x>=400 then begin

write('CD');

x:=x-400;

end;

while x>=100 do begin
write('C');
x:=x-100

end;

if x>=90 then begin
write('XC');
x:=x-90;

end;

if x>=50 then begin
write('L');
x:=x-50;

end;

if x>=40 then begin
write('XL');
x:=x-40;

end;

while x>=10 do begin
write('X');
x:=x-10;

end;

if x>=9 then begin
write('IX');
x:=x-9;

end;

if x>=5 then begin
write('V');
x:=x-5;
end;

if x>=4 then begin
write('IV');
x:=x-4;
end;

while x>=1 do begin
write('I');
x:=x-1;

end;

y:=2*y;

writeln;

end;

writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14.9. Eliminare spatii excedentare sir de caractere

program eliminare_spatii_excedentare_sir;
var sf:char;
i,j:-1..80;

a,b:packed array[0..80] of char;
procedure cuvant; forward;
procedure sf;
begin

i:=0;

repeat
write(b[i]); i:=i+1

until i>j;
writeln;
readln;

end;
procedure spinit;
begin

i:=i+1;
if a[i]= ' ' then spinit
else if a[i]='%' then sf

else begin
j:=j+1;
b[j]:=a[i];
cuvant

end
end;
procedure spatiu;
begin

i:=i+1;
if a[i]=' ' then spatiu
else if a[i]='%' then sf

else

begin
j:=j+1;
b[j]:=' ';
j:=j+1;
b[j]:=a[i];
cuvant

end

end;
procedure cuvant;
begin

i:=i+1;
if a[i]=' ' then spatiu
else if a[i]='%' then sf

else begin
j:=j+1; b[j]:=a[i];
cuvant

end
end;
begin

sf := 'D';

repeat
i:=0;
j:=-1;
repeat

read (a[i]); i:=i+1;
until a[i-1]='%';
i:=-1;
spinit;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.