Programacion con Threads

[rmendoza83]

Gracias Neftali por tu respuesta.

Ya por la premura pude corregir el problema, aunque no como yo quería realmente. Ya pude al menos hacer que la aplicación ejecute cierta cantidad de threads "casi" concurrentes (entiendo que son hilos y no procesos concurrentes). Lo que no pude hacer es poder tener acceso a cada thread y poder saber cuando una finalizo para reutilizar la misma variable (o espacio en el arreglo dinámico), estaba usando un arreglo dinámico probando con un numero fijo de 20. Les anexo el código:

La Clase Thread, creo que la visibilidad es importante

Código Delphi [-]
THTTPThread = class(TThread)
    private
      Index: Integer;
      Msg: string;
      Inbox: string;
      Email: string;
      Error: Boolean;
      MyHTTP: TIdHTTP;
      FRichEdit: TRichEdit;
      procedure DoWork;
      procedure SetRichEdit(const Value: TRichEdit);
    protected
      procedure Execute; override;
    public
      property RichEdit: TRichEdit read FRichEdit write SetRichEdit;
      constructor Create(Suspended: Boolean; AIndex: Integer; AInbox, AEmail: String); overload;
      destructor Destroy; reintroduce;
  end;

{ THTTPThread }

constructor THTTPThread.Create(Suspended: Boolean; AIndex: Integer; AInbox,
  AEmail: String);
begin
  inherited Create(Suspended);
  Index := AIndex;
  Inbox := AInbox;
  Email := AEmail;
  MyHTTP := TIdHTTP.Create(nil);
end;

destructor THTTPThread.Destroy;
begin
  MyHTTP.Destroy;
  inherited Destroy;
end;

procedure THTTPThread.DoWork;
var
  AuxColor: TColor;
begin
  if (Error) then
  begin
    AuxColor := clRed;
  end
  else
  begin
    AuxColor := clBlack;
  end;
  FRichEdit.SelAttributes.Color := AuxColor;
  FRichEdit.Lines.Add(Msg);
end;

procedure THTTPThread.Execute;
var
  ParamsList: TStringList;
begin
  FreeOnTerminate := True;
  Error := False;
  ParamsList := nil;
  try
    ParamsList := TStringList.Create;
    with MyHTTP do
    begin
      ParamsList.Add('qemail=' + Email);
      try
        try
          MyHTTP.Post(Inbox,ParamsList);
        except
          Error := True;
        end;
      finally

      end;
    end;
  finally
    ParamsList.Free;
  end;
  if (Error) then
  begin
    Msg := 'Enviando E-mail para "' + Email + '" Usando Inbox "' + Inbox + '... Resultado: Error. (' + MyHTTP.ResponseText + ')';
  end
  else
  begin
    Msg := 'Enviando E-mail para "' + Email + '" Usando Inbox "' + Inbox + '... Resultado: OK. (' + MyHTTP.ResponseText + ')';
  end;
  Synchronize(DoWork);
  Exit
end;

procedure THTTPThread.SetRichEdit(const Value: TRichEdit);
begin
  FRichEdit := Value;
end;

y este es el bloque de codigo donde se usa:

Código Delphi [-]
MaxThreads := UpDownMaxThreads.Position;
        Screen.Cursor := crHourGlass;
        TxtLogEmails.Clear;
        PB.Min := 0;
        PB.Max := LstEmail.Items.Count * UpDownMaxEmail.Position;
        PB.Position := 0;
        PB.Step := 1;
        CThreads := 0;
        CounterThread := 0;
        for i := 0 to UpDownMaxEmail.Position - 1 do
        begin
          for j := 0 to LstEmail.Items.Count - 1 do
          begin
            //Configuring Thread
            while True do
            begin
              //if (Length(AThreads) < MaxThreads) then
              if (CThreads < MaxThreads) then
              begin
                Inc(CounterThread);
                HTTPThread := THTTPThread.Create(True,CounterThread,LstInbox.Items[Random(LstInbox.Items.Count)],LstEmail.Items[j].ToLower);
                HTTPThread.RichEdit := TxtLogEmails;
                HTTPThread.Priority := tpHighest;
                HTTPThread.OnTerminate := OnThreadDone;
                HTTPThread.Start;
                Inc(CThreads);
                //Application.ProcessMessages;
                Break;
              end;
              Sleep(Random(10) + 5);
              Application.ProcessMessages;
            end;
            PB.StepIt;
          end;
        end;
        //Waiting for Threads
        while True do
        begin
          if (CounterThread = TotalThreads) then
          begin
            Break;
          end;
          Application.ProcessMessages;
          Sleep(10);
        end;
        Screen.Cursor := crDefault;

