uses Crt;
const  B = 30; 
type  
celltype = record 
element: string[255];
next: ^celltype
end; 
TABL = array[0..B-1]  of  ^celltype;

var
End_Menu: boolean;
ch: char;
x: string[255];
A: TABL;

Function  h ( x: string ): 0..B-1;
var   i, sum: integer; 
begin 
sum:= 0; 
for  i:= 1  to  length(x)  do 
sum:= sum + ord( x[i] ); 
h:= sum  mod  B ;
end; 				{ h } 


procedure  MAKENULL ( var A: TABL ); 
var   i: integer; 
begin 
for  i:= 0  to  B - 1  do 
A[i]:= nil 
end; 			


function  MEMBER ( x: string; var A: TABL ): boolean; 
var   current: ^celltype; 
begin 
current:= A[h(x)]; 
{ начальное значение current равно заголовку сегмента, 
которому принадлежит элемент х } 
while  current <> nil  do 
if  current^.element = x   then  MEMBER:=true 
else  current:= current^.next; 
MEMBER:=false		 { элемент х не найден } 
end; 			

procedure  INSERT ( x: string; var A: TABL ); 
var   bucket: integer; 	{ для номера сегмента } 
oldheader: ^celltype; 
begin 
if  not MEMBER(x, A)  then  begin 
bucket:= h(x); 
oldheader:= A[bucket]; 
new( A[bucket] ); 
A[bucket] ^.element:= x; 
A[bucket] ^.next:= oldheader ;
writeln('элемент добавлен');
end 
else writeln ('такой элемент уже записан');
end; 			


procedure  DELETE ( x: string; var A: TABL ); 
var  bucket: integer; 	current: ^celltype;  f: boolean;
begin 
bucket:= h(x);   f:= true;
if  A[bucket] <> nil  then  begin 
if A[bucket] ^.element = x  then 	{ x в первой ячейке } 
A[bucket]:= A[bucket] ^.next 	{ удаление х из списка } 
else   begin 	{ x находится не в первой ячейке } 
current:= A[bucket];  
{ current указывает на предыдущую ячейку } 
while  (current^.next <> nil ) and  f  do 
	if  current^.next^.element = x  then  begin 
		current^.next := current^.next^.next;  
		{ удаление х из списка } 
		f:= false { останов } 	end 
	else   { x пока не найден }  current:= current^.next 
end 
end 
end; 			


procedure PRINT;
var
i: integer;
current: ^celltype;
begin
for i:=0 to B do
begin
writeln;
write (i,':');
if A[i]<>nil then current:=A[i];
while current<>nil do
begin
write(current^.element, '  ');
current:=current^.next;
end;
end;
end;

Procedure Menu_1;
begin
clrscr;
End_Menu:=False;
repeat
writeln;
writeln;
Writeln('***********************************************');
writeln( '*****************Главное меню******************');
Writeln('***********************************************');
writeln('                                               ');
writeln('         выберите вид работы:                  ');
writeln('        0- вставка элемента                    ');
writeln('        1- Проверка на существование элемента  ');
writeln('        2- удаление элемента                   ');
writeln('        3- просмотреть все элементы            ');
writeln('        4- выход                              ');
writeln('***********************************************');

readln(ch);
Case ch of
'0': begin
writeln('введите эелемент для записи');
readln(x);
INSERT ( x, A ); 

end;
'1':
begin
writeln('введите элемент для поиска');
readln(x);
if  MEMBER ( x, A ) = true then writeln (' элемент существует')
else writeln('элемент не существует');
end;
'2': begin
writeln('введите элемент для удаления');
readln(x);
DELETE ( x, A ); 
writeln('элемент удален');
   end;
'3': begin   Print;  end;
'4': begin End_menu:=true;clrscr; Writeln('работа завершена, закройте программу!'); end;
end;
until End_Menu;
clrscr;
end;

BEGIN

MAKENULL ( A);
Menu_1;
end.

 

  if  not  MEMBER (x, A ) then writeln (' элемент не существует')
else writeln('элемент  существует');

  while  current <> nil  do 
    if  current^.element = x   then  MEMBER:=true 
    else  current:= current^.next;

  while  current <> nil  do
  begin
    if  current^.element = x   then  MEMBER:=true;
    current:= current^.next;
  end;

procedure Delete(x: string; var A: TABL);
var
  bucket: integer;
  current: ^celltype;
begin
  bucket:= h(x);
  if A[bucket] <> nil then
  begin
    if A[bucket]^.element = x then { x в первой ячейке }
      A[bucket] := A[bucket] ^.next { удаление х из списка }
    else
    begin { x находится не в первой ячейке }
      current := A[bucket];
      { current указывает на предыдущую ячейку }
      while current^.next <> nil do
        if current^.next^.element = x then
        begin
          current^.next := current^.next^.next; { удаление х из списка }
          exit; { останов - выходим из процедуры }
        end
        else current:= current^.next; { x пока не найден }
    end; { else }
  end; { if <> nil }
end; { Delete }

for i:=0 to B do
begin

procedure  DELETE ( x: string; var A: TABL ); 
var
  bucket: integer;
  current, tmp: pcelltype;
  f: boolean;
begin
  bucket:= h(x);
  f:= true;
  if  A[bucket] <> nil  then  begin
    if A[bucket] ^.element = x  then 	{ x в первой ячейке }
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }
    else   begin 	{ x находится не в первой ячейке }
      current:= A[bucket];
      { current указывает на предыдущую ячейку }
      while  (current^.next <> nil ) and  f  do
        if  current^.next^.element = x  then  begin
          tmp := Current^.Next;
          current^.next := current^.next^.next;
          Dispose(tmp);
          { удаление х из списка }
          f:= false { останов }
        end else   { x пока не найден }
          current:= current^.next
    end
  end
end; 		
	

BEGIN

assign(input, 'hash.txt');
reset(input);

MAKENULL ( A);
Menu_1;
close(input);
end.

if A[bucket] ^.element = x  then 	{ x в первой ячейке }
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }

if A[bucket] ^.element = x  then begin 	{ x в первой ячейке }
      tmp := A[bucket];
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }
      Dispose(tmp);
end

procedure  Udalenie ( x: string; var A: TABL ); 
var  nomerSegm: integer; 	ukaz,ud: ^zapis;  
begin 
nomerSegm:= h(x);   
if  A[nomerSegm] <> nil  then  begin 
if A[nomerSegm] ^.element = x  then 	 
A[nomerSegm]:= A[nomerSegm] ^.next 	  
else   begin 	
ukaz:= A[nomerSegm];
ud:=ukaz^.next;  
while  (ukaz^.next <> nil )  do 
	if  ud^.element = x  then 
	begin
		 ukaz^.next := ud^.next; 
		 dispose(ud); exit;
	end
	else   begin 
	    ukaz:= ukaz^.next ;
	    ud:=ud^.next; 
	       end;
end 
end 
end; 			

 
0:ррр 
1:
2:
3:
4:ороро 
5:
6:оро 
7:
8:ро 
9:

 

 

0:ррр 
1:
2:
3:
4:ороро 
5:
6:оро 
7:про 
8:㳮￿9: