Правила форума
Прочтите прежде чем задавать вопрос!
помогите пожалуйста найти ошибку.
.
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.
