|
|
Проверка сайтов на наличие слова на странице
Привет!
Есть хорошая программа для проверки списка сайтов на наличие конкретного слова на страницах этих сайтов 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;
Пожалуйста подскажите что нужно поправить чтоб работало лучше.
|
Решил проблему самостоятельно. Создал отдельную функцию проверки. В потоках вызываю эту функцию с параметрами а результат обрабатываю в синхронизации.
Скорость очень большая и валидные ссылки не пропускает.
Поделюсь кодом функции может кому-то пригодится.
Код:
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;
|
Время: 17:33.
© OSzone.net 2001-