Programacion con Threads
 

Buenos Dias mis estimados, espero que puedan colaborarme a detectar cual es el problema que estoy presentando, les comento, estoy haciendo un programa para envio de correos masivos usando Indy para conexiones HTTP->post a unos servidores con apache para que hagan el envio de los respectivos correos. Por esta parte estoy muy bien, el problema que presento es que requiero hacer simultaneamente el envio de los correos con 20 procesos (hilos) y que se mantenga constante 20 procesos enviando las peticiones de Indy, basicamente esto lo estoy logrando, el problema radica en que necesito mostrar el log de operaciones de cada peticion en un control memo del formulario principal y por alguna razon los hilos no terminan su ejecucion, entiendo que debo usar Syncronize para evitar conflicto de acceso entre los hilos pero no se si lo estoy utilizando correctamente y necesita ayuda es con esto, les anexo el codigo en cuestion:

Esta es la clase Thread

Código Delphi [-]
THTTPThread = class(TThread)
    private
      Index: Integer;
      Msg: string;
      Error: Boolean;
      MyHTTP: TIdHTTP;
    public
      constructor Create(Suspended: Boolean; AIndex: Integer); overload;
      destructor Destroy; reintroduce;
      procedure Execute; override;
      procedure DoWork;
  end;

{ THTTPThread }

constructor THTTPThread.Create(Suspended: Boolean; AIndex: Integer);
begin
  inherited Create(Suspended);
  Index := AIndex;
  MyHTTP := TIdHTTP.Create(nil);
end;

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

procedure THTTPThread.DoWork;
var
  AuxColor: TColor;
begin
  with FrmP do
  begin
    if (Error) then
    begin
      AuxColor := clRed;
    end
    else
    begin
      AuxColor := clBlack;
    end;
    LogSpammer(Msg,AuxColor);
  end;
end;

procedure THTTPThread.Execute;
var
  ParamsList: TStringList;
  Inbox, Email: string;
begin
  FreeOnTerminate := False;
  Randomize;
  Error := False;
  ParamsList := nil;
  try
    //Getting Random Inbox and Email
    Inbox := FrmP.LstInbox.Items[Random(FrmP.LstInbox.Count)];
    Email := FrmP.LstEmail.Items[Index].ToLower;
    ParamsList := TStringList.Create;
    with MyHTTP do
    begin
      ParamsList.Add('qemail=' + Email);
      try
        MyHTTP.Post(Inbox,ParamsList);
      except
        Error := True;
      end;
    end;
  finally
    ParamsList.Free;
  end;
  if (Error) then
  begin
    Msg := 'Enviando E-mail para "' + Email + '"... Resultado: Error. (' + MyHTTP.ResponseText + ')';
  end
  else
  begin
    Msg := 'Enviando E-mail para "' + Email + '"... Resultado: OK. (' + MyHTTP.ResponseText + ')';
  end;
  Synchronize(DoWork);
end;

Aqui la porcion de codigo donde genero los hilos:
FrmP es el Formulario Principal y LstInbox y LstEmail son ListBox con la lista de correos electronicos.

Código Delphi [-]
            //Configuring Thread
            while True do
            begin
              if (Length(AThreads) < MaxThreads) then
              begin
                SetLength(AThreads,Length(AThreads) + 1);
                AThreads[Length(AThreads) - 1] := THTTPThread.Create(True,j);
                AThreads[Length(AThreads) - 1].Start;
                Break;
              end
              else
              begin
                for k := Low(AThreads) to High(AThreads) do
                begin
                  if (AThreads[k].Terminated) then //Aqui visualizo el depurador pero la tarea nunca termina.
                  begin
                    AThreads[k].Free;
                    AThreads[k] := THTTPThread.Create(True,j);
                    AThreads[k].Start;
                    Break;
                  end;
                end;
              end;
              Sleep(100);
            end;

AThreads es un Array de THTTPThread dinamico y basicamente controla la cantidad de thread a generar, y MaxThreads la cantidad maxima permitida a generar.

Espero que puedan ayudarme, al menos comprender porque la aplicacion se cuelga y los hilos nunca terminan que basicamente es el problema que presento.

Saludos.

No puedo probarlo ahora, pero a primeras te recomendaría lo siguiente.
No accedas desde dentro del Thread directamente a objetos del formulario y tampoco al formulario.

Código Delphi [-]
    //Getting Random Inbox and Email
    Inbox := FrmP.LstInbox.Items[Random(FrmP.LstInbox.Count)];
    Email := FrmP.LstEmail.Items[Index].ToLower;

Esos accesos a FrmP (que imagino es el formulario) eliminalos.
Crea 2 propiedades en el thread para pasar esas lista de valores y al crearlo se los pasas.

Código Delphi [-]
...
  property Inbox:TStrings read FInbox write FInbox;
  property Emails:TStrings read FEmails write FEmails;
...

constructor Create(Suspended: Boolean; AIndex: Integer; pInbox, pEmails:TStrings); overload;  
begin

...
  FInbox := TStringsList.Create();
  FInbox.Assig(pInbox);
  FEmails := TStringsList.Create();
  FEmails.Assign(pEmails);
...
end;

Dentro del thread ya puedes usar estas listas, en lugar de acceder al FrmP.

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

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