Programalama > PASCAL

uses crt;
     type
        kayit=record
        Isim:string[20];
        Soyad:string[20];
        Meslek:string[20];
        Sehir:string[20];
        Telefon:string[12];
        f:char;
  end;
     var
  dosya:file of kayit;
  kay:kayit;
  tus,t:char;
  i,kod:integer;
{**************************************************************}
procedure cerceve(x1,y1,x2,y2:byte);
   var
  i:integer;
  cizgi:string[80];
 begin
   fillchar(cizgi,x2-x1,#196);
   cizgi[0]:=chr(x2-x1-1);
   gotoxy(x1,y1);write(chr(218),cizgi,chr(191));
   for i:=y1+1 to y2-1 do
 begin
   gotoxy(x1,i);write(chr(179));
   gotoxy(x2,i);write(chr(179));
        end;
  gotoxy(x1,y2);write(chr(192),cizgi,chr(217));
 end;
{*********************************************************}
procedure kayityap;
 begin
   assign(dosya,''Meslek.dat'');
   {$i-}reset(dosya);kod:=ioresult;{$i+};
   if kod<>0 then rewrite(dosya);
 repeat
  clrscr;
  cerceve(10,5,70,15);
  gotoxy(15,7);write(''Isim............:'');readln(kay.Isim);
  if kay.isim='''' then
 begin
  close(dosya);exit;
 end;
  gotoxy(15,9);write(''Meslek..........:'');readln(kay.Meslek);
  gotoxy(15,11);write(''Sehir...........:'');readln(kay.Sehir);
  gotoxy(15,13);write(''Telefon.........:'');readln(kay.Telefon);
     cerceve(10,16,70,18);
  gotoxy(25,17);write(''Bilgi Dosyaya Yazilsin Mi? [E/H]'');
repeat
    tus:=upcase(readkey);
      until tus in [''E'',''H''];
       if tus=''E'' then
 begin
  kay.f:=''*'';
  seek(dosya,filesize(dosya));
  write(dosya,kay);
 end;
  until 1=2;
end;
{********************************************************}
procedure listeleme;
 var
   s:integer;
 begin
  assign(dosya,''Meslek.dat'');
  {$i-}reset(dosya);i:=ioresult;{$i+}
  if i<>0 then
 begin
  writeln(''!!!Dosya Yok!!!'');
  tus:=readkey;halt;
 end;
   clrscr;
   writeln(''AD               MESLEK               SEHIR                  TELEFON'');
   writeln(''___________________________________________________________________'');
   window(1,3,80,25);
   s:=0;
 for i:=0 to filesize(dosya)-1 do
 begin
     seek(dosya,i);read(dosya,kay);
     if kay.f=''*'' then
  begin
   s:=s+1;
   gotoxy(1,s);write(kay.Isim);
   gotoxy(17,s);write(kay.Meslek);
   gotoxy(39,s);write(kay.Sehir);
   gotoxy(60,s);write(kay.telefon);
 end;
  if s>18 then
 begin
   gotoxy(20,21);
      write(''Diger Sayfa I&#8225;in Bir Tusa Basiniz...'');
   tus:=readkey;
   s:=0;
   clrscr;
 end;
end;
 gotoxy(20,21);write(''Listelenecek Kayitlar Bitti!...'');
 tus:=readkey;
 window(1,1,80,25);
 close(dosya);
end;
{********************************************************************}
procedure arama;
 var
   ara:string[30];
 begin
   assign(dosya,''Meslek.dat'');
   {$i-}reset(dosya);kod:=ioresult;{$i+}
   if kod<>0 then
 begin
  gotoxy(20,20);write(''!!!Dosya Yok!!!'');
  tus:=readkey;exit;
 end;
  repeat
   clrscr;
   cerceve(20,3,60,5);
   gotoxy(22,4);write(''Aradiginiz Isim:'');readln(ara);
   if ara='''' then
 begin
  close(dosya);exit;
 end;
 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;
   cerceve(10,5,70,15);
   gotoxy(15,7);writeln(''Isim...........:'',kay.Isim);
   gotoxy(15,9);writeln(''Meslek.........:'',kay.Meslek);
   gotoxy(15,11);writeln(''Sehir..........:'',kay.Sehir);
   gotoxy(15,13);writeln(''Telefon........:'',kay.Telefon);
     cerceve(10,16,70,18);
   gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]'');
      repeat
          tus:=upcase(readkey);
      until tus in [''E'',''H''];
      if tus=''E'' then
  begin
     close(dosya);exit;
   end;
  end;
