Про потоки с нуля

unit UMainForm;
 
interface
 
uses
  classes, types, forms, Controls, StdCtrls, Dialogs, SysUtils;
 
type
  TMainForm = class(TForm)
    bStart: TButton;
    m1: TMemo;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    procedure bStartClick(Sender: TObject);
  private
    procedure Log(const s: string);
    procedure ThreadTerm(Sender: TObject);
  public
    Started:integer;
    Finished:integer;
    procedure RunThread();
 
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  UMyThread;
 
 
const
  MAX_THREADS=5;
  SAME_TIME=50;
 
{$R *.dfm}
 
 
 
 
{ TMainForm }
 
 
procedure TMainForm.Log(const s:string);
begin
  m1.Lines.Add(s);
end;
 
procedure TMainForm.ThreadTerm(Sender: TObject);
var
  th:TMyThread absolute Sender; // очень древняя магия. обозначает th:=TMyThread(Sender)
begin
  log(th.URL + ':'+th.answer);
  inc(Finished);
  if Started<10 then
    RunThread;
  if Finished=MAX_THREADS then
  begin
    log('===========================');
    log('Работа окончена');
    bStart.Enabled := true;
  end;
end;
 
procedure TMainForm.bStartClick(Sender: TObject);
var
  i: Integer;
begin
  bStart.enabled:=false;
  for i := 0 to SAME_TIME-1 do
    RunThread;
end;
 
procedure TMainForm.RunThread;
var
  th:TMyThread;
begin
  inc(Started);
  th:=TMyThread.Create('URL '+inttostr(Started), ThreadTerm );
 
  Log('запущен '+th.url);
  th.Resume;
end;
 
end.

unit UMyThread;
 
interface
uses Classes,ssl_openssl, httpsend;
type
  TMyThread=class(TThread)
  public
    th:TMyThread;
    URL:string;
    answer:string;
    http: THTTPSend;
    StringList: TStringList;
    procedure Execute;override;
    constructor Create(AURL:string; TermProc:TNotifyEvent);
  end;
 
implementation
uses Sysutils;
 
{ TMyThread }
 
constructor TMyThread.Create(AURL:string; TermProc:TNotifyEvent);
 
begin
  inherited Create(true);
  URL := AURL;
  FreeOnTerminate := true;
  OnTerminate := TermProc;
 
end;
 
procedure TMyThread.Execute;
var
  StringList: TStringList;
  begin
 
 
     http:=THTTPSend.Create;
     StringList:=TStringList.Create;
 
     HTTP.MimeType:='application/x-www-form-urlencoded';
     http.Timeout:=40000;
       try
 
          http.HTTPMethod('GET', 'http://ru.myip.ms');
 
               StringList.LoadFromStream(http.Document);
 
            except
            on E : Exception do begin
            URL:='     '+E.ClassName+'     '+E.Message;   end;
       end;
      Answer:=inttostr(HTTP.ResultCode);
   StringList.Free;
   http.Free;
  end;
 
end.

procedure TMainForm.SpeedButton1Click(Sender: TObject);
var
 THR_Users : TTHreadGet_Users;
 i         : integer;
 counter   : integer;  // счетчик 
 user_ids  : String;
begin
  // Заполнение параметров
  counter := 0;
  {        ПЕРЕБОР             }
  // от 1 до 446000000 да, да вы не ослышались пол миллиарда 
  for I := Trim(edMP_Min.Text).ToInteger to Trim(edMP_Max.Text).ToInteger do
  begin
    
    // собираем порции по 99 id и кормим наш поток
    if counter = 99 then // если собрали 99 id создаем поток
    begin
      //edMP_Min.Text := i.ToString; // к делу не относится
      counter := 0; // обнуляю для следующей коллекции
 
      // Поток запроса
      THR_Users := TTHreadGet_Users.Create(true);
      THR_Users.FreeOnTerminate := true;
      // Список городов, фильтр
      
      // мои параметры
      THR_Users.Cityes.AddStrings(memMPCityFilter.Lines); // к делу не относится
      THR_Users.Token := NextToken; // Токен
      THR_Users.Proxy := NextPoxy;  // Прокси
 
      THR_Users.users_get.user_ids := user_ids; // список id пользователей   123,432,533
 
      THR_Users.Resume; // стартую
    end;
 
    user_ids := user_ids + (i.ToString+','); // здесь формирую строку запроса 
    counter := counter+1; // счетчик 
  end;
 
end;

procedure TTHreadGet_Users.Execute;
var
  i : integer;
  counter: integer;
  Hread: TTHreadXMLToDB;
  DataXML : string;
