Потоки, правильно реализовал или нет?

[bakanaev]

Сообщение от Kix.IV

Или лучше в коде потока сделать цикл, который будет сам брать подходящую ссылку и исключать её, дабы другой поток её не обработал.

Что то не понял, в каждом потоке свой цикл?

[Kix.IV]

Всем.
Предлагаю разбить тебе код на куски:
1)Процедура которая берёт из кого-то списка строку и возвращает её, удаляя её из списка. Если брать нечего, то возвращает какой-нибудь "код".
2)Процедура которая создаёт список из listbox'a(в котором хранятся все значения) и запускает n потоков.
3)Поток который в цикле: берёт значение и обрабатывает его. Если вместо значения получает "код", то выходит из цикла.

Если ты сможешь представить в голове, как будет работать программа, то писать будет гораздо легче.

[bakanaev]

Так просто лишь на словах.

Сообщение от Kix.IV

1)Процедура которая берёт из кого-то списка строку и возвращает её, удаляя её из списка. Если брать нечего, то возвращает какой-нибудь "код".
2)Процедура которая создаёт список из listbox'a(в котором хранятся все значения) и запускает n потоков.

У меня список урлов занесен в ListBox, будут браться от туда. Удалять каждый раз ссылку это плохо.

Сообщение от Kix.IV

Всем

это не ответ...

[BDA]

Посмотрите этот видео-урок
http://avtuh.ru/2010/10/10/delphi-vi...onizaciya.html

[bakanaev]

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

Посмотрите этот видео-урок
http://avtuh.ru/2010/10/10/delphi-vi...onizaciya.html

Самое оно!!! Спасибо

[Kix.IV]

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

Так просто лишь на словах.

У меня список урлов занесен в ListBox, будут браться от туда. Удалять каждый раз ссылку это плохо.


это не ответ...

Дак я же написал, что бы создал ещё один список и из него удалял. Чем же удалять ссылки это плохо?

[GunSmoker]

Мда...

Если у тебя проблемы с таким:

Процедура которая берёт из кого-то списка строку и возвращает её, удаляя её из списка.

то за потоки ты явно очень рано сел....

В любом случае, у тебя задача на пул потоков. Но реализовывать пул потоков самому с твоим уровнем - безумие. Нужно воспользоваться готовым решением. Я бы рекомендовал AsyncCalls или OTL. Но в простых случаях сойдёт и сервис ОС:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Spin, StdCtrls;

const
  // Создаём своё оконное сообщение, которое будет служить уведомлением о завершении обработки
  WM_TaskComplete = WM_USER + 1;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    SpinEdit1: TSpinEdit;
    Button1: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    FTaskIndex: Integer;      // Номер задачи для запуска
    FCompletedTasks: Integer; // Сколько всего рабочих потоков завершилось

    // Обратная к Button1Click: вызывается при завершении всей работы
    procedure FinishWork;

    // Запускает очередную задачу
    procedure RunNextItem;

    // Управление интерфейсом программы
    procedure EnableControls;
    procedure DisableControls;
    procedure SetControlsEnabled(const AEnabled: Boolean);
  protected
    // Уведомление о завершении очередной задачи
    procedure TaskComplete(var AMsg: TMessage); message WM_TaskComplete;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  X: Integer;
begin
  // Нечего делать? Выходим.
  if (SpinEdit1.Value <= 0) or
     (ListBox1.Items.Count <= 0) then
    Exit;

  // Потоков не может быть больше, чем всего элементов для обработки
  if SpinEdit1.Value > ListBox1.Items.Count then
    SpinEdit1.Value := ListBox1.Items.Count;

  // Отключили интерфейс
  DisableControls;

  // И запустили N параллельных потоков (где N = SpinEdit1.Value, т.е. 1, 2, 3, 4, ...).
  FTaskIndex := 0;
  FCompletedTasks := 0;
  for X := 0 to SpinEdit1.Value - 1 do // обычно = 1, 2 или 4 (по числу ядер), либо что-то вроде 10-20
    RunNextItem;
end;

// Вызывается, когда вся работа полностью завершена
// (обработан каждый элемент и все задачи завершились)
procedure TForm1.FinishWork;
begin
  // На всякий случай сбросим счётчики
  FTaskIndex := 0;
  FCompletedTasks := 0;

  // Включаем интерфейс
  EnableControls;
end;

type
  // Запись описывает параметры задачи для потока.
  TTaskParams = record
    // (служебные)
    ID: Integer;
    WndHandle: HWND;

    // В данном случае - простой URL.
    // Если надо ещё что-то (таймаут, логин/пароль и т.п.) - добавляем сюда.
    URL: String;
  end;
  PTaskParams = ^TTaskParams;

  // Запись описывает результат работы потока
  TTaskResult = record
    // В данном случае - результат парсинга после запроса.
    // Если надо ещё что-то - добавляем сюда.
    ParsedText: String;
  end;
  PTaskResult = ^TTaskResult;

[GunSmoker]

Не влезло в один пост...

