Найти кратчайший путь между двумя заданными городами

program Project64;
uses
  SysUtils,
  windows;
const
n = 8;
inf = 1000;
var
f: text;
D: array[1..n, 1..n] of integer;
i, j, k, p,min:integer;         //k-начальная вершина   p-счетчик
A,B,C: array[1..n] of integer;
begin
  SetConsoleOutputCP(1251);
  SetConsoleCP(1251);
  Assign(f, 'Алгоритм.txt');
  Reset(f);
    for i:=1 to n do
      for j:=1 to n do
      begin
        read(f, d[i,j]);
        if d[i,j]=-1 then d[i,j]:=inf;  //считали из файла матрицу
      end;
  Close(f);
    for i:=1 to n do
    begin
      for j:=1 to n do
        if d[i,j]=inf then write('-':5)
        else  write(d[i,j]:5);     //напечатали
        writeln;
    end;
  writeln('Введите начальную вершину');
  readln(k);
   for i:=1 to n do
     begin              //заполнили массив
      A[i]:=0;
      b[i]:=D[k,i];
      C[i]:=k;
     end;
   A[k]:=1;
  for p:=1 to n-1 do
    begin
    min:=inf;    //пошёл сам алгоритм
      for i:=1 to n do
        begin
          if (A[i]=0) and (B[i]<min) then
            begin
              min:=B[i];
              j:=i;
            end;
          end;
            A[j]:=1;
          for i:=1 to n do
              if B[i]>B[j]+D[i,j]  then
              begin
                B[i]:=B[j]+D[i,j];
                C[i]:=j;
              end;
        end;
   for i:=1 to n do
   begin
     write(i:6);
     writeln(B[i]:5);
   end;
  readln;
end.

{Реализация алгоритма Флойда-Уоршелла}
program FloydWarshall;
 
const
  n = 5; {количество вершин графа}
  INFINITY = MaxInt;
type
  TRow = array [0..n - 1] of integer;
  TVertex = array [0..n - 1] of TRow;
const
  Vertex1: TVertex =
    (
    (0, 0, 5, 0, 0),
    (7, 0, 0, 0, 10),
    (0, 7, 0, 0, 0),
    (0, 0, 6, 0, 4),
    (0, 0, 1, 0, 0)
    );
  Vertex2: TVertex =
    (
    (0, 3, 2, 0, 0),
    (0, 0, 0, 4, 0),
    (0, 0, 0, 6, 0),
    (0, 0, 0, 0, 2),
    (0, 0, 0, 0, 0)
    );
 
  procedure FloydWarshall(v: TVertex; n: integer; var d, p: TVertex);
  var
    i, j, k: integer;
  begin
    {
    матрицу веса дуги преобразуем в требуемый для алгоритма вид
    - если i=j, то d[i, j]:=0
    - если из i в j нет ребра, то d[i, j]:=INFINITY (бесконечности)
    - иначе d[i, j] равно весу ребра из i в j
    подготовим матрицу для восстановления пути p
    }
    d := v;
    for i := 0 to pred(n) do
      for j := 0 to pred(n) do
      begin
        if d[i, j] = 0 then
          d[i, j] := INFINITY;
        if i = j then
          d[i, j] := 0;
        p[i, j] := j;
      end;
    for k := 0 to pred(n) do
    begin
      for i := 0 to pred(n) do
      begin
        for j := 0 to pred(n) do
        begin
          if (d[i, k] <> INFINITY) and (d[k, j] <> INFINITY) then
          begin
            if (d[i, j] > d[i, k] + d[k, j]) then
            begin
              d[i, j] := d[i, k] + d[k, j];
              p[i, j] := p[i, k];
            end;
          end;
        end;
      end;
    end;
  end;
 
  procedure RestorePath(const D, P: TVertex; n: integer; A, B: integer);
  var
    k: integer;
  begin
    if A >= n then
    begin
      writeln('The vertex A is out of range.');
      exit;
    end;
    if B >= n then
    begin
      writeln('The vertex B is out of range.');
      exit;
    end;
    if D[A, B] = INFINITY then
    begin
      writeln('There is not a path from vertex ', A, ' to vertex ', B, '.');
      exit;
    end;
    Write('The path from vertex ', A, ' to vertex ', B, ' is: <');
    Write(A: 4);
    k := A;
    while k <> B do
    begin
      k := p[k, B];
      Write(k: 4);
    end;
    writeln('>');
  end;
 
  procedure ShowMatrix(const M: TVertex; n: integer);
  var
    i, j: integer;
  begin
    for i := 0 to pred(n) do
    begin
      for j := 0 to pred(n) do
      begin
        if M[i, j] <> INFINITY then
          Write(M[i, j]: 4)
        else
          Write('inf': 4);
      end;
      writeln;
    end;
  end;
 
  procedure TestAlgoFW(const Vertex: TVertex; n: integer);
  var
    D, P: TVertex;
  begin
    FloydWarshall(Vertex, n, D, P);
    writeln('Vertex matrix:');
    ShowMatrix(Vertex, n);
    writeln('Distance matrix:');
    ShowMatrix(D, n);
    writeln('Path matrix:');
    ShowMatrix(P, n);
    RestorePath(D, P, n, 3, 1);
    RestorePath(D, P, n, 0, 3);
    RestorePath(D, P, n, 3, 3);
  end;
 
begin
  TestAlgoFW(Vertex1, n);
  TestAlgoFW(Vertex2, n);
end.

procedure ShowPath(A, B: integer; const P, D: array[1..n] of integer);
  var
    Q: array[1..n] of integer;
    Len: integer;
    v: integer;
  begin
    Len := 1;
    if D[B] = INF then
      writeln('There is not exist path from ', A, ' to ', B, '.')
    else
    begin
      v := B;
      repeat
        Q[Len] := v;
        Inc(Len);
        v := P[v];
      until v=-1;
      write('A path from ', A, ' to ', B, ' is <');
      for v := Len - 1 downto 1 do
        Write(Q[v]: 4);
      writeln('>.');
    end;
  end;
................................
вызов из основной программы
  ShowPath(k, m, C, B);