Programalama > PASCAL

program ajanda_binary_file_ile;
uses wincrt;
type
    kayit= record
           ad , okul , tel: string[15];
           end;
var
   dd: file of kayit;
   rehber1, rehber2: kayit;
   n, karar, i: integer;
   sifre: string;
function adres(rehber1: kayit):integer;
var
chb, chs: char;
b,s,uz: integer;
begin
     uz:= length(rehber1.ad);
     chb:= rehber1.ad[1];
     chs:= rehber1.ad[uz];
     b:= ord(chb);
     s:= ord(chs);
     adres:= ( ( b+s) * uz ) mod (filesize(dd));
end;


procedure kaydet;
var
ch1: char;
begin
repeat
      write('---- ad      >>> '); readln(rehber1.ad);
      write('---- okul    >>> '); readln(rehber1.okul);
      write('---- telefon >>> '); readln(rehber1.tel);
      seek(dd, adres(rehber1));
      read(dd,rehber2);
      if (length(rehber2.ad) <> 0) then
      begin
           writeln('!!! UYARI !!! kayit yapilacak yerde zaten baska bir kayit var')
      end
      else
      begin
           seek(dd,adres(rehber1));
           write(dd,rehber1);
           writeln('-------------!!! kayit olusturuldu !!!------------------')
      end;
      writeln('devam etmek istiyormusunuz??? < e , h >');
      ch1:= readkey;
until ch1 in ['h', 'H' ] 
end;


procedure degistir;
var
   ch: char;
begin
     writeln(' degistirmek istediginiz kisinin adini giriniz... ');
     write('ad >>> ');
     readln(rehber1.ad);
     seek(dd, adres(rehber1));
     read(dd, rehber2);
     writeln('aradiginiz kisinin yerinde bulunan bilgiler...');
     writeln('----------------------------------------------------------');
     writeln(rehber2.ad:20, rehber2.okul:20,rehber2.tel: 20);
     writeln('-----------------------------------------------------------');
     writeln('aradiginiz bilgiler bunlar mi??? < e , h > ');
     ch:=readkey;
     if ch in ['e', 'E' ] then
     begin
          write('    ad      >>> ');readln(rehber2.ad);
          write('    okul    >>> '); readln(rehber2.okul);
          write('    telefon >>> '); readln(rehber2.tel);
          seek(dd,adres(rehber1));
          write(dd, rehber2);
          writeln('------------ !!!! bilgiler degistirildi !!!! --------------- ');
     end
     else
     writeln(' aradiginiz kisi bulunamadi!!! tekrar deneyin!!! ');
end;
procedure  oku;
begin
     for i:=1 to (filesize (dd) - 1) do
     begin
          seek(dd, i);
          read(dd,rehber1);
          if (length( rehber1.ad)<>0) then
          begin
               writeln('-------------------------------------------------------');
               writeln(rehber1.ad:20,rehber1.okul:20, rehber1.tel:20)
          end
     end;
     writeln; writeln;
     writeln('---------------------- !!! bilgiler yazdirildi !!! ------------------------');
end;
label
     bas,son, yer1,yer2,yer3,yer4;
begin
     writeln('------------------------------------------------------------------------------');
     writeln;
     writeln('----------------------  A --- J --- A --- N --- D --- A  ---------------------' );
     writeln;
     writeln('-------------------------------------------------------------------------------');
     assign(dd, 'rehber.dat');
     reset(dd);
     bas:
         writeln(' 1 : dosya olusturacagim (kayitlar silinir)');
         writeln(' 2 : yeni kayit ekleyecegim');
         writeln(' 3 : varolan kaydi degistirecegim');
         writeln(' 4 : ajandami gorecegim');
         writeln(' 5 : isim bitti, ben kacar hocaaaa! ');
         readln(karar);
         case karar of
         1: goto yer1;
         2: goto yer2;
         3: goto yer3;
         4: goto yer4;
         5: goto son
         end;
         yer1: writeln('sifre??? :)))');
               readln(sifre);
               if (sifre='kopuk')  then
               begin
              close(dd); rewrite(dd);
              write(' kac tane kayit olusturulacak >>> '); readln(n);
              for i:=1 to n do
              begin
                   seek(dd,i);
                   rehber1.ad:='';rehber1.okul:=''; rehber1.tel:='';
                   write(dd,rehber1);
              end;
                  writeln('--------------------------!!! dosya olusturuldu !!!----------------------------');
              close(dd); reset(dd);
              end
              else
              writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
           goto bas;
         yer2:writeln('sifre??? :)))');
               readln(sifre);
               if (sifre='kopuk')  then
               begin
              kaydet;
              end
              else
              writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
         goto bas;
         yer3:  writeln('sifre??? :)))');
               readln(sifre);
               if (sifre='kopuk')  then
               begin
              degistir;
              end
              else
              writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
         goto bas;
         yer4:  writeln('sifre??? :)))');
               readln(sifre);
               if (sifre='kopuk')  then
               begin
              oku;
              end
              else
              writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
         goto bas;
         son:
         writeln('--------- güle güle, iYi GüNLER ------------')
end.