Programalama > PASCAL

uses crt;
var
f,t:text;
yan,ch:char;
s,z:string;
i:byte;
procedure buyuk;
begin
for i:=1 to length(s) do
s[i]:= upcase(s[i]);
end;
procedure ekle;
begin
clrscr;
append(f);
write(''''ad soyad.(max.20 harf):'''');readln(s);
buyuk;
s:=s+'''''''';s:=copy(s,1,20);write(f,s);
write(''''telefon..(max.20 harf):'''');readln(s);
s:=s+'''''''';s:=copy(s,1,20);write(f,s:18);
write(''''adres....(max.30 harf:)'''');readln(s);
buyuk;
s:=s+'''''''';s:=copy(s,1,30);writeln(f,s:21);
close(f);
end;
procedure liste;
begin
clrscr;
writeln(''''AD     SOYAD       TELEFON          ADRES'''');
reset(f);
repeat
readln(f,s);
writeln(s);
until eof(f);
ch:=readkey;if ch=#0then ch:=readkey;
end;
procedure ara;
begin
clrscr;
write(''''ad soyad.(max.20 harf):'''');readln(z);
for i:=1 to length(z) do
z[i]:= upcase(z[i]);
z:=z+'''''''';z:=copy(z,1,20);
writeln(''''aranyor......'''');
reset(f);
repeat
readln(f,s);
if copy(s,1,20)=z then
begin
writeln('''' AD         SOYAD          TELEFON              ADRES'''');
writeln(s);
s:='''''''';
write(''''aramaya devam?(E/H):'''');
repeat ch:=upcase(readkey);until ch in[''''E'''',''''H''''];
if ch=''''E''''then begin gotoxy(1,wherey-3);
end else break;
end;
until eof(f);
write(''''dosya sonu!''''#7);
ch:=readkey;if ch=#0then ch:=readkey;
end;
procedure silme;
begin
clrscr;
write(''''ad soyad.(max.20 harf):'''');readln(z);
for i:=1 to length(z) do
z[i]:= upcase(z[i]);
z:=z+'''''''';z:=copy(z,1,20);
writeln(''''aranyor.....'''');
assign(t,''''rehber.tmp'''');rewrite(t);
reset(f);
repeat
readln(f,s);
if copy(s,1,20)<>z then writeln(t,s);
until eof(f);
close(f);
close(t);
erase(f);
rename(t,''''rehber.tel'''');
end;
procedure degistir;
begin
clrscr;
write(''''ad soyad.(max.20 harf):'''');readln(z);
for i:=1 to length(z) do
z[i]:=upcase(z[i]);
z:=z+'''''''';z:=copy(z,1,20);
writeln(''''aranyor....'''');
assign(t,''''rehber.tmp'''');rewrite(t);
reset(f);
repeat
readln(f,s);
if copy(s,1,20)<>z then writeln(t,s);
until eof(f);
close(f);
close(t);
erase(f);
rename(t,''''rehber.tel'''');
clrscr;
append(f);
write(''''yeni ad soyad.(max.20 harf):'''');readln(s);
buyuk;
s:=s+'''''''';s:=copy(s,1,20);write(f,s);
write(''''yeni telefon..(max.20 harf):'''');readln(s);
s:=s+'''''''';s:=copy(s,1,20);write(f,s);
write(''''yeni adres...(max.30 harf):'''');readln(s);
buyuk;
s:=s+'''''''';s:=copy(s,1,30);writeln(f,s);
close(f);
end;
procedure tumunusil;
begin
write(''''B&#353;T&#353;N KAYITLARI S&#732;LMEK &#732;STED&#732;¦&#732;N&#732;ZDEN EM&#732;NM&#732;S&#732;N&#732;Z? (E/H):'''');
repeat
readln(yan);
yan:=upcase(yan);
until yan in [''''E'''',''''H''''];
if yan=''''E'''' then
begin
rewrite(f);
close(f);
end;
end;
procedure cikis;
begin
clrscr;
halt;
end;
begin
assign(f,''''rehber.tel'''');
{$i-}reset(f);{$i+}
if ioresult<>0then rewrite(f);
repeat
repeat
clrscr;
textcolor(white);
writeln(''''Nazm DEM&#732;R  (SDU/Senirkent MYO &#8482;§rencisi)'''');
writeln;
writeln;
writeln;
writeln;
textcolor(red);
writeln(''''          ---           KULLANI&#382;LI B&#732;R REHBER PROGRAMI           --- '''');
writeln;
textcolor(green);
writeln(''''                            *  1)kayt ekleme      *'''');
writeln(''''                            *  2)kayt listeleme   *'''');
writeln(''''                            *  3)kayt arama       *'''');
writeln(''''                            *  4)kayt silme       *'''');
writeln(''''                            *  5)kayt de§i&#376;tirme  *'''');
writeln(''''                            *  6)kayt sfrlama   *'''');
writeln(''''                            *  7 DOS tan &#8225;k&#376;     *'''');
ch:=readkey;
until ch<>#7;
case ch of
''''1'''':ekle;
''''2'''':liste;
''''3'''':ara;
''''4'''':silme;
''''5'''':degistir;
''''6'''':tumunusil;
''''7'''':cikis;
end;
until ch=#7;
readln;
end.


nazım demir
demirnazim@hotmail.com