Зависание программы

[brownb]

procedure TForm1.Button1Click(Sender: TObject);
var str:string;
begin
str:=edit1.text;
if str[length(str)]='/' then
setlength(str,length(str)-1);
host:=str;
pars(edit1.text);
end;
function TForm1.duble(const line: string):boolean;
var i:integer;
begin
for i:=0 to memo1.Lines.Count-1 do
  if memo1.Lines[i]= line then begin
  result:=true; break; end else result:=false;
end;

procedure TForm1.pars(url: string);
var list:Tstringlist;
reg:TRegExpr;
begin
inc(q);
URLDownloadToFile(nil,Pchar(url),pchar('index'+inttostr(q)+'.html'),0,nil);
list:=Tstringlist.Create;
reg:=TRegExpr.Create;
if FileExists('index'+inttostr(q)+'.html') then
list.LoadFromFile('index'+inttostr(q)+'.html') else exit;

reg.Expression:='[a][\s]{1,}(href=")([^"]+)';
if reg.Exec(list.Text) then
Repeat
  if (reg.Match[2]<>'#')and(not duble(reg.Match[2])) then begin
  memo1.Lines.Add(reg.Match[2]);
  Application.ProcessMessages;
  label1.Caption:=inttostr(memo1.Lines.Count+1);
      if reg.Match[2][1]='/' then
          pars(host+reg.Match[2])
     else if ((copy(reg.Match[2],1,4)='http') and (Pos(host, reg.Match[2])>0)) then
          pars(reg.Match[2])
      else
          pars(host+'/'+reg.Match[2]);
      end;
 Until not reg.ExecNext else ShowMessage('Ã*Ã¥Ã*');

//DeleteFile('index'+inttostr(q)+'.html');
list.Free;
reg.Free;

end;
initialization
q:=0;

В программировании не силен )по этому прошу помощи профессионалов))в общем код работает вот только программа зависает и ее не выключить(если только убить процесс) как избаться от этого злодеяния?

[саша40]

Добавить в цикл Application.ProcessMessages. В своё время она в этом помогала.

[northener]

саша40, она там уже есть.

[саша40]

Может тогда проблема в функции Double? По факту только на неё прям активно глаз ложится.

[kropotkina-alice]

А что, поставить бряку и пройтись по шагам религия не позволяет?

[northener]

При "зависании" бряка не всегда помогает.
Сначала нужно понять причину "зависания", а уж после становится ясно где и с какими параметрами бряку нужно было ставить чтобы понять причину.

[kropotkina-alice]

Сообщение от northener

Сначала нужно понять причину "зависания", а уж после становится ясно где

Да тут вроде очевидно...
Единственное "узкое" место - цикл REPEAT...UNTIL...

[evg_m]

ЧИТАЕМ соообщения Warring компилятора.

[Warning] Unit1.pas(33): Return value of function 'TForm1.duble' might be undefined

если цикл НИ разу не выполниться, то и результата нет.
результат не тот, нет выхода из цикла repeat
нет выхода, программа "висит" .
он всегда выполняется.
не будьте так в это уверены.

[kropotkina-alice]

if reg.Exec(list.Text) then
Repeat
  if (reg.Match[2]<>'#')and(not duble(reg.Match[2])) then 
  begin
...
  end;
 Until not reg.ExecNext

Ну, и что будет, если условие

if (reg.Match[2]<>'#')and(not duble(reg.Match[2])) then

никогда не выполнится?
Вот вам и "бесконечный цикл"...

Сообщение от evg_m

ЧИТАЕМ соообщения Warring компилятора.
если цикл НИ разу не выполниться, то и результата нет

По умолчанию Result будет равен False.
Так что это не есть источник проблемы.

[саша40]

Я же говорил, что проблема там.