没仔细找Bug,效率也只能对付5个顶点，将就用吧。
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TNode = record
d: Integer;
Len: Integer;
Arrived: set of Byte
end;
var
Graph: array [1..5, 1..5] of Integer;
Stack: array [0..4] of TNode;
Top: Integer;
BestLen: Integer;
BestWay: array [1..4] of Integer;
i: Integer;
procedure Init;
var
i, j: Integer;
begin
for i:=1 to 4do
for j:=i+1 to 5do
begin
Write(Chr(Ord('A')+i-1)+'到'+Chr(Ord('A')+j-1)+'的距离：');
ReadLn(Graph[i, j]);
Graph[j, i]:=Graph[i, j]
end;
Stack[0].d:=1;
Stack[0].Len:=0;
Stack[0].Arrived:=[1];
Stack[1]:=Stack[0];
Top:=1;
BestLen:=MaxInt
end;
procedure Print;
var
i: Integer;
begin
Write('路线：A - ');
for i:=1 to 4do
Write(Chr(Ord('A')+BestWay-1)+' - ');
WriteLn('A');
WriteLn('总长度：', BestLen)
end;
begin
Init;
while Top>0do
begin
while Stack[Top].d<5do
begin
Inc(Stack[Top].d);
if not (Stack[Top].d in Stack[Top-1].Arrived) then
if (Graph[Stack[Top-1].d, Stack[Top].d]>0) then
begin
Stack[Top].Len:=Stack[Top-1].Len+Graph[Stack[Top-1].d, Stack[Top].d];
Stack[Top].Arrived:=Stack[Top-1].Arrived+[Stack[Top].d];
if Top=4 then
begin
if Graph[Stack[Top].d, 1]>0 then
if Stack[Top].Len+Graph[Stack[Top].d, 1]<BestLen then
begin
BestLen:=Stack[Top].Len+Graph[Stack[Top].d, 1];
for i:=1 to 4do
BestWay:=Stack.d
end
end
else
begin
Inc(Top);
Stack[Top].d:=1
end
end
end;
Dec(Top)
end;
Print;
ReadLn
end.
