%PDF- %PDF-
Mini Shell

Mini Shell

Direktori : /www/varak.net/www.varak.net/programy/
Upload File :
Create Path :
Current File : //www/varak.net/www.varak.net/programy/ws_main.pas

unit ws_sql;
interface
 type
     lpst = ^student;
     student = record
             jmeno : string[30];
             prijmeni : string[30];
             vek : byte;
             next : lpst;
     end;
     dstudent = record
             jmeno : string[30];
             prijmeni : string[30];
             vek : byte;
     end;
 function create(student : dstudent) : lpst;
 procedure insert(first : lpst; novy : dstudent);
 procedure delete(var first : lpst; deleted : lpst);
 function find(first : lpst; krit_t : byte; kriterium : string) : lpst;
 function find(first : lpst; krit_t : byte; kriterium : byte) : lpst;
 procedure print(first : lpst);
 procedure sort(first : lpst; krit_t : byte);
 procedure save(first : lpst; fil : string);
 procedure load(var first : lpst; fil : string);


implementation

 function create(student : dstudent) : lpst;
  var
     pom : lpst;
  begin
       new(pom);
       pom^.jmeno := student.jmeno;
       pom^.prijmeni := student.prijmeni;
       pom^.vek := student.vek;
       pom^.next := nil;
       create := pom;
  end;

 procedure insert(first : lpst; novy : dstudent);
  var
     pom : lpst;
     i : integer;
  begin
       pom := first;
       i := 0;
       while(pom^.next <> nil) do
        begin
             pom := pom^.next;
             inc(i);
        end;
       new(pom^.next);
       pom := pom^.next;
       pom^.jmeno := novy.jmeno;
       pom^.prijmeni := novy.prijmeni;
       pom^.vek := novy.vek;
       pom^.next := nil;
  end;

 procedure delete(var first : lpst; deleted : lpst);
  var
     pom : lpst;
  begin
     if(deleted = first) then
      begin
           first := first^.next;
      end
     else
      begin
           pom := first;
           while(pom^.next <> deleted) do
            begin
                 if(pom^.next <> deleted) then
                  begin
                       pom := pom^.next;
                  end;
            end;
           pom^.next := pom^.next^.next;
           dispose(deleted);
      end;
  end;

 function find(first : lpst; krit_t : byte; kriterium : string) : lpst;
  var
     pom : lpst;
  begin
       pom := first;
       case krit_t of
        1 : begin
          while((pom <> nil) and (pom^.jmeno <> kriterium)) do
           begin
                pom := pom^.next;
           end;
           find := pom;
        end;
        2 : begin
          while((pom <> nil) and (pom^.prijmeni <> kriterium)) do
           begin
                pom := pom^.next;
           end;
           find := pom;
        end
        else begin
             find := nil;
        end;
       end;
  end;

 function find(first : lpst; krit_t : byte; kriterium : byte) : lpst;
  var
     pom : lpst;
  begin
       pom := first;
       case krit_t of
        1 : begin
          while((pom <> nil) and (pom^.vek <> kriterium)) do
           begin
                pom := pom^.next;
           end;
           find := pom;
        end
        else begin
             find := nil;
        end;
       end;
  end;

 procedure print(first : lpst);
  var
     pom : lpst;
  begin
       pom := first;
       while(pom <> nil) do
        begin
             writeln('Jmeno: ', pom^.jmeno);
             writeln('Prijmeni: ', pom^.prijmeni);
             writeln('Vek: ', pom^.vek);
             writeln(#10#13, '-------------------------------------------------------------------------------', #10#13);
             pom := pom^.next;
        end;
  end;

 function isbigger(ptr1 : lpst; ptr2 : lpst; typ : byte) : boolean;
  begin
       case typ of
            1 : begin
              if(ptr1^.jmeno > ptr2^.jmeno) then
               begin
                    isbigger := true;
               end
              else
               begin
                    isbigger := false;
               end;
            end;
            2 : begin
              if(ptr1^.prijmeni > ptr2^.prijmeni) then
               begin
                    isbigger := true;
               end
              else
               begin
                    isbigger := false;
               end;
            end;
            3 : begin
              if(ptr1^.vek > ptr2^.vek) then
               begin
                    isbigger := true;
               end
              else
               begin
                    isbigger := false;
               end;
            end;
       end;
  end;

 procedure sort(first : lpst; krit_t : byte);
  var
     pom : lpst;
     pocet : integer;
     i : integer;
     j : integer;
     vek : byte;
     jm : string;
  begin
       pom := first;
       pocet := 0;
       while(pom <> nil) do
        begin
             inc(pocet);
             pom := pom^.next;
        end;
       pom := first;
       for i := 0 to pocet-1 do
        begin
             pom := first;
             while(pom^.next <> nil) do
              begin
                   if(isbigger(pom, pom^.next, krit_t)) then
                    begin
                         vek := pom^.vek;
                         pom^.vek := pom^.next^.vek;
                         pom^.next^.vek := vek;

                         jm := pom^.prijmeni;
                         pom^.prijmeni := pom^.next^.prijmeni;
                         pom^.next^.prijmeni := jm;

                         jm := pom^.jmeno;
                         pom^.jmeno := pom^.next^.jmeno;
                         pom^.next^.jmeno := jm;
                    end;
                   pom := pom^.next;
              end;
        end;
  end;

 procedure save(first : lpst; fil : string);
  var
     f : file of dstudent;
     pom : lpst;
     d : dstudent;
  begin
       assign(f, fil);
       rewrite(f);
       pom := first;
       while(pom <> nil) do
        begin
             d.jmeno := pom^.jmeno;
             d.prijmeni := pom^.prijmeni;
             d.vek := pom^.vek;
             pom := pom^.next;
             write(f, d);
        end;
       close(f);
  end;

 // nutno vyresit aby first na konci ukazoval skutecne na prvni
 procedure load(var first : lpst; fil : string);
  var
     d : dstudent;
     f : file of dstudent;
  begin
       assign(f, fil);
       reset(f);
       read(f, d);
       first := create(d);
       while(not eof(f)) do
        begin
             read(f, d);
             insert(first, d);
        end;
       close(f);
  end;

end.

Zerion Mini Shell 1.0