Programalama > PASCAL

uses crt;
type
kayit=record
hesap,maas:longint;
adres:string[30];
tel:string[11];
isim,soy:string[30];
egit,hobi,fobi,meslek,web,mail:string[40];
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus:char;
s,dongu,i,kod:integer;
ara:string[20];

procedure kutuciz(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 gotoxy(x1+1,y1);writeln('[ ]');
 textcolor(lightgreen);
 gotoxy(x1+2,y1);writeln('ş');
 textcolor(white);
 gotoxy(x1+5,y1);writeln(baslik);
end;
procedure ust_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 end;


procedure alt_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 end;
 procedure sag_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 end;
  procedure yazi_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 end;



 procedure sol_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

 for dongu:=x1 to x2 do
 begin
  gotoxy(dongu,y1);write('Í');
  gotoxy(dongu,y2);write('Í');
 end;
 for dongu:=y1 to y2 do
 begin
  gotoxy(x1,dongu);writeln('º');
  gotoxy(x2,dongu);writeln('º');
 end;
 gotoxy(x1,y1);writeln('É');
 gotoxy(x2,y1);writeln('»');
 gotoxy(x1,y2);writeln('È');
 gotoxy(x2,y2);writeln('¼');
 GOTOXY(20,12);writeln('HAZIRLAYAN: UGUR GšVEN & OSMAN CiVELEK');
 gotoxy(12,41);writeln('brokenaframe@hotmail.com   gencturk55@messengeruser.com')
 end;



                     {listeleme procedure si}

procedure listele;
begin
clrscr;
assign(dosya,'maas.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then begin  textcolor(red);
kutuciz('listele',15,15,60,5);
gotoxy(35,25);write('dosya yok');
tus:=readkey; halt;
end;
s:=11;
for i:=0 to filesize(dosya)-1 do
begin
textcolor(red);
seek(dosya,i);
read(dosya,kay);
if kay.f='*' then begin
s:=s+1;
kutuciz('listele',5,10,76,23);
gotoxy(6,s);   write(i+1:3);
gotoxy(12,s);  write('Isim..:',kay.isim);
gotoxy(34,s);  write('Soyad..:',kay.soy);
gotoxy(56,s);  write('Tel..:',kay.tel);
end;
if s>20 then begin
readkey;
tus:=readkey;
s:=11;
clrscr;
end;
end;
close(dosya);
readln;
end;

                     {kayit yapma procedur }
procedure kayityap;
begin
assign(dosya,'maas.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+};
if kod<>0 then rewrite(dosya);
repeat
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('MENU',20,18,60,33);
gotoxy(23,22);  write('Isim......:');
gotoxy(23,24);  write('Soyisim...:');
gotoxy(23,26);  write('Adres.....:');
gotoxy(23,28);  write('Telefon...:');
gotoxy(23,30);  write('Mail......:');
gotoxy(35,22); readln(kay.isim);
gotoxy(35,24); readln(kay.soy);
gotoxy(35,26); readln(kay.adres);
gotoxy(35,28); readln(kay.tel);
gotoxy(35,30); readln(kay.mail);
gotoxy(24,36); write('Bilgi Dosyaya Yazilsinmi [E/H]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then begin
clrscr;
kay.f:='*';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 3=3;
end;

              {dzelt me prodecure si}

procedure duzelt;
var
ara:string[30];
begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DUZELT',20,18,60,33);
assign(dosya,'maas.dat');
{$i-} reset (dosya); kod:=ioresult; {$i+}
if kod<>0 then begin  writeln('dosya yok.....');
tus:=readkey; exit;
end;
gotoxy(23,25);write('Dzeltilecek Isim...:');  readln(ara);
writeln;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (ara=kay.isim) and (kay.f='*') then begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT D&#353;ZELT',20,18,60,33);
gotoxy(23,22);  write('Isim......:',kay.isim);
gotoxy(23,24);  write('Soyisim...:',kay.soy);
gotoxy(23,26);  write('Adres.....:',kay.adres);
gotoxy(23,28);  write('Telefon...:',kay.tel);
gotoxy(23,30);  write('Mail......:',kay.mail);
gotoxy(24,36); writeln('dzeltilecek kayit bu mu? [E/H]');

repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT D&#353;ZELT',20,18,60,33);
textcolor(red);
GOTOXY(23,22);  write('Yeni isim......:');
gotoxy(23,24);  write('Yeni Soyisim...:');
gotoxy(23,26);  write('Yeni adres.....:');
gotoxy(23,28);  write('Yeni telefon...:');
gotoxy(23,30);  write('Yeni Mail......:');
gotoxy(39,22); readln(kay.isim);
gotoxy(39,24); readln(kay.soy);
gotoxy(39,26); readln(kay.adres);
gotoxy(39,28); readln(kay.tel);
gotoxy(39,30); readln(kay.mail);
gotoxy(24,36); write('Bilgiler Dzeltiliyor.');
delay(1000);
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT D&#353;ZELT',20,18,60,33);
textcolor(red);
clrscr;
seek(dosya,i);
write(dosya,kay);
close(dosya);

exit;
end;
end;{if}
end;{for}
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT D&#353;ZELT',20,18,60,33);
textcolor(red);
gotoxy(35,36);writeln('kayit yok...');
close(dosya);
tus:=readkey;
end;


              {arama procedure si}

procedure arama;
begin
assign(dosya,'maas.dat');
 {$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then begin writeln('Dosya yok'); tus:=readkey; halt; end;
repeat;
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('MENU',20,18,60,33);

GOTOXY(23,25);write('Aradiniz 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;
gotoxy(43,32); write('Arama Tamamlandi.');
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT ARAMA',20,18,60,33);
GOTOXY(23,21);  write('isim......:',kay.isim);
gotoxy(23,23);  write('Soyisim...:',kay.soy);
gotoxy(23,25);  write('Adres.....:',kay.adres);
gotoxy(23,27);  write('Telefon...:',kay.tel);
gotoxy(23,29);  write('Mail Adresiniz..:',kay.mail);
gotoxy(25,36); write('Aradiginiz Kayit Bu Mu ? [E/H]');

REPEAT
tus:=upcase(readkey);
until tus in ['E','H',#27];
if (tus='E') or (tus=#27) then exit;
end;
end;{for}
CLRSCR;
textcolor(red);

ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT ARAMA',20,18,60,33);
gotoxy(25,36);writeln('Aradiginiz kayit yok.....');
tus:=readkey;
until 1=2;
end;

               {ana men procedure si}
procedure menu;
begin
repeat
CLRSCR;
textcolor(darkgray);
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);  kutuciz('KAYIT ARAMA',20,18,60,33);
GOTOXY(23,22);writeln('[  F1  ] KAYIT EKLE ');
GOTOXY(23,24);writeln('[  F2  ] KAYIT ARA');
GOTOXY(23,26);writeln('[  F3  ] KAYIT D&#353;ZELT');
GOTOXY(23,28);writeln('[  F4  ] KAYIT LiSTELE');
GOTOXY(23,30);writeln('[ ESC  ] &#8364;IK');
tus:=readkey; case tus of
';':kayityap;
'<':arama;
'=':duzelt;
'>':listele;
#27:halt;
end;
until  1=2;
end;


begin {ana program}
menu;
kayityap;
arama;
close(dosya);
end.