end;
  writeln;
  cerceve(10,16,70,18);
  gotoxy(15,17);write(''Aradiginiz Kayit Yok.Devam Etmek I&#8225;in Bir Tusa Basiniz.'');
    tus:=readkey;
  until 1=2;
end;
{****************************************************************************}
procedure Duzeltme;
 var
   ara:string[30];
 begin
  assign(dosya,''Meslek.dat'');
  {$i-}reset(dosya);kod:=ioresult;{$i+}
  if kod<>0 then
 begin
  gotoxy(20,20);write(''!!!Dosya Yok!!!....'');
  tus:=readkey;
  exit;
 end;
  clrscr;
  cerceve(20,3,60,5);
  gotoxy(22,4);write(''D&#65533;zeltilecek Isim:'');readln(ara);
  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;
  cerceve(10,5,70,15);
  gotoxy(15,7);writeln(''Isim...........:'',kay.Isim);
  gotoxy(15,9);writeln(''Meslek.........:'',kay.Meslek);
  gotoxy(15,11);writeln(''Sehir..........:'',kay.Sehir);
  gotoxy(15,13);writeln(''Telefon........:'',kay.Telefon);
       cerceve(10,16,70,18);
  gotoxy(25,17);write(''Aradiginiz Kayit Bu Mu? [E/H]'');
      repeat
          tus:=upcase(readkey);
      until tus in [''E'',''H''];
      if tus=''E'' then
  repeat
   clrscr;
    cerceve(10,5,70,17);
  gotoxy(15,7);writeln(''1-Isim...........:'',kay.Isim);
  gotoxy(15,9);writeln(''2-Meslek.........:'',kay.Meslek);
  gotoxy(15,11);writeln(''3-Sehir..........:'',kay.Sehir);
  gotoxy(15,13);writeln(''4-Telefon........:'',kay.Telefon);
  gotoxy(15,15);writeln(''5-Islem Sonu'');
    cerceve(10,18,70,20);
  gotoxy(20,19);writeln(''Se&#8225;iminiz (1..5) (Esc=iptal):'');
    repeat
      tus:=readkey;
    until tus in[''1''..''5'',#27];
    if tus<>#27 then cerceve(10,21,70,23);
      case tus of
    ''1'':begin
             gotoxy(15,22);
             write(''Isim..........:'');readln(kay.Isim);
           end;
    ''2'':begin
             gotoxy(15,22);
             write(''Meslek........:'');readln(kay.Meslek);
           end;
    ''3'':begin
             gotoxy(15,22);
             write(''Sehir.........:'');readln(kay.Sehir);
           end;
    ''4'':begin
             gotoxy(15,22);
             write(''Telefon.......:'');readln(kay.Telefon);
           end;
    ''5'':begin
             seek(dosya,i);
             write(dosya,kay);
             gotoxy(20,22);
             write(''Islem Tamamlandi...'');
             close(dosya);
             tus:=readkey;exit;
           end;
      #27:exit;
    end;
  until 1=2;
 end;
end;
  gotoxy(20,20);write(''!!!Kay&#65533;t Yok!!!'');
  close(dosya);
  tus:=readkey;
 end;
{***************************************************************************}
procedure silme;
 var
  ara:string[20];
 begin
  assign(dosya,''Meslek.dat'');
  {$i-}reset(dosya);kod:=ioresult;{$i+}
  if kod<>0 then
 begin
  gotoxy(20,20);write(''!!!Dosya Yok!!!'');
  tus:=readkey;exit;
 end;
  clrscr;
  cerceve(10,3,70,5);
  gotoxy(15,4);write(''Silinecek Isim:'');readln(ara);
  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;
      cerceve(10,5,70,15);
  gotoxy(15,7);writeln(''Isim...........:'',kay.Isim);
  gotoxy(15,9);writeln(''Meslek.........:'',kay.Meslek);
  gotoxy(15,11);writeln(''Sehir..........:'',kay.Sehir);
  gotoxy(15,13);writeln(''Telefon........:'',kay.Telefon);
       cerceve(10,16,70,18);
  gotoxy(25,17);write(''Silinecek Kayit Bu Mu? [E/H]'');
      repeat
          tus:=upcase(readkey);
      until tus in [''E'',''H''];
      if tus=''E'' then
    begin
     kay.f:=''s'';
     seek(dosya,i);write(dosya,kay);
     gotoxy(20,20);write(''Kayit Silindi!...'');
     close(dosya);
     tus:=readkey;
     exit;
   end;
  end;
 end;
  gotoxy(20,20);write(''!!!Kayit Yok!!!'');
  close(dosya);tus:=readkey;
 end;
{**********************************************************************}
procedure ekran;
 begin
   clrscr;
    cerceve(1,1,80,24);
    cerceve(3,2,78,4);
    cerceve(3,5,20,20);
    cerceve(22,5,60,7);
    cerceve(22,8,60,23);
    cerceve(62,5,78,20);
    cerceve(3,21,20,23);
    cerceve(62,21,78,23);
    gotoxy(27,3);write(''TELEFON TAKIP PROGRAMI'');
    gotoxy(27,6);write(''Design by restart_on'');
 end;
{***************************************************************************}
begin
   repeat
    ekran;
     gotoxy(30,10);write(''1-Bilgi Girisi'');
     gotoxy(30,12);write(''2-Bilgi Listesi'');
     gotoxy(30,14);write(''3-Bilgi Arama'');
     gotoxy(30,16);write(''4-Bilgi D&#65533;zeltme'');
     gotoxy(30,18);write(''5-Bilgi Silme'');
     gotoxy(30,20);write(''Se&#8225;iminiz (Esc=Cikis):'');
       repeat
        t:=readkey;
        if t=#27 then halt;
        until t in[''1''..''5'',#27.);
         case t of
            ''1'':Kayityap;
            ''2'':Listeleme;
            ''3'':Arama;
            ''4'':Duzeltme;
            ''5'':Silme;
       end;
    until false;
end.

restart_on
restart_on@hotmail.com