[mozayka]

overlest для решения поставленной задачи можно использовать алгоритм поиска максимального пути на графе ... его реализация может быть, например, такой как в коде показаном ниже:

Код:

type
  arr_str = array of string;
  arr_int = array of integer;

  mtx_elm = array of arr_int;

function findMaxChainOfCities(tmpSL: TStrings): arr_int;
{-------------------------------------------------------}
{      Функция поиска максимальной по длине цепочки     }
{-------------------------------------------------------}
{                     Параметры:                        }
{ tmpSL - список городов, используемых для формиро- ... }
{        ... вания цепочки из названий городов мак- ... }
{        ... симальной длины                            }
{-------------------------------------------------------}
var
  k: integer;
  tmpCur: arr_int;
  tmpMtx: mtx_elm;

  function createMatrixOfCities(tSL: TStrings): mtx_elm;
  {-------------------------------------------------------}
  { Функция создания матрицы связности для имеющегося ... }
  { ... списка названий городов                           }
  {-------------------------------------------------------}
  var
    i, j: integer;
  begin
    setlength(result, tSL.Count);
    for i:=0 to (tSL.Count - 1) do
      setlength(result[i], tSL.Count);
    for i:=low(result) to high(result) do
      for j:=low(result[i]) to high(result[i]) do
        if (i <> j) then
          begin
            if tSL[i][length(tSL[i])] = tSL[j][1] then
              result[i, j]:=1
            else
              result[i, j]:=0
          end
        else
          result[i, j]:=0
  end;

  procedure findChainOfCities(tCur: arr_int; tMtx: mtx_elm; var tMax: arr_int);
  {-------------------------------------------------------}
  { Функция поиска текущей цепочки из названий городов ...}
  { ... и сравнение её с максимальной                     }
  {-------------------------------------------------------}
  var
    l, j: integer;

    function existCityInChain(tVal: integer; tArr: arr_int): boolean;
    var
      i: integer;
    begin
      result:=false;
      for i:=1 to tArr[0] do
        if tArr[i] = tVal then
          begin
            result:=true; exit
          end
    end;

  begin
    l:=tCur[tCur[0]];
    for j:=low(tMtx) to high(tMtx) do
    if (tMtx[l,j] = 1) and (not existCityInChain(j, tmpCur)) then
      begin
        tCur[0]:=tCur[0] + 1; tCur[tCur[0]]:=j;
        tMtx[l,j]:=-1; // исключить из рассмотрения текущую пару ...
        findChainOfCities(tCur, tMtx, tMax);
        tMtx[l,j]:=1;  // пару снова разрешено использовать ...
        tCur[0]:=tCur[0] - 1
      end;
    if tCur[0] > tMax[0] then
      begin
        for j:=low(tMax) to high(tMax) do
          tMax[j]:=tCur[j]
      end
  end;

begin
  tmpMtx:=createMatrixOfCities(tmpSL);
  setlength(tmpCur, high(tmpMtx) - low(tmpMtx) + 2);
  setlength(result, high(tmpMtx) - low(tmpMtx) + 2);
  for k:=low(tmpMtx) to high(tmpMtx) do
    begin
      tmpCur[0]:=1; tmpCur[1]:=k;
      findChainOfCities(tmpCur, tmpMtx, result)
    end
end;

з.ы.: пример использования кода в прилагаемом архиве ...