Kayıt Defteri Örneği

[ReKoBaa_61]

Kayıt ekleme , arama , listeleme , yazıcıdan çıktı alma gibi işlevleri bulunan bir kayıt defterinin oluşturulması..




Kod:
uses crt,printer;
type
kayit=record
isim:string[30];
maas:longint;
f:char;

end;

var
dosya:file of kayit;
kay:kayit;
tus:char;
i,s,kod:integer;
ara:string[30];
d:integer;
label
aa;
procedure kayityap;

begin
assign(dosya,'c:\maas.DAT');
reset(dosya);
kod:=IOresult;
if kod0 then rewrite(dosya);
repeat
clrscr;
write('isim.... : ');
readln(kay.isim);
if kay.isim=''then exit;
write('maas.... : ');
readln(kay.maas);
write('bilgi dosyaya yaz�ls�n m�? [E/H] ');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
kay.f:='*';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 1=2;
end;
procedure arama;
begin
assign(dosya,'c:\maas.dat');
reset(dosya);
kod:=IOresult;
if kod0 then
begin
writeln('dosya yok....' );
tus:=readkey;
halt;
end;
repeat
clrscr;
write('arad�g�n�z isim : ');
readln(ara);
if ara='' then exit;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (kay.f='*') and (kay.isim=ara) then
begin
clrscr;
writeln('isim..... : ',kay.isim);
writeln('maas..... : ',kay.maas);
write('arad�g�n�z kayit bu mu? [E\H]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then exit;
end;
end;
writeln;
writeln('arad�g�n�z kay�t yok.. ');
tus:=readkey;
until 1=2;
end;
procedure listeleme;
begin
assign(dosya,'c:\maas.dat');
reset(dosya);
I:=IOresult;
if i0 then
begin
writeln('dosya yok');
tus:=readkey;
halt;
end;
clrscr;
writeln('s�ra no ad soyad maas');
writeln('------- --------------- ----------');
window(1,3,80,25);
s:=0;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if kay.f='*' then
begin
s:=s+1;
gotoxy(3,s); write(i+1:3);
gotoxy(20,s); write(kay.isim);
gotoxy(30,s); write(kay.maas:12);
end;
if s>18 then
begin
gotoxy(20,21);
write('d�ger sayfa icin b�r tusa bas�n');
tus:=readkey;
s:=0;
clrscr;
end;
end;
gotoxy(20,21); write('listelenecek kay�tlar bitti');
tus:=readkey;
window(1,1,80,25);
close(dosya);
end;
procedure baslik;
begin
writeln(lst,'s�ra no ad soyad maas');
writeln(lst,'---------- ------------- --------');
s:=0;
end;
procedure yazici;
begin
assign(dosya,'c:\maas.dat');
reset(dosya);
I:=IOresult;
if i0 then
begin
writeln('dosya yok');
tus:=readkey;
halt;
end;
clrscr;
writeln('s�ra no ad soyad maas');
writeln('------- --------------- ----------');
window(1,3,80,25);
s:=0;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if kay.f='*' then
begin
s:=s+1;
gotoxy(3,s); write(lst,i+1:3);
gotoxy(20,s); write(lst,kay.isim);
gotoxy(30,s); write(lst,kay.maas:12);
end;
if s>50 then
begin
gotoxy(20,21);
write('d�ger sayfa icin b�r tusa bas�n');
tus:=readkey;

baslik;
end;
end;
gotoxy(20,21); write('listelenecek kay�tlar bitti');
tus:=readkey;
window(1,1,80,25);
close(dosya);
end;


begin
aa:
clrscr;

writeln('1 kay�t girisi ');
writeln('2 kay�t arama ');
writeln('3 kay�t listeleme');
writeln('4 yaz�c�dan c�kt� alma');
writeln('5 exit');
write('se‡iminiz : ');
readln(d);
if d=1 then kayityap;
if d=2 then arama;
if d=3 then listeleme;
if d=4 then yazici;
if d=5 then exit;
goto aa;
end.