// "Задача" - метод, который выполняет всю работу
// Сама работа сидит в DoWork, а RunTask занимается только подготовкой параметров задачи
// и упаковкой/отправкой результатов
function RunTask(lpThreadParameter: Pointer): Integer stdcall;

  procedure DoWork(const AParams: TTaskParams; var AResult: TTaskResult);
  begin
    Sleep(1000 + Random(1000));
    AResult.ParsedText := AParams.URL;
  end;

var
  Params: TTaskParams;
  PResult: PTaskResult;
begin
  try
    Params := PTaskParams(lpThreadParameter)^;
    Dispose(PTaskParams(lpThreadParameter));

    PResult := AllocMem(SizeOf(TTaskResult));

    try
      DoWork(Params, PResult^);
    finally
      SendMessage(Params.WndHandle, WM_TaskComplete, Params.ID, LPARAM(PResult));
    end;
    Result := 0;

  except
    Result := ERROR_GEN_FAILURE;
  end;
end;

// Запускает очередную задачу
procedure TForm1.RunNextItem;
var
  PParams: PTaskParams;
begin
  // Если элементы закончились, то все задачи уже отправлены в обработку
  // Но это ещё не значит, что они все завершились
  if FTaskIndex >= ListBox1.Items.Count then
  begin
    // Пометили, что завершилась ещё одна задача
    FCompletedTasks := FCompletedTasks + 1;

    // Это была последняя задача?
    if FCompletedTasks = SpinEdit1.Value then
      FinishWork;

    // Выходим в любом случае, т.к. нечего больше запускать
    Exit;
  end;

  // Готовим параметры
  PParams := AllocMem(SizeOf(TTaskParams));
  PParams.ID := FTaskIndex;
  PParams.WndHandle := Handle;

  PParams.URL := ListBox1.Items[FTaskIndex];

  // "Поехали!" (С)
  Win32Check(QueueUserWorkItem(RunTask, PParams, WT_EXECUTELONGFUNCTION));

  // Переходим к следующей задаче
  // (т.е. в следующий вызов будет выполняться задача со следующим номером)
  FTaskIndex := FTaskIndex + 1;
end;

// Уведомление о завершении задачи
procedure TForm1.TaskComplete(var AMsg: TMessage);
var
  ID: Integer;
  Rslt: TTaskResult;
begin
  ID := AMsg.WParam;
  Rslt := PTaskResult(AMsg.LParam)^;
  Dispose(PTaskResult(AMsg.LParam));

  // Здесь: выполнена задача с номером ID
  // Можно воспользоваться результатами из Rslt
  Memo1.Lines.Add(Rslt.ParsedText);

  // ... при желании можно обновить прогресс операции
  Label1.Caption := Format('%f%%', [(ID + 1) / ListBox1.Items.Count]); // вообще-то, по хорошему тут надо вместо ID делать счётчик, но для простоты примера пусть будет так

  // Задачу обработали - запускаем следующую
  RunNextItem;
end;

procedure TForm1.DisableControls;
begin
  SetControlsEnabled(False);
  Label1.Caption := '0.00%';
end;

procedure TForm1.EnableControls;
begin
  SetControlsEnabled(True);
  Label1.Caption := '';
end;

procedure TForm1.SetControlsEnabled(const AEnabled: Boolean);
begin
  ListBox1.Enabled := AEnabled;
  Button1.Enabled := AEnabled;
  SpinEdit1.Enabled := AEnabled;
end;

end.

[Kix.IV]

Он не понимает как всё это работает. Ему бы книги по работе винды, устройству компа и ассемблеру почитать.

[GunSmoker]

В данном примере поток ничего не делает (тождественное преобразование со случайной задеркой). Этот вариант удобно использовать для проверки работы многопоточности. К примеру, внеси 10 элементов в список (ListBox), укажи число потоков в SpinEdit (например, 2 или 4) и нажми на кнопку.

И если это устраивает, то нужно всего-лишь внести свой код в DoWork, например:

...

  procedure DoWork(const AParams: TTaskParams; var AResult: TTaskResult);

    function LoadPage(const AURL: String): String;
    var
      HTTP: TIdHTTP;
      SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
      CookieManager: TIDCookieManager;
    begin
      SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
      try
        CookieManager := TIDCookieManager.Create;
        try
          HTTP := TIdHTTP.Create;
          try
            HTTP.IOHandler := SSLHandler;
            HTTP.CookieManager := CookieManager;
            HTTP.HandleRedirects := True;
            Result := HTTP.Get(AURL);
          finally
            FreeAndNil(HTTP);
          end;
        finally
          FreeAndNil(CookieManager);
        end;
      finally
        FreeAndNil(SSLHandler);
      end;
    end;

    procedure IsolateText(const AText, AOpenTag, ACloseTag: String; Extracted: TStrings);
    begin
      // ...
    end;

  var
    Page: String;
    Strs: TStringList;
  begin
    Page := LoadPage(AParams.URL);

    Strs := TStringList.Create;
    try
      IsolateText(Page, '<a class="b-serp-item__title-link" href="', '" onmousedown="rc', Strs);
      AResult.ParsedText := Strs.Text;
    finally
      FreeAndNil(Strs);
    end;
  end;

...