Es importante usar Application.ProcessMessages mientras el proceso principal duerme.

Espero que para algun otro les sirva de ayuda

[bucanero]

Hola rmendoza83

El problema que veo en tu código es que que por cada email que envías creas y destruye el hilo,

te pongo aquí un ejemplo de como puedes realizar una lectura sincronizada con las listas, espero te pueda servir

Código Delphi [-]
type
  TGetMailFunction=function:string of object;
  THTTPThread = class(TThread)
  private
    FEmail:String;
    FOnGetNewEmail:TGetMailFunction;
    procedure SetOnNewEmail(const Value: TGetMailFunction);
    procedure GetNewEmail;
    procedure enviarEmail(const AEmail:string);
  public
    procedure execute; override;
    property OnNewEmail:TGetMailFunction write SetOnNewEmail;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetNewEmail:String;
    procedure OnThreadDone(sender:TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  MaxThreads:Integer=20;

var
  CounterThread: integer;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j:longint;
  HTTPThread:THTTPThread;
begin
  Screen.Cursor := crHourGlass;

  CounterThread := 0;

  //crear e inicializar todos los thread
  for i := 1 to MaxThreads do begin
    Inc(CounterThread);
    HTTPThread := THTTPThread.Create(True);
    HTTPThread.Priority := tpHighest;
    HTTPThread.OnNewEmail := GetNewEmail;
    HTTPThread.OnTerminate := OnThreadDone;
    HTTPThread.FreeOnTerminate:=true;
    HTTPThread.Start;
  end;

  //esperar a que finalicen todos los Threads
  while (CounterThread>0) do begin
    Application.ProcessMessages;
    Sleep(300);
  end;
  Screen.Cursor := crDefault;
end;

function TForm1.GetNewEmail: String;
begin
  // aqui obtine el mail de la lista de emails
  // para este ejemplo yo utilizo un listbox, que seria el equivalente a las lista de email 
  if (Listbox1.count > 0) then begin
    Result := listBox1.items[0];
    listBox1.Items.Delete(0);
  end
  else
    result := '';
end;

procedure TForm1.OnThreadDone(sender: TObject);
begin
  if sender is THTTPThread then
    dec(CounterThread);
end;

{ THTTPThread }

procedure THTTPThread.enviarEmail(const AEmail: string);
begin
  //aqui es donde se hace el proceso de enviar un email

end;

procedure THTTPThread.execute;
begin
  inherited;
  if not assigned(FOnGetNewEmail) then exit;
  Synchronize(GetNewEmail);
  while not terminated and (FEmail <> '') do begin
    enviarEmail(FEmail);
    Synchronize(GetNewEmail);
  end;
end;

procedure THTTPThread.GetNewEmail;
begin
  //se llama a una funcion externa al Thread
  FEmail:=FOnGetNewEmail;
end;

procedure THTTPThread.SetOnNewEmail(const Value: TGetMailFunction);
begin
  FOnGetNewEmail:=value;
end;

como peculiaridad del ejemplo le paso al hilo un puntero a una función que es la encargada de leer el email de la lista y que hay que llamar siempre con el synchronize.

Espero te pueda servir
Un saludo