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);
write('adres....(max.30 harf:)');readln(s);
buyuk;
s:=s+'';s:=copy(s,1,30);writeln(f,s);
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