Реализовать в виде класса абстрактный тип данных...

{ Множество }
type mset = record
    m : array [1..NPar] of string[10];
    n : byte;
end;

===========================================================}
{ Функция, проверяющая, входит ли множество 1 в множество 2 }
function IsSubSet(set1, set2 : mset) : boolean;
var
        i,j,fl,fl1 : byte;
begin
        fl:=1;
        for i:=1 to set1.n do
        begin
                fl1:=0;
                for j:=1 to set2.n do
                begin
                        if (set1.m = set2.m[j])
                        then
                        begin
                                fl1:=1;
                        end;
                end;
                if (fl1 = 0)
                then
                begin
                        fl:=0;
                end;
        end;
        if fl=0
        then
        begin
                IsSubSet:=FALSE;
        end
        else
        begin
                IsSubSet:=TRUE;
        end;
end;

{===========================================================}
{ Процедура очистки множества }
procedure ResetSet(var vset : mset);
var
        i : byte;
begin
        for i:=1 to NPar do
        begin
                vset.m:='';
        end;
        vset.n:=0;
end;


{===========================================================}
{ Функция проверка вхождения элемента в множество }
function IsInSet(s : string; vset : mset) : boolean;
var
        i : byte;
begin
        i:=1;
        while ((i <= vset.n) and (s <> vset.m)) do
        begin
                i:=i+1;
        end;
        if (i > vset.n)
        then
        begin
                IsInSet:=FALSE;
        end
        else
        begin
                IsInSet:=TRUE;
        end;
end;


{===========================================================}
{ Процедура добавления в множество }
procedure AddToSet(s : string; var vset : mset);
begin
        if ( not IsInSet( s, vset ) )
        then
        begin
                vset.n:=vset.n+1;
                vset.m[vset.n]:=s;
        end;
end;


{===========================================================}
{ Процедура удаления элемента из множества }
procedure RemoveFromSet(s : string; var vset : mset);
var
        i,j : byte;
begin
        i:=1;
        while (s <> vset.m) do
        begin
                i:=i+1;
        end;
        if (i < vset.n)
        then
        begin
                for j:=i to vset.n-1 do
                begin
                        vset.m[j]:=vset.m[j+1];
                end;
        end;
        vset.m[vset.n]:='';
        vset.n:=vset.n-1;
end;

{===========================================================}
{ Процедура копирования множеств }
procedure CopySet(var DstSet : mset; SrcSet : mset);
var
        i : byte;
begin
        for i:=1 to SrcSet.n do
        begin
                DstSet.m:=SrcSet.m;
        end;
        DstSet.n:=SrcSet.n;
end;

Uses CRT;

const n = 100;

type u = ^rec;
     rec = record
           key: integer;
           inf: integer;
           ptr: u;
           end;
     hTab = array [1..n] of rec;


var t : hTab;
    ch : char;
    hKey, i : integer;


function HashFunc(hKey : integer) : integer;
begin
    HashFunc := hKey mod n ;
end;

procedure AddRecord (var t : hTab);
var tmp : u;
    i   : integer;
    r   : rec;

begin
    Write('Vvedite klych dobavljaemoj zapisi    :  ');
    ReadLn(r.key);
    Write('Vvedite niformacionnoe pole zapisi   :  ');
    ReadLn(r.inf);

    r.ptr := nil;

    i := HashFunc(r.key);

    if t.key = 0 then
    begin
        t := r;
        WriteLn('Zapis poneshena v poziciju ', i, '.');
    end
    else
    begin
        new(tmp);
        tmp^ := r;
        tmp^.ptr := t.ptr;
        t.ptr := tmp;
        Writeln('Pozicija ', i, ' zanjata.');
        Writeln('Zapis v cepochre perepolnenija.');
     end;
     ReadKey;
end;

procedure FindRec(var t : hTab; hKey : integer);
var
    i : integer;
    p : u;
begin
    i := HashFunc(hKey);
    WriteLn(' Poisk v tablice...');

    if t.key = hKey then
    begin
        WriteLn('Zapis najdena v pozicii  ', i);
        WriteLn('Znjachenie inf. polja ravno  : ', t.inf);
        ReadKey;
        exit;
    end;
    if t.key = 0 then
    begin
        WriteLn('Zapisi v tablice net.');
        ReadKey;
        exit;
    end;

    WriteLn(i, ' - ', t.key);
    WriteLn('Poisk v cepochke perepolnenija...');

    p := t.ptr;
    while (p <> nil) AND (p^.key <> hKey) do
    begin
      Write(p^.key,' ');
      p := p^.ptr;
   end;

   WriteLn;

   if p <> nil then
   begin
       WriteLn ('Zapis najdena');
       WriteLn ('Znachenie inf. polja -- ', p^.inf);
   end
   else
       WriteLn ('Zapis ne najdena');

   ReadKey;
end;

begin
   for i := 1 to n do
     t.key := 0;
   repeat
     ClrScr;

     WriteLn('&#227;================================¬');
     WriteLn('¦ 1 - Zanesenie zapisi v tablicu ¦');
     WriteLn('¦   2 - Poisk zapisi v tablice   ¦');
     WriteLn('¦--------------------------------¦');
     WriteLn('¦           0 - Vixod            ¦');
     WriteLn('L================================-');

     ch := ReadKey;
     WriteLn;

     case ch of
       '1' : begin
               AddRecord(t);
               WriteLn('Press any key');
             end;
       '2' : begin
               Write('Vvedite kljuch iskomoj zapisi  :  ');
               ReadLn(hKey);
               FindRec(t, hKey);
             end;
     end;

   until ch = '0';
end.