Serv.pas

   1 unit serv;
   2
   3 interface
   4
   5 procedure FreeList(var p : pchar;   s : word);
   6 function  NewEList(var p : pointer; s : word; c : boolean) : pointer;
   7
   8 implementation
   9
  10 procedure FreeList;
  11 var r,
  12     d : pchar;
  13 begin
  14    while p <> nil do begin
  15       r := p;
  16       d := p + s - 4;
  17       move(d^, p, 4);
  18       freeMem(r, s);
  19    end;
  20 end;
  21
  22 function NextList(p : pchar; s : word) : pointer;
  23 var r,
  24     d : pchar;
  25 begin
  26    d := p + s - 4;
  27    move(d^, r, 4);
  28    NextList := r;
  29 end;
  30
  31 function NewEList;
  32 var r,
  33     d : pchar;
  34     n : pchar;
  35 begin
  36       if p = Nil then begin
  37          getmem(p, s);
  38          NewEList := p;
  39          r        := p;
  40          FillChar(r^, s, #0);
  41       end        else begin
  42          n := p;
  43          while NextList(n, s) <> nil do begin
  44             n := NextList(n, s);
  45          end;
  46          getmem(r, s);
  47          FillChar(r^, s, #0);
  48          d := n + s - 4;
  49          move(r, d^, 4);
  50          if c then begin
  51             d := r + s - 8;
  52             move(n, d^, 4);
  53          end;
  54          NewEList := r;
  55       end;
  56 end;
  57
  58 end.