{$I KEYS}

unit Indextrd;

interface
procedure IndAddName (var s :string; A :pointer);
function  IndFindName(var s :string) :pointer;
function  UnloadInd  (u :boolean) :longint;

implementation

type pItype = ^Itype;

      Itype = record
                A      :pointer;
                Next   :pItype;
                Other  :pItype;
                C      :char;
              end;

var   IndexI :pItype;



var UnloSumma :longint;


procedure EraseI(var p :pItype; u :boolean);
begin
if p <> nil
then begin
     EraseI(p^.Next, u);
     EraseI(p^.Other, u);
     UnloSumma:=UnloSumma + sizeof(p^);
     if u then begin
               dispose(p);
               p:=nil;
               end;
     end;
end;


function FindOther(C :char; p :pItype) :pItype;
label Ex;
begin
FindOther:=nil;
while p <> nil
do begin
   if p^.C = C then begin FindOther:=p; goto Ex end;
   p:=p^.Other
   end;
Ex:
end;


function MakeNext :pItype;
var q :pItype;
begin
new(q);
q^.C:='^'; q^.A:=nil; q^.Next:=nil; q^.Other:=nil;
MakeNext:=q;
end;


function UnloadInd(u :boolean) :longint;
begin
UnloSumma:=0;
EraseI(IndexI, u);
UnloadInd:=UnloSumma;
end;


procedure IndAddName(var s :string; A :pointer);
var p,q :pItype; pU :^pItype; i,L :integer;
begin
p:=IndexI; pU:=@IndexI; L:=length(s);
for i:=1 to L
do begin
   q:=FindOther(s[i],p);
   if q = nil
   then begin
        new(q);
        q^.C:=s[i];
        q^.A:=nil; q^.Next :=MakeNext; q^.Other:=p;
        pU^:=q;
        end;
   if i=L then q^.A:=A;
   p:=q^.Next; pU:=@q^.Next;
   end;
end;


function IndFindName(var s :string) :pointer;
label 1,Ex; var i,L :integer; p,q :pItype; c :char;
begin
IndFindName:=nil;
if s <> ''
then begin
     L:=length(s);
     p:=IndexI;
     for i:=1 to L
     do begin
        {------------------}
        c:=s[i]; q:=nil;
        while p <> nil
        do begin
           if p^.c = c then begin q:=p; goto 1 end;
           p:=p^.Other
           end;
        1: (* *);
        {------------------}
        if q = nil then goto Ex;
        p:=q^.Next;
        end;
     IndFindName:=q^.A;
     end;
Ex:
end;


begin
IndexI:=nil;
end.