Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 11-04-2017
rmendoza83 rmendoza83 is offline
Miembro
 
Registrado: ago 2006
Posts: 50
Poder: 18
rmendoza83 Va por buen camino
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.
Responder Con Cita
  #2  
Antiguo 12-04-2017
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.233
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
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.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #3  
Antiguo 12-04-2017
rmendoza83 rmendoza83 is offline
Miembro
 
Registrado: ago 2006
Posts: 50
Poder: 18
rmendoza83 Va por buen camino
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
Responder Con Cita
  #4  
Antiguo 12-04-2017
bucanero bucanero is offline
Miembro
 
Registrado: nov 2013
Ubicación: Almería, España
Posts: 208
Poder: 11
bucanero Va camino a la fama
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
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Threads en unit Ramsay Varios 12 14-04-2016 16:59:31
manejo de threads ... anubis Lazarus, FreePascal, Kylix, etc. 20 22-04-2015 01:31:12
Aclaracion de threads JULIPO Varios 4 10-12-2012 17:33:37
uso de threads JULIPO API de Windows 2 25-07-2007 17:09:06
Threads in DLL's Gianni Varios 0 20-07-2007 23:18:23


La franja horaria es GMT +2. Ahora son las 13:13:55.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi