Programalama > PASCAL

Program TelefonDefteri_1_0;
Uses crt;
Type
kayit_Tipi = Record
isim : string[50];
evtel,istel,ceptel:string[15];
adres:string;
dogum:string[10];
durum:char;
end;

Var
kayit:kayit_tipi;
dosya:file of kayit_tipi;
tus:char;

Procedure renk(y,z:byte);
begin
textcolor(y);textbackground(z);
end;

function DosyaVarMi(DosyaAdi: String): Boolean;
var
F: file;
begin
{$I-}
Assign(F, DosyaAdi);
Reset(F);
Close(F);
{$I+}
DosyaVarMi := (IOResult = 0) and (DosyaAdi <> '');
end;

Procedure DosyayiAc;
begin
if dosyavarmi('telefon.dat') then begin
assign(dosya,'telefon.dat');
reset(dosya);
end else begin
assign(dosya,'telefon.dat');
rewrite(dosya);
end;
end;

Procedure YeniKayit;
Begin Clrscr;
write('Ad Soyad..: ');readln(kayit.isim);
write('Ev Tel......: ');readln(kayit.evtel);
write('&#732;&#376; Tel......: ');readln(kayit.istel);
write('Cep Tel.....: ');readln(kayit.ceptel);
write('Ev Adresi...: ');readln(kayit.adres);
write('Do§um tarihi (18/11/1983 &#376;eklinde) : ');
readln(kayit.dogum);
kayit.durum:='+';
seek(dosya,filesize(dosya));
write(dosya,kayit);
End; {yenikayit}

Procedure IsmeGoreAra;
var
ad : string[50];
a:longint;
tus2:char;
begin clrscr;
write('Aranacak isim: ');readln(ad);
for a:=0 to filesize(dosya)-1 do begin
seek(dosya,a);read(dosya,kayit);
if (pos(ad,kayit.isim)>0) and (kayit.durum='+') then begin
writeln('Ad Soyad..:', kayit.isim);
writeln('Ev telefonu.:', kayit.evtel);
writeln('&#732;&#376; telefonu.:', kayit.istel);
writeln('Cep telefonu:', kayit.ceptel);
writeln('Adresi......:', kayit.adres);
writeln('Do§um tarihi:', kayit.dogum);
tus2:=readkey;
end; {if pos..}
end; {for a..}
end; {ismegore..}

Procedure TumunuListele;
var
a:longint;
tus2:char;
begin clrscr;
renk(0,15);
gotoxy(1,1);write(' ':80);
gotoxy(1,1);write('Ad-Soyad');
gotoxy(40,1);write('Ev telefonu');
gotoxy(60,1);writeln('Cep telefonu');
renk(lightgray,0);
for a:=0 to filesize(dosya)-1 do 
 if kayit.durum='+' then begin
seek(dosya,a);read(dosya,kayit);
write(kayit.isim);
gotoxy(40,wherey);write(kayit.evtel);
gotoxy(60,wherey);writeln(kayit.ceptel);
if wherey=24 then begin
tus2:=readkey;
clrscr;
renk(0,15);
gotoxy(1,1);write(' ':80);
gotoxy(1,1);write('Ad-Soyad');
gotoxy(40,1);write('Ev telefonu');
gotoxy(60,1);writeln('Cep telefonu');
renk(lightgray,0);
end; {if wherey..}
end; {for a..}
tus2:=readkey;
end;

Procedure KayitIptal;
var
ad : string[50];
a:longint;
tus2:char;
begin clrscr;
write('Silincek isim: ');readln(ad);
for a:=0 to filesize(dosya)-1 do begin
seek(dosya,a);
read(dosya,kayit);
if (pos(ad,kayit.isim)>0) and (kayit.durum='+') then begin
writeln('Ad Soyad..:', kayit.isim);
writeln('Ev telefonu.:', kayit.evtel);
writeln('&#732;&#376; telefonu.:', kayit.istel);
writeln('Cep telefonu:', kayit.ceptel);
writeln('Adresi......:', kayit.adres);
writeln('Do§um tarihi:', kayit.dogum);
writeln;
write('Silincek Kayt bu mu (e/h) ? : ');
repeat
tus2:=readkey;
until tus2 in['e','E','h','H',#27];
case tus2 of
'e','E': begin
kayit.durum:='-';
seek(dosya,a);write(dosya,kayit);
end; {'e','E':..}
end; {case}
end; {if pos..}
end; {for a..}
end; {kayitiptal}

Begin
dosyayiAc;
Repeat clrscr;
writeln(':::::::: Men ::::::::');
writeln;
writeln('[1] Yeni Kayt');
writeln('[2] &#732;sme G&#8221;re Ara');
writeln('[3] Tmn Listele');
writeln('[4] Kayt &#732;ptal');
writeln('[5] &#8364;k&#376;');
writeln;
write('Se&#8225;iminiz: ');
tus:=readkey;
case tus of
'1':yenikayit;
'2':ismegoreara;
'3':tumunulistele;
'4':kayitiptal;
end;
Until tus in['5',#27];
close(dosya);
end.