Найдите исполнителя для вашего проекта прямо сейчас!
Разместите заказ на фриланс-бирже и предложения поступят уже через несколько минут.

Есть чекер сайтов на делфи. Нужно сделать многопоточность. Нашел хороший пример где я кое что понимаю, хотелось бы в него вставить

действие чекера, подправить ошибки, написать комментарии что бы я мог

изменить что надо. Нужна кнопка пауза и кнопка стоп, кол-во потоков

вводить в едите. Плюс программа не должна виснуть, потому что сейчас

после запуска сразу фризи.

Многопоточность:

var

  Form1: TForm1;

  CritSec:TCriticalSection; // объект критической секции

  TSource:TStringList;

  stopped:boolean;

implementation

{$R *.dfm}

procedure ThreadFunc;

var s:string;

    stop:boolean;

begin

CritSec.Enter;

stop:=stopped; //надёжно читаем глобальную переменную стопа в локальную

CritSec.Leave;

While not stop do //здесь условие на стоп, завершение работы потока. Локальная переменная.

  begin

  CritSec.Enter;

  if (TSource.Count>0) then //Соурс глобальный, поэтому условие тоже в Крит. секции

    begin

    s:=TSource[0]; //переводим из общих данных - в локальные, и уже с ними работаем

    TSource.Delete(0); //удаляем первую строку в соурсе

    CritSec.Leave; // закрываем секцию после всех дел с глобальными данными

    end

  else

    begin

    CritSec.Leave; //иначе тоже закрываем, до выхода из цикла

    break; //выходим из цикла

    end;

  MessageBox(0,PChar(s),'Мессадж',0); //наша функция, работа со строкой из файла

  CritSec.Enter;

  stop:=stopped; //проверяем была ли команда стопа. Если да - следующий раз цикл не выполнится

  CritSec.Leave;

  end;

endthread(0);

end;

procedure TForm1.Button1Click(Sender: TObject); //кнопка старта

var tid1,tid2,id:longword;

begin

if not fileexists('test.txt') then //проверка существования файла

  begin

  ShowMessage('создайте test.txt');

  exit;

  end;

stopped:=false; //ставим false для того, чтобы программа снова работала после стопа

TSource.LoadFromFile('test.txt'); //загружаем файл

tid1:=beginthread(nil,0,Addr(ThreadFunc),nil,0,id); //запускаем функцию ThreadFunc в потоке

tid2:=beginthread(nil,0,Addr(ThreadFunc),nil,0,id); //в tid2 присваиваем Идентификатор потока, который пригодится позже.

end;

procedure TForm1.Button2Click(Sender: TObject); //кнопка стопа

begin

Stopped:=true; //стоп

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

CritSec:=TCriticalSection.Create; // создаём объект критической секции, на всё время работы программы

TSource:=TStringList.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

CritSec.Free; // разрушаем

TSource.Free;

end;

end.

Действие чекера:procedure TForm1.Button3Click(Sender: TObject);

begin

for i:=0 to Memo5.Lines.Count-1 do

begin

try

memo4.text:=IdHTTP1.Get('http://'+memo5.lines);

if (Pos('html', memo4.text)

  AssignFile(myFile, 'goods.txt');

Append(myFile);

  WriteLn(myFile, memo4.text);

  CloseFile(myFile);  end

 else    begin

    AssignFile(myFile, 'bads.txt');

Append(myFile);

  WriteLn(myFile, memo1.lines);

  WriteLn(myFile, memo4.text);

  CloseFile(myFile);  end;

if Pos(Edit5.Text, memo4.text)

  Memo1.Lines.Add(memo5.lines);

  AssignFile(myFile, 'good.txt');

Append(myFile);

  WriteLn(myFile, memo5.lines);

  CloseFile(myFile);  end

 else   begin

  Memo2.Lines.Add(memo5.lines);

    AssignFile(myFile, 'bad.txt');

Append(myFile);

  WriteLn(myFile, memo5.lines);

  CloseFile(myFile);  end;

except

begin

  Memo3.Lines.Add(memo5.lines);

    AssignFile(myFile, 'error.txt');

Append(myFile);

  WriteLn(myFile, memo5.lines);

  CloseFile(myFile);

 

end;   end;

 

end;

 ShowMessage('finish');

 end;

7 лет назад
guest_14905915618515
7 лет в сервисе
Был
7 лет назад