Циклы на графе

[Nicko_mt]

Доброго времени суток.Возник вопрос.Стоит задача написать программу для нахождения циклов различной длины на графе. Искал исходник для того чтобы посмотреть пример решения.Нашёл только вот это

{$R-,I-,S-,Q-}

const MAXN       = 40;
      QUERYSIZE  = 600;

type vert = record x: integer; s: array [1..MAXN] of integer; end;

var c   : array [1..MAXN,1..MAXN] of integer;
    n   : integer;

wr  : vert;

res : array [1..MAXN] of string;
    resv: integer;
    ss  : string;

procedure load;
var i,j: integer;
begin
  assign(input,'input.txt');
  reset(input);
   read(n);
   for i:=1 to n do
     for j:=1 to n do
       read(c[i][j]);
  close(input);
end;

function saveway(i:integer):string;
var e:string;
begin
  str(i,e);
  if (wr.s[i]=-1) then
    saveway:=e+' '
  else
    saveway:=saveway(wr.s[i])+e+' ';
end;

p>function findss(s: string): boolean;
var i         : integer;
    l1,l2,rs  : string;
    i1,i2,i22 : integer;

begin
  findss:=false;
  l2:=copy(s,1,pos(' ',s)-1);
  i2:=length(l2);
  i22:=length(s);
  for i:=1 to resv do begin
    l1:=copy(res[i],1,pos(' ',res[i])-1);
    i1:=length(l1);
    rs:=copy(res[i],1,length(res[i])-i1)+res[i];
    if (length(res[i])+i2=i22+i1)and(pos(s,rs)>0)
    then begin
      findss:=true;
      exit;
    end;
  end;
end;

procedure solve;
var h,t,i,j: integer;
    q      : array [1..QUERYSIZE] of vert;
    e      : string;
begin
   resv:=0;
   fillchar(res,sizeof(res),0);

for i:=1 to n do begin
     fillchar(q[i],sizeof(q[i]),0);
     q[i].x:=i;
     q[i].s[i]:=-1;
   end;

t:=n+1;
   h:=1;
   while h<t do begin
     for i:=1 to n do
       if (c[q[h].x,i]>0) then begin
          if (q[h].s[i]=-1) then begin
            wr:=q[h];
            str(i,e);
            ss:=saveway(q[h].x)+e;
            if (not findss(ss)) then begin
               inc(resv);
               res[resv]:=ss;
            end;
          end;
          if (q[h].s[i]=0) then begin
            q[t]:=q[h];
            q[t].x:=i;
            q[t].s[i]:=q[h].x;
            inc(t);
          end;
       end;
     inc(h);
   end;

close(output);
end;

procedure save;
var i: integer;
begin
  assign(output,'output.txt');
  rewrite(output);
  for i:=1 to resv do
    writeln(res[i]);
  close(output);
end;

begin
  load;
  solve;
  save;
end.

Взято вот отсюда http://www.intuit.ru/department/algo...ombi/16/3.html.Только не понятно каким образом это работает.Если кто то может то помогите с объяснением хотя бы в общих чертах.Заранее благодарен.