Current File : //www/varak.net/www.varak.net/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(var 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(first = deleted) 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;{else}
end; {fce}
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;
if(pom = nil) then
begin
writeln('V databazi neni zadny student');
end;
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;
procedure sort(var first : lpst; krit_t : byte);
type
dstudenta = array[0..1] of dstudent;
var
pomp : ^dstudenta;
pom : lpst;
pocet : integer;
i : integer;
j : integer;
d : dstudent;
begin
pom := first;
pocet := 1;
while(pom^.next <> nil) do
begin
inc(pocet);
end;
getmem(pomp, pocet*sizeof(dstudent));
pom := first;
i := 1;
while(pom^.next <> nil) do
begin
pomp^[i].jmeno := pom^.jmeno;
pomp^[i].prijmeni := pom^.prijmeni;
pomp^[i].vek := pom^.vek;
end;
case krit_t of
1 : begin
for i := 0 to pocet-1 do
begin
for j := 1 to pocet-i-1 do
begin
if(pomp^[j].jmeno < pomp^[j-1].jmeno) then
begin
d := pomp^[j];
pomp^[j] := pomp^[j-1];
pomp^[j-1] := d;
end;
end;
end;
end;
2 : begin
for i := 0 to pocet-1 do
begin
for j := 1 to pocet-i-1 do
begin
if(pomp^[j].prijmeni < pomp^[j-1].prijmeni) then
begin
d := pomp^[j];
pomp^[j] := pomp^[j-1];
pomp^[j-1] := d;
end;
end;
end;
end;
3 : begin
for i := 0 to pocet-1 do
begin
for j := 1 to pocet-i-1 do
begin
if(pomp^[j].vek < pomp^[j-1].vek) then
begin
d := pomp^[j];
pomp^[j] := pomp^[j-1];
pomp^[j-1] := d;
end;
end;
end;
end;
end;
first := create(pomp^[0]);
for i := 1 to pocet-1 do
begin
insert(first, pomp^[i]);
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.
Mini Shell