Programalama > PASCAL

uses crt,printer;
type
kayit=record
isim:string[30];
maas:longint;
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus:char;
i,s,kod:integer;
ara:string[30];
d:integer;
label
aa;
   procedure kayityap;
   begin
   assign(dosya,'c:\maas.DAT');
   reset(dosya);
   kod:=IOresult;
   if kod<>0 then rewrite(dosya);
   repeat
   clrscr;
   write('isim.... : ');
   readln(kay.isim);
   if kay.isim="then exit;
   write('maas.... : ');
   readln(kay.maas);
   write('bilgi dosyaya yaz&#65533;ls&#65533;n m&#65533;? [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 arama;
        begin
        assign(dosya,'c:\maas.dat');
        reset(dosya);
        kod:=IOresult;
        if kod<>0 then
             begin
             writeln('dosya yok....' );
             tus:=readkey;
             halt;
             end;
        repeat
        clrscr;
        write('arad&#65533;g&#65533;n&#65533;z 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;
                 writeln('isim..... : ',kay.isim);
                 writeln('maas..... : ',kay.maas);
                 write('arad&#65533;g&#65533;n&#65533;z kayit bu mu? [E\H]');
                    repeat
                    tus:=upcase(readkey);
                    until tus in ['E','H'];
                    if tus='E' then exit;
                 end;
            end;
            writeln;
            writeln('arad&#65533;g&#65533;n&#65533;z kay&#65533;t yok.. ');
            tus:=readkey;
            until 1=2;
            end;





            procedure listeleme;
            begin
            assign(dosya,'c:\maas.dat');
            reset(dosya);
            I:=IOresult;
            if i<>0 then
            begin
            writeln('dosya yok');
            tus:=readkey;
            halt;
            end;
            clrscr;
            writeln('s&#65533;ra no         ad soyad           maas');
            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(3,s); write(i+1:3);
            gotoxy(20,s); write(kay.isim);
            gotoxy(30,s); write(kay.maas:12);
            end;
            if  s>18 then
            begin
            gotoxy(20,21);
            write('d&#65533;ger sayfa icin b&#65533;r tusa bas&#65533;n');
           tus:=readkey;
           s:=0;
           clrscr;
           end;
           end;
           gotoxy(20,21); write('listelenecek kay&#65533;tlar bitti');
           tus:=readkey;
           window(1,1,80,25);
           close(dosya);
           end;







           procedure baslik;
           begin
           writeln(lst,'s&#65533;ra no            ad soyad         maas');
           writeln(lst,'----------      -------------    --------');
           s:=0;
           end;
           procedure yazici;
            begin
            assign(dosya,'c:\maas.dat');
            reset(dosya);
            I:=IOresult;
            if i<>0 then
            begin
            writeln('dosya yok');
            tus:=readkey;
            halt;
            end;
            clrscr;
            writeln('s&#65533;ra no         ad soyad           maas');
            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(3,s); write(lst,i+1:3);
            gotoxy(20,s); write(lst,kay.isim);
            gotoxy(30,s); write(lst,kay.maas:12);
            end;
            if  s>50 then
            begin
            gotoxy(20,21);
            write('d&#65533;ger sayfa icin b&#65533;r tusa bas&#65533;n');
           tus:=readkey;

           baslik;
           end;
           end;
           gotoxy(20,21); write('listelenecek kay&#65533;tlar bitti');
           tus:=readkey;
           window(1,1,80,25);
           close(dosya);
           end;



           procedure silme;
           begin

           assign(dosya,'c:\maas.dat');
        reset(dosya);
        kod:=IOresult;
        if kod<>0 then
             begin
             writeln('dosya yok....' );
             tus:=readkey;
             halt;
             end;
        repeat
        clrscr;
        write('silmek istediginiz 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;
                 writeln('isim..... : ',kay.isim);
                 writeln('maas..... : ',kay.maas);
                 write('silmek iste§iniz kay&#65533;t 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);
                    writeln;
                    writeln;
                    writeln('kayit silindi');
                    tus:=readkey;
                    close(dosya);
                    exit;
                    end;
                 end;
            end;
            writeln;
            writeln('silmek istediginiz kay&#65533;t yok.. ');
            close(dosya);
            tus:=readkey;
            until 1=2;
            end;



            procedure duzelt;
            begin
                    assign(dosya,'c:\maas.dat');
        reset(dosya);
        kod:=IOresult;
        if kod<>0 then
             begin
             writeln('dosya yok....' );
             tus:=readkey;
             halt;
             end;
        repeat
        clrscr;
        write('d&#65533;zelteceginiz 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;
                 writeln('isim..... : ',kay.isim);
                 writeln('maas..... : ',kay.maas);
                 write('d&#65533;zelteceginiz kayit bu mu? [E\H]');
                    repeat
                    tus:=upcase(readkey);
                    until tus in ['E','H'];
                    if tus='E' then
                    begin
                    clrscr;
                    write('Kisinin ismini giriniz=');
                    readln(kay.isim);
                    write('kisinin maas&#65533;n&#65533; giriniz=');
                    readln(kay.maas);
                    seek(dosya,i);
                    write(dosya,kay);
                    writeln;
                    writeln;
                    writeln('d&#65533;zeltildi');
                    tus:=readkey;
                    close(dosya);
                    exit;
                   end;
                 end;
            end;
            writeln;
            writeln('d&#65533;zletilecek kay&#65533;t yok.. ');
            tus:=readkey;
            close(dosya);

            until 1=2;
            end;








      begin
      textcolor(white);
      aa:
      clrscr;
      writeln('Naz&#65533;m DEM&#732;R  (SDU/Senirkent MYO &#8482;§rencisi)');
      textcolor(white);
      writeln;
      writeln;
      writeln('                          PROGRAM MEN&#353;S&#353;');
      writeln;
      textcolor(green);
      writeln('                         1 kay&#65533;t girisi ');
      writeln('                         2 kay&#65533;t arama ');
      writeln('                         3 kay&#65533;t listeleme');
      writeln('                         4 yaz&#65533;c&#65533;dan c&#65533;kt&#65533; alma');
      writeln('                         5 Kay&#65533;t silme');
      writeln('                         6 Kay&#65533;t D&#65533;zeltme');
      writeln('                         7 &#8364;&#65533;k&#65533;s');
      write('se&#8225;iminiz--->');
      readln(d);
      if d=1 then kayityap;
      if d=2 then arama;
      if d=3 then listeleme;
      if d=4 then yazici;
      if d=5 then silme;
      if d=6 then duzelt;
      if d=7 then exit;
    goto aa;
end. 


nazım demİr
demirnazim@hotmail.com