begin
 
  Auth.token := Token; // токен ключ
  try
 
    // здесь выполняю запрос на сервер с уже сформированными параметрами запроса
    DataXML :=  Auth.ExecuteQuery(oAuth.TMethod.USERS_GET,
                    users_get.collect_request,
                    '5.8',
                    oAuth.XML,
                    Proxy.Server,
                    Proxy.Port);
    //получил ответ в DataXML              
 
  
    // Это поток в потоке", то есть по моим размышлениям 
    // я не хочу терять время на добавление данных в базу SQLite
    // Здесь я запускаю дочерний поток для добавления в базу данных
    // и забываю про него. Думая что все будет хорошо
    Hread                 := TTHreadXMLToDB.Create(True);
    Hread.DataBasesName   := ExtractFilePath(ParamStr(0))+'ALL_VK_ID.db';
    Hread.XMLData         := DataXML; // XML данные
    Hread.Cityes.AddStrings(Cityes);
    Hread.Country         := Country;
    Hread.FreeOnTerminate := true;
    Hread.Resume;
 
    users_get.user_ids := '';
  except
 
  end;
  users_get.Free; // 
 
end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TTestThread = class(TThread)
  private
    FNum: Integer;
    procedure SynchAdd();
    procedure SynchDel();
  protected
    procedure Execute; override;
  public
    constructor Create(ANum: Integer);
  end;
 
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
const
  InitialCount = 8;
 
var
  Form1: TForm1;
  hSemaphore: THandle;
 
implementation
 
{$R *.dfm}
 
{ TTestThread }
 
constructor TTestThread.Create(ANum: Integer);
begin
  inherited Create(True);
  FreeOnTerminate:=True;
  FNum:=ANum;
  Resume;
end;
 
procedure TTestThread.Execute;
begin
  <font color="red">WaitForSingleObject(hSemaphore, INFINITE);</font>
  Synchronize(SynchAdd);
  Sleep(100+Random(100));
  Synchronize(SynchDel);
  <font color="red">ReleaseSemaphore(hSemaphore, 1, nil);</font>
end;
 
procedure TTestThread.SynchAdd;
begin
  Form1.Tag:=Form1.Tag+1;
  Form1.Label1.Caption:=IntToStr(Form1.Tag);
end;
 
procedure TTestThread.SynchDel;
begin
  Form1.Tag:=Form1.Tag-1;
  Form1.Label1.Caption:=IntToStr(Form1.Tag);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i:=1 to 100 do TTestThread.Create(i);
end;
 
<font color="Red">initialization
  hSemaphore:=CreateSemaphore(nil, InitialCount, InitialCount, nil);
 
finalization
  CloseHandle(hSemaphore);</font>
 
end.

if Started<  MAX_THREADS then
    RunThread;

if Started<10 then
    RunThread;

 if Started<10 then
    RunThread;

      ThreadCount := TrackBar1.Position;
      while ThreadCounter > ThreadCount do
      begin
        sleep(200);
        Application.ProcessMessages;
      end;

      Label34.Caption := ThreadCounter.ToString;
      // Поток запроса
      THR_Users := TTHreadGet_Users.Create(true);
      THR_Users.FreeOnTerminate := true;
      THR_Users.OnTerminate     := OnTermenate;
 
      // Список городов, фильтр
      THR_Users.Cityes.AddStrings(memMPCityFilter.Lines);
      THR_Users.Token := NextToken; // Токен
      THR_Users.Proxy := NextPoxy;  // Прокси
      THR_Users.users_get.user_ids := user_ids; // список id пользователей
      THR_Users.Resume;
 
      inc(ThreadCounter); // увеличиваю счетчик

procedure TMainForm.OnTermenate(Sender: TObject);
begin
  Dec(ThreadCounter); уменьшаю счетчик
end;

ThreadCount := TrackBar1.Position;
      while ThreadCounter > ThreadCount do
      begin
        sleep(200); // c этой строчкой проц не греется
        Application.ProcessMessages;
      end;

TMyThread=class(TThread)
...
public
  ParamXXX:integer;
  ParamYYY:string;
....
end;

procedure TForm1.Button16Click(Sender: TObject);
for j := 0 to Memo1.Lines.Count-1 do
     begin
          while pauses=true do pause(1000);
          MyThread:= TMyThread.Create(Memo1.Lines[j]);
          MyThread.Priority:=tpNormal;
          potoki:=potoki+1;
          while StrToInt(form1.Edit1.Text)=potoki do begin pause(1000); application.ProcessMessages; end;
          application.ProcessMessages;
     end;
 
procedure TMyThread.Execute;
бла бла бла
 
 potoki:=potoki-1;
end;