Programalama > PASCAL

Etiketler: telefon, rehberi

Ort. 0
Puan ver:
program telefon_defteri;
uses crt;

type
    kayit_tipi=record
      kayitNo:longint;
      isim:string[14];
      soyad:string[20];
      tel:string[12];
end;

var
kayit:kayit_tipi;
dosya:file of kayit_tipi;
devam,secim,kontrol,sec,sil,emin,x:char;
i,j:integer;
kod:longint;
ara,bul:string[14];



label
bas,son;

procedure yeni_kayit;

begin
     clrscr;
     reset(dosya);
     devam:='E';
     writeln('   *****Kayıt Girişi*****   ':35);writeln;
     while devam<>'H' do
     begin
     kontrol:='H';
        while kontrol<>'E' do
        begin
             kayit.kayitno:=filesize(dosya)+1;
             writeln;
             write('   ');write(' Kayıt No Giriniz => ',kayit.kayitno);writeln;
             if kayit.kayitno=0 then break;
             write('   ');for i:=1 to 37 do write(#205);writeln;
             write('   ');write(' İsim Giriniz  : ');readln(kayit.isim);
             if kayit.isim='0' then break;
             write('   ');write(' Soyad Giriniz : ');readln(kayit.soyad);
             if kayit.soyad='0' then break;
             write('   ');write(' Telefon No    : ');readln(kayit.tel);
             if kayit.tel='0' then break;
             write('   ');for i:=1 to 37 do write(#205);writeln;
             write('   ');write(' Girilen Kayıt Doğru mu?(E/H) ');readln(kontrol);

        end;
     if kayit.kayitno=0 then break;
     if kayit.isim='0' then break;
     if kayit.soyad='0' then break;
     if kayit.tel='0' then break;
     seek(dosya,kayit.kayitno-1);
     write(dosya,kayit);
     writeln;
     write(' Devam mı?(E/H) ');readln(devam);
     end;close(dosya);
end;

procedure okuma;
begin
     clrscr;
     reset(dosya);
     devam:='E';
     while devam<>'H' do
     begin
          clrscr;
          writeln('   *****Kayıt Okuma*****   ':35);writeln;
          write('   ');write(' Kayıt No Giriniz => ');readln(kod);
          if kod=0 then break;
          seek(dosya,kod-1);
          read(dosya,kayit);
          write('   ');for j:=1 to 31 do write(#205);writeln;
          write('   ');write(' İsim    : ');writeln(kayit.isim);
          write('   ');write(' Soyad   : ');writeln(kayit.soyad);
          write('   ');write(' Telefon : ');writeln(kayit.tel);
          write('   ');for j:=1 to 31 do write(#205);writeln;
          write('   ');write(' Devam mı?(E/H) ');readln(devam);writeln;

     end;close(dosya);
end;

procedure liste;
label
bas,son;

begin
     reset(dosya);

     clrscr;
     writeln('                 *****Kayıt Listeleme*****   ');
     writeln;
     write('   ');write(#201);for j:=1 to 54 do write(#205);writeln(#187);
     write('   ');write(#186);write('  Kayıt No      İsim        Soyad         Telefon     ');writeln(#186);
     write('   ');write(#186);write(' ==========   ========   ===========   ============   ');writeln(#186);
     write('   ');write(#186);write('                                                      ');writeln(#186);
     i:=0;
     while i<=(filesize(dosya)-1) do
     begin
         i:=i+1;
         if (i mod 15)=0 then x:=readkey;
         write('   ');write(#186);write('    [',i,']');
         if i<10 then write('   ');
         if ((i>9) and (i<100)) then write('  ');
         if i>99 then write(' ');
         seek(dosya,i-1);
         read(dosya,kayit);
         write('    ',kayit.isim);
         if length(kayit.isim)=3 then write('     ');
         if length(kayit.isim)=4 then write('    ');
         if length(kayit.isim)=5 then write('   ');
         if length(kayit.isim)=6 then write('  ');
         if length(kayit.isim)=7 then write(' ');
         write('   ',kayit.soyad);
         if length(kayit.soyad)=2 then write('         ');
         if length(kayit.soyad)=3 then write('        ');
         if length(kayit.soyad)=4 then write('       ');
         if length(kayit.soyad)=5 then write('      ');
         if length(kayit.soyad)=6 then write('     ');
         if length(kayit.soyad)=7 then write('    ');
         if length(kayit.soyad)=8 then write('   ');
         if length(kayit.soyad)=9 then write('  ');
         if length(kayit.soyad)=10 then write(' ');
         write('   ',kayit.tel);
         if length(kayit.tel)=1 then write('           ');
         if length(kayit.tel)=2 then write('          ');
         if length(kayit.tel)=3 then write('         ');
         if length(kayit.tel)=4 then write('        ');
         if length(kayit.tel)=5 then write('       ');
         if length(kayit.tel)=6 then write('      ');
         if length(kayit.tel)=7 then write('     ');
         if length(kayit.tel)=8 then write('    ');
         if length(kayit.tel)=9 then write('   ');
         if length(kayit.tel)=10 then write('  ');
         if length(kayit.tel)=11 then write(' ');
         write('   ');writeln(#186);
     end;
     write('   ');write(#200);for j:=1 to 54 do write(#205);writeln(#188);
     writeln;
     write(' Seçiminiz => ');readln(kod);
     if kod=0 then goto son;
     seek(dosya,kod-1);
     read(dosya,kayit);
     write(' İsim    : ');writeln(kayit.isim);
     write(' Soyad   : ');writeln(kayit.soyad);
     write(' Telefon : ');writeln(kayit.tel);readln;

son: close(dosya);
end;

procedure arama;

label
son;

begin
     clrscr;
     reset(dosya);
     devam:='E';
     while devam<>'H' do
     begin
          clrscr;
          writeln('   *****Kayıt Arama*****   ':40);writeln;
          write(' ');write(#201);for j:=1 to 24 do write(#205);writeln(#187);
          write(' ');write(#186);write(' [1] - İsim ile Arama   ');writeln(#186);
          write(' ');write(#186);write(' [2] - Soyad ile Arama  ');writeln(#186);
          write(' ');write(#186);write(' [3] - Numara ile Arama ');writeln(#186);
          write(' ');write(#186);write(' [4] - Kayıt Silme      ');writeln(#186);
          write(' ');write(#186);write(' [5] - Ana Menüye Dön   ');writeln(#186);
          write(' ');write(#200);for j:=1 to 24 do write(#205);writeln(#188);
          write('  Seçiminiz => ');readln(secim);writeln;
          if secim='5' then break;
          if secim='0' then break;
          if secim='4' then begin
          clrscr;
          writeln('   *****Kayıt Silme*****   ':40);writeln;
          write(' ');write(#201);for j:=1 to 26 do write(#205);writeln(#187);
          write(' ');write(#186);write(' [1] - İsim ile Silme     ');writeln(#186);
          write(' ');write(#186);write(' [2] - Soyad ile Silme    ');writeln(#186);
          write(' ');write(#186);write(' [3] - Numara ile Silme   ');writeln(#186);
          write(' ');write(#186);write(' [4] - Kayıt No ile Silme ');writeln(#186);
          write(' ');write(#186);write(' [0] - Menüye Dön...      ');writeln(#186);
          write(' ');write(#200);for j:=1 to 26 do write(#205);writeln(#188);
          write('  Seçiminiz => ');readln(sec);writeln;
          if sec='0' then break;
          if sec='4' then begin
          write(' Silinecek Kayıt No Giriniz => ');readln(kod);
          clrscr;
          seek(dosya,kod-1);
          read(dosya,kayit);
          write(' ');for j:=1 to 31 do write(#205);writeln;
          write(' ');writeln(' Kayıt No  => ',kod);
          write(' ');write(' İsim    : ');writeln(kayit.isim);
          write(' ');write(' Soyad   : ');writeln(kayit.soyad);
          write(' ');write(' Telefon : ');writeln(kayit.tel);
          write(' ');for j:=1 to 31 do write(#205);writeln;
          write('  Eminmisiniz?(E/H) ');readln(emin);writeln;
          if emin<>'E' then goto son;
          kayit.isim:=' ';
          kayit.soyad:=' ';
          kayit.tel:=' ';
          seek(dosya,kod-1);
          write(dosya,kayit);
          writeln(' ',kayit.kayitno,'. Kayıt Silindi...');writeln;
son:      end;
          if sec='1' then begin
          write(' Silincek Kişinin İsmini Giriniz: ');readln(bul);
          i:=0;
          clrscr;
             while i<=(filesize(dosya)-1) do
             begin
             seek(dosya,i);
             read(dosya,kayit);
             if kayit.isim=bul then
                begin
                     writeln;
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write(' ');writeln(' Kayıt No  => ',(i+1));
                     write(' ');write(' İsim    : ');writeln(kayit.isim);
                     write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                     write(' ');write(' Telefon : ');writeln(kayit.tel);
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write('  Silinsin mi?(E/H) ');readln(sil);writeln;
                     if sil<>'H' then begin
                      kayit.isim:=' ';
                      kayit.soyad:=' ';
                      kayit.tel:=' ';
                      seek(dosya,i);
                      write(dosya,kayit);
                      writeln(' Silindi...');writeln;
                     end;
                end;i:=i+1;
             end;
          end;
          if sec='2' then begin
          write(' Silincek Kişinin Soyadını Giriniz: ');readln(bul);
          i:=0;
          clrscr;
             while i<=(filesize(dosya)-1) do
             begin
             seek(dosya,i);
             read(dosya,kayit);
             if kayit.soyad=bul then
                begin
                     writeln;
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write(' ');writeln(' Kayıt No  => ',(i+1));
                     write(' ');write(' İsim    : ');writeln(kayit.isim);
                     write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                     write(' ');write(' Telefon : ');writeln(kayit.tel);
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write('  Silinsin mi?(E/H) ');readln(sil);writeln;
                     if sil<>'H' then begin
                      kayit.isim:=' ';
                      kayit.soyad:=' ';
                      kayit.tel:=' ';
                      seek(dosya,i);
                      write(dosya,kayit);
                      writeln(' Silindi...');writeln;
                     end;
                end;i:=i+1;
             end;
          end;
          if sec='3' then begin
          write(' Silincek Kişinin Numarasını Giriniz: ');readln(bul);
          i:=0;
          clrscr;
             while i<=(filesize(dosya)-1) do
             begin
             seek(dosya,i);
             read(dosya,kayit);
             if kayit.tel=bul then
                begin
                     writeln;
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write(' ');writeln(' Kayıt No  => ',(i+1));
                     write(' ');write(' İsim    : ');writeln(kayit.isim);
                     write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                     write(' ');write(' Telefon : ');writeln(kayit.tel);
                     write(' ');for j:=1 to 31 do write(#205);writeln;
                     write('  Silinsin mi?(E/H) ');readln(sil);writeln;
                     if sil<>'H' then begin
                      kayit.isim:=' ';
                      kayit.soyad:=' ';
                      kayit.tel:=' ';
                      seek(dosya,i);
                      write(dosya,kayit);
                      writeln(' Silindi...');writeln;
                     end;
                end;i:=i+1;
             end;
          end;
          end;
          if secim='1' then begin
          write(' Aranan Kişinin İsmini Giriniz: ');readln(ara);
          i:=0;
          clrscr;
          while i<=(filesize(dosya)-1) do
          begin
               seek(dosya,i);
               read(dosya,kayit);
               if ara=kayit.isim then
                  begin
                    writeln;
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    write(' ');writeln(' Kayıt No  => ',(i+1));
                    write(' ');write(' İsim    : ');writeln(kayit.isim);
                    write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                    write(' ');write(' Telefon : ');writeln(kayit.tel);
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    readln;
                  end;
                  i:=1+i;
          end;end;
          if secim='2' then begin
          write(' Aranan Kişinin Soyadını Giriniz: ');readln(ara);
          if ara='0' then break;
          i:=0;
          clrscr;
          while i<=(filesize(dosya)-1) do
          begin
               seek(dosya,i);
               read(dosya,kayit);
               if ara=kayit.soyad then
                  begin
                    writeln;
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    write(' ');writeln(' Kayıt No  => ',(i+1));
                    write(' ');write(' İsim    : ');writeln(kayit.isim);
                    write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                    write(' ');write(' Telefon : ');writeln(kayit.tel);
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    readln;
                  end;
                  i:=1+i;
          end;end;
          if secim='3' then begin
          write(' Aranan Kişinin Telefon Nosu nu Giriniz: ');readln(ara);
          if ara='0' then break;
          i:=0;
          clrscr;
          while i<=(filesize(dosya)-1) do
          begin
               seek(dosya,i);
               read(dosya,kayit);
               if ara=kayit.tel then
                  begin
                    writeln;
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    write(' ');writeln(' Kayıt No  => ',(i+1));
                    write(' ');write(' İsim    : ');writeln(kayit.isim);
                    write(' ');write(' Soyad   : ');writeln(kayit.soyad);
                    write(' ');write(' Telefon : ');writeln(kayit.tel);
                    write(' ');for j:=1 to 31 do write(#205);writeln;
                    readln;
                  end;
                  i:=1+i;
          end;end;
          write('Başka Arama Yapmak İstiyormusunuz?(E/H) ');readln(devam);writeln;
     end;close(dosya);
end;

procedure duzelt;

label
bas,son;

begin
     reset(dosya);
bas: clrscr;
     writeln('   *****Kayıt Düzeltme*****   ':35);writeln;
     write('   ');write(' Düzeltilecek Kayıt No => ');readln(kod);
     if kod=0 then goto son;
     seek(dosya,kod-1);
     read(dosya,kayit);
     write('   ');for j:=1 to 31 do write(#205);writeln;
     write('   ');write(' İsim    : ');writeln(kayit.isim);
     write('   ');write(' Soyad   : ');writeln(kayit.soyad);
     write('   ');write(' Telefon : ');writeln(kayit.tel);
     write('   ');for j:=1 to 31 do write(#205);writeln;
     write('    Bu Kayıtı Düzeltmek İstiyormusunuz?(E/H) ');readln(secim);writeln;
     if secim<>'H' then
        begin
             write('   ');writeln(' Düzeltilen Kayıt No => ',kod);
             write('   ');for j:=1 to 31 do write(#205);writeln;
             write('   ');write(' Yeni Kayıt No => ');readln(kayit.kayitno);
             write('   ');write(' Yeni İsim    : ');readln(kayit.isim);
             write('   ');write(' Yeni Soyad   : ');readln(kayit.soyad);
             write('   ');write(' Yeni Telefon : ');readln(kayit.tel);
             write('   ');for j:=1 to 31 do write(#205);writeln;
             writeln('    Düzeltildi...');
             seek(dosya,kayit.kayitno-1);
             write(dosya,kayit);
             if kayit.kayitno<>kod then
                begin
                     kayit.isim:=' ';
                     kayit.soyad:=' ';
                     kayit.tel:=' ';
                     seek(dosya,kod-1);
                     write(dosya,kayit);
                end;
             writeln;
             write(' ');write('Başka Düzeltme Yapmak İstermisiniz?(E/H) ');readln(devam);
             if devam<>'H' then goto bas;
             if devam='H' then goto son;
        end else
     if secim='H' then goto bas;
son:close(dosya);
end;

procedure giris1;

label
son;

begin

     textbackground(1);textcolor(14);clrscr;
     assign(dosya,'Rehber.DAT');
     {$I-} reset(dosya) {$I+};
     if ioresult<>0 then
        begin
             rewrite(dosya);
             close(dosya);
             reset(dosya);
        end;close(dosya);
son:
end;

procedure menu;

label
son;

begin
     while secim<>'6' do
     begin
     clrscr;
     writeln('   *****Telefon Defteri Program Menüsü*****   ');writeln;
     write('   ');write(#201);for i:=1 to 26 do write(#205);writeln(#187);
     write('   ');write(#186);write('  [1] - Kayıt Girşi      ');writeln(#186);
     write('   ');write(#186);write('  [2] - Kayıt Okuma       ');writeln(#186);
     write('   ');write(#186);write('  [3] - Kayıt Listeleme   ');writeln(#186);
     write('   ');write(#186);write('  [4] - Kişi Arama & Silme');writeln(#186);
     write('   ');write(#186);write('  [5] - Kayıt Düzeltme    ');writeln(#186);
     write('   ');write(#186);write('  [6] - Programdan çıkış  ');writeln(#186);
     write('   ');write(#200);for i:=1 to 26 do write(#205);writeln(#188);writeln;
     write('   Seçiminiz => ');readln(secim);
     case secim of
          '0':goto son;
          '1':yeni_kayit;
          '2':okuma;
          '3':liste;
          '4':arama;
          '5':duzelt;
     end;
     end;
son:
end;

begin
     giris1;
     menu;
end.


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2018 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.