Удалить недостижимые вершины ориентированного графа

 Type Uk=^Rebro; //тип указателя на ребро
        Rebro=Record   //тип описывающий ребро графа
     Ver1, Ver2 : Integer;      //вершины графа
     Next: Uk;             //указатель на следующее ребро
     Bool: Boolean;     //признак прохождения по ребру
        end;
Var  P, P1:Uk;
     N, M, i, j, a : Word;
     Way : Set of Byte; //множество достижимых вершин
 
 
Procedure Input;
var i:word;
  Begin
    Write(' Vvedite colichectvo verhin :  ');  ReadLn(N);
    Write(' Vvedite colichectvo reber:  ');      ReadLn(M);
    P:=nil;  //цепочка ребер пуста
    For i:= 1 to M do
       begin New(P1); //создание нового ребра
        Write ('Vvedite 1-u verhinu ',i,'-go rebra:  ');  Read(P1^.Ver1);
        Write ('Vvedite 2-u verhinu ',i,'-go rebra:  ');  Read(P1^.Ver2);
        P1^.Bool :=TRUE;  P1^.Next :=P; //прикрепляем новое ребро кначалу
        P:=P1;  //новое ребро становится началом цепочки
         end;
End;
 
Procedure Poisk (i:Byte);
    Var tt:Uk;     //указатель на текущее ребро
Begin
 Way:=Way+[i];  //добавляем вершину во множество достихнутых
 tt:=p;         //перемещаем указатель на начало цепочки
 While tt <> nil do // пока не конец цепочки
  begin If (i=tt^.Ver1) and tt^.Bool    //находим ребро которое выходит
    then    //из i-ой вершины в которой не были
    begin tt^.Bool := FALSE; //отмечаем что прошли
     Poisk(tt^.Ver2);   //уходим на вторую вершину
     tt^.Bool := TRUE;  //снимает отметку о прохождении
    end;
    tt:=tt^.Next;
  end;
end;
 
begin
    Input; //ввод графа
Write('zadaite verhinu dla cotoroi ihutca nedoctigimii verdhini: '); ReadLn(A);
    Way:=[];    //обнуляем множество достижимых вершин
    Poisk(A);   //процедура обхода графа
    for j:=1 to N do
      if not (j in Way) then WriteLn( j, '-ia verhina nedoctigima iz verhini ',  A);
    if Way = [1 .. N] then WriteLn('Vce verhini doctigimi iz verhini ', A);
    ReadLn
  end.