Programalama > PASCAL

uses crt;
var
dosya:text;
ad,soyad,no:string;
i,a:integer;
sec:char;
x:string;
procedure menuyaz;
begin
clrscr;textcolor(2);
gotoxy(12,0);writeln('KAYIT EKLEME');writeln;textcolor(3);
gotoxy(10,2);  writeln('(1)(*KAYIT EKLE)*');textcolor(4);
gotoxy(10,4);  writeln('(2)(* LİSTE)*');textcolor(5);
gotoxy(10,6);  writeln('(3)(* BUL)*');textcolor(6);
gotoxy(10,8);  writeln('(4)ÇIKIŞ');textcolor(9);
gotoxy(10,10); write('KAYIT 1=LİSTE 2=BUL 3=ÇIKIŞ 4:');textcolor(10);
gotoxy(10,12); write('LÜTFEN BİR NUMARA SEÇİNİZ');
end;
procedure kayitgir;
begin
{$i-} append(dosya); {$i+}
if ioresult<>0 then rewrite(dosya);
repeat
clrscr;textcolor(12);
write(' ADI.......:');readln(ad);
write(' SOYADI....:');readln(soyad);
write(' TELEFON.......:');readln(no);
writeln(dosya,ad);
writeln(dosya,soyad);
writeln(dosya,no);
writeln;writeln('KAYIT İŞLEM TAMAMDIR');
write('DEVAM ETMEK İSTRMİSİNİZ? < E / H > :');
repeat
sec:=readkey;
until sec in ['E','H','e','h'];
until (sec='h') or (sec='H');
close(dosya);
end;
procedure listele;
begin
clrscr;textcolor(10);
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin
while not eof(dosya) do begin
readln(dosya, ad);
readln(dosya, soyad);
readln(dosya,no);
writeln(' Ad:', ad,'   Soyad:', soyad,'  Tel:',no);
end;
writeln;
writeln(' KAYITLAR');
readln;
close(dosya);
end
else
begin
readln;
end;
end;
procedure arama;
begin
clrscr;
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin
writeln('ARANACAK İSMİ GİRİN (LÜTFEN)');
readln(x);
while not eof(dosya) do begin
readln(dosya, ad);
readln(dosya,soyad);
readln(dosya,no);
if ad=x then begin
writeln('ARADIĞINIZ KİŞİNİN');
writeln(' Ad: ', ad,'  Soyad: ', soyad,' Tel: ',no);
end;
if ad<>x then begin
end;
end;
readln;
close(dosya);
end;
end;
begin
assign(dosya,'kim.dat');
repeat
menuyaz;
sec:=readkey;
case sec of
'1':kayitgir;
'2':listele;
'3':arama;
end;
until sec='4';
end.