Delphi - Проверка сайтов на наличие слова на странице

[VitProff]

Привет!

Есть хорошая программа для проверки списка сайтов на наличие конкретного слова на страницах этих сайтов

XLink Checker 2.0

Решил для себя написать аналог этой программы чтоб добавить дополнительный функционал. Всё сделал кажется правильно но моя программа работает медленные XLink Checker 2.0 и делает много пропусков.



Использовал Delphi7 и Synapse.

Вот код моего потока и синхронизации:





Код:

Код: Выделить всё

procedure TMultiThread.Execute;
begin
  while Work do
    begin
      CS.Enter;
        inc(c);                       
        if c>Form1.MemoLoad.Lines.Count-1 then Work:= false;
      CS.Leave;
      if Work then
      begin
        HTTP:= THTTPSend.Create;
        HTTP.UserAgent:=UA[Random(18)];
       if HTTP.HTTPMethod('GET', Form1.MemoLoad.Lines.Strings[c]) then
       begin
          Response:= TStringList.Create;
          Response.LoadFromStream(HTTP.Document);
          if Pos(Form1.EditFind.Text, Response.Text)0 then
            begin
              Rez:=1;
              link:= Form1.MemoLoad.Lines.Strings[c] + ' найдено ' + inttostr(c);
            end
          else
            begin
              Rez:=-1;
              link:= Form1.MemoLoad.Lines.Strings[c] + ' не найдено ' + inttostr(c);
            end;
            Synchronize(Sync);
            HTTP.Free;
            Response.Free;
       end;
      end;
    end;
  dec(Thread);
  if Thread=0 then
  Work:= False;
  Form1.ButtonFindStop.Enabled:=false;
  Form1.ButtonFindStart.Enabled:=true;
end;
procedure TMultiThread.Sync;
begin
case Rez of
  1:begin
      Form1.MemoSave.lines.Add(link);
Form1.LabelFind.Caption:=IntToStr(StrToInt(Form1.LabelFind.Caption)+1);
    end;
 -1:begin
      Form1.LabelNotExist.Caption:=IntToStr(StrToInt(Form1.LabelNotExist.Caption)+1);
    end;
end;
end;

Пожалуйста подскажите что нужно поправить чтоб работало лучше.

[VitProff]

Решил проблему самостоятельно. Создал отдельную функцию проверки. В потоках вызываю эту функцию с параметрами а результат обрабатываю в синхронизации.



Скорость очень большая и валидные ссылки не пропускает.

Поделюсь кодом функции может кому-то пригодится.





Код:

Код: Выделить всё

function FindInSiteSourceCode(site, FindText:string):integer;
var
  HTTP:THTTPSend;
  Source: Tstringlist;
begin
  HTTP:= THTTPSend.Create;
  HTTP.UserAgent:=UA[Random(18)];
  Result:= 5;
  if HTTP.HTTPMethod('GET', site) then
  begin
    Source:= Tstringlist.Create;
    Source.LoadFromStream(HTTP.Document);
      if (Source.Text='') then
      begin
        Source.Free;
        HTTP.Free;
        Result:= 0;
      end
      else if pos(FindText, Source.Text)0 then
           begin
            Source.Free;
            HTTP.Free;
            Result:= 1;
           end
           else
           begin
            Source.Free;
            HTTP.Free;
            Result:= -1;
           end;
  end;
end;