Паскаль. двусвязный некольцевой неупорядоченный список

[KaZaaM]

процедура удаления заданного элемента

Procedure deleteK(H:list);
var
p:list;

begin
   H:=head;
  writeln('write K');
  readln(k);
  writeln('write value');
  readln(l);

for i:=1 to (k-1) do
H:=H^.next;
New(p);
P^.info:=l;
P^.Next:=H^.Next;
P^.Prev:=H;
H^.Next:=P;
p^.Next^.Prev:=P;
end;

вот такие ошибки
1) удаляем k+1 узел
2) удаляем последний узел
3) в списке меньше k узлов

помогите исправить, если надо могу весь код выложить, с остальными процедурами

[Serge_Bliznykov]

приведите РАБОТАЮЩИЙ кусок программы, тогда будет повод для разговора. А так, восстанавливать описание Вашей структуры, писать код начального заполнения списка и т.д. и т.п. просто нет ни времени, ни желания...

p.s. у Вас код вообще не удаления, а ВСТАВКИ нового элемента после K-го. Причём, отсутствует проверка, что в списке вообще есть нужное число элементов (нужно в цикле for проверять не достигли ли конца списка)...

[RusArtm]

А как тогда выходить из цикла, если достигнут конец?
может надо использовать вообще другой оператор цикла?
While или repeat ?

Procedure deleteK(H:list);
var
p:list;

begin
   H:=head;
  writeln('write K');
  readln(k);
  writeln('write value');
  readln(l);

i:=1;
While (H^.next <> nil) and (i<=k) do begin
H:=H^.next;
i:=i+1;
end;

If i<k then begin writeln(энеча удалять'); exit; end;

P:=H^.Prev;
P^.Next:=H^.Next;
P:=H^.Next;
P^.Prev:=H^.Prev;

Freemem(H); {или как там в паскале, может просто Free}
end;

[KaZaaM]

вот весь код:

PHP код:

program spiskiKAZ;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
list=^node;
node=record
  info:string;
  Next,Prev:List;
end;
var

  f:text;
  l:string;
  i,k:integer;
  Head:list;
  ch:char;



Procedure add;
var
p:list;
begin
  New(p);
  writeln('Write value: ');
  readln(p^.info);
  p^.prev:=nil;
  p^.next:=head;
  head^.prev:=p;
  head:=p;
  if head=nil then
  head:=p
end;

Procedure outcircle(H:list);
begin
  while H<>nil do
  begin
    writeln(H^.info);
    H:=H^.Next;
  end;
end;


Procedure Sortlist(H:List);
Var
p1,p2,pMin:List;
min:string;
begin

  if H<>nil then
  begin
  p1:=H;
  repeat
    pMin:=p1; {ссылка на узел с мин. значением}
    min:=p1^.info;
    p2:=p1^.next;{Поиск наименьшего значения в оставшейся части списка}
    While p2<>nil do
    begin
    if p2^.info<min then
    begin
      min:=p2^.info;
      pMin:=p2;
    end;
    p2:=p2^.next;
  end;{Обмен}
  pMin^.info:=p1^.info;
  p1^.info:=min;{Переход на следующий узел}
  p1:=p1^.next;
  until p1^.next=nil;
  end;
end;




Procedure clearlist(var H:list);
var
 p:list;
begin
  while H<>nil do
  begin
    p:=h;
    h:=H^.Next;
    Dispose(p);
  end;
end;



Procedure save(H:list);
begin
  assign(f,'spisok.txt');
  rewrite(f);
  H:=head;
  while h<>nil do
  begin
    writeln(f,H^.info);
    H:=H^.next;
  end;
  close(f);
  write('File save, press any button');
end;

Procedure load(var H:list);
var
 p:list;
 stroka:string;
begin
  clearlist(H);
  assign(f,'spisok.txt');
  Reset(f);
  while (not EoF(f)) do
  begin
    Readln(f,stroka);
    new(p);
    p^.info:=stroka;
    p^.prev:=nil;
    p^.next:=h;
    h^.prev:=p;
    h:=p;
  end;
  write('file load, press any button');
end;

Procedure deleteK(H:list);
var
p:list;

begin
   H:=head;
  writeln('write K');
  readln(k);
  writeln('write value');
  readln(l);

// 1) удаляем k+1 узел
// 2) удаляем последний узел
// 3) в списке меньше k узлов
  

for i:=1 to (k-1) do
H:=H^.next;
New(p);
P^.info:=l;
P^.Next:=H^.Next;
P^.Prev:=H;
H^.Next:=P;
p^.Next^.Prev:=P;
end;




Begin
Head:=nil;
repeat

writeln('1.Add Node');
writeln('2.OutCircle');
writeln('3.SortList');
writeln('4.ClearList');
writeln('5.Save');
writeln('6.Load');
writeln('7.DeleteK');
writeln('');


Case ch of
#24 :add;
#39 :OutCircle(head);
#49 :SortList(head);
#81 :ClearList(head);
#95 :Save(head);
#119 :Load(head);
#133 :DeleteK(head);

end;
writeln('choose and press <ENTER>');
readln;
until ch='175';
end. 


и еще вопрос, как концовку правильно написатьб, чтоб при нажатие допустим 1 , запускалась процедура добавления??