Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Closed Thread
 
Thread Tools Display Modes
  #1  
Old 09-09-2017, 01:33 PM
Luiz Eduardo Luiz Eduardo is offline
Member
 
Join Date: May 2014
Posts: 34
Question Why a queue Thread freeze the Form?

Hello,

i have this code below that send email to multiple recipients using a queue Thread, but while application is sending the Form stays freezed.

How solve?

Code:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.Collections,
  SyncObjs, IdMessage,
  IdSMTP, IdText, IdBaseComponent, IdComponent, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdGlobal, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase;

Type
  TMyConsumerItem = class(TThread)
  private
    FQueue: TThreadedQueue;
    FSignal: TCountDownEvent;
  protected
    procedure Execute; override;
  public
    constructor Create(aQueue: TThreadedQueue; aSignal: TCountDownEvent);
  end;

type
  TForm1 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    btn2: TButton;
    OpenDialog1: TOpenDialog;
    SSL1: TIdSSLIOHandlerSocketOpenSSL;
    idsmtp2: TIdSMTP;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
    procedure DoSomeJob(myListItems: TStringList);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IdSMTP: TIdSMTP;
  Email: TIdMessage;
  idtTextPart: TIdText;
  SSLHandler: TIdSSLIOHandlerSocketOpenSSL;

implementation

{$R *.dfm}

constructor TMyConsumerItem.Create(aQueue: TThreadedQueue;
  aSignal: TCountDownEvent);
begin
  Inherited Create(false);
  Self.FreeOnTerminate := true;
  FQueue := aQueue;
  FSignal := aSignal;
end;

procedure TMyConsumerItem.Execute;
var
  aProc: TProc;
begin
  try
    repeat
      FQueue.PopItem(aProc);
      if not Assigned(aProc) then
        break;
      aProc();
    until Terminated;
  finally
    FSignal.Signal;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  aList: TStringList;
  i: Integer;
begin
  mmo2.Clear;
  aList := TStringList.Create;
  try
    for i := 0 to mmo1.Lines.Count - 1 do
      aList.Add(mmo1.Lines.Strings[i]);
    DoSomeJob(aList);
  finally
    aList.Free;
  end;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  if (OpenDialog1.Execute()) then
    mmo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.DoSomeJob(myListItems: TStringList);
const
  cThreadCount = 10;
  cMyQueueDepth = 100;
var
  i: Integer;
  s: string;
  aQueue: TThreadedQueue;
  aCounter: TCountDownEvent;

  function CaptureJob(const aString: string): TProc;
  begin
    s := '';
    Email.Clear;
    Email.From.Address := 'myuser@hotmail.com';
    Email.From.Name := 'myName';

    Email.Recipients.EmailAddresses := myListItems[i];
    Email.Subject := 'test message';
    Email.ContentType := 'multipart/related; type="multipart/alternative"';
    Email.CharSet := 'utf-8';

    idtTextPart := TIdText.Create(Email.MessageParts, nil);
    idtTextPart.ContentType := 'text/plain; charset=utf-8';
    idtTextPart.Body.Add('this is a test message');

    try
      if (not IdSMTP.Connected) then
      begin
        IdSMTP.Connect;
        IdSMTP.Authenticate;
      end;
    except
      on E: Exception do
      begin
        s := E.Message;
      end;
    end;

    try
      if IdSMTP.Connected then
      begin
        IdSMTP.Send(Email);
      end;
    except
      On E: Exception do
      begin
        s := E.Message;
      end;
    end;

    Result := procedure
      begin

        // Report status to main thread
        TThread.Synchronize(nil,
          procedure
          begin
            if s = '' then
              mmo2.Lines.Add(aString + ' success!');
            if s <> '' then
              mmo2.Lines.Add(aString + ' error: ' + s);
          end);

      end;
  end;

var
  aThread: TThread;
begin

  IdSMTP := TIdSMTP.Create(nil);
  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  Email := TIdMessage.Create(nil);

  try

    SSLHandler.MaxLineAction := maException;
    SSLHandler.SSLOptions.Method := sslvSSLv23;
    SSLHandler.SSLOptions.Mode := sslmUnassigned;
    SSLHandler.SSLOptions.VerifyMode := [];
    SSLHandler.SSLOptions.VerifyDepth := 0;

    IdSMTP.IOHandler := SSLHandler;
    IdSMTP.Host := 'smtp.live.com';
    IdSMTP.Port := 587;
    IdSMTP.Username := 'myuser@hotmail.com';
    IdSMTP.Password := 'mypass';
    IdSMTP.UseTLS := utUseExplicitTLS;

    aQueue := TThreadedQueue.Create(cMyQueueDepth);
    aCounter := TCountDownEvent.Create(cThreadCount);
    try
      for i := 1 to cThreadCount do
        TMyConsumerItem.Create(aQueue, aCounter);
      for i := 0 to myListItems.Count - 1 do
      begin
        aQueue.PushItem(CaptureJob(myListItems[i]));
      end;

      for i := 1 to cThreadCount do
        aQueue.PushItem(nil);
    finally

      aThread := TThread.CreateAnonymousThread(
        procedure
        begin
          aCounter.WaitFor;
          aCounter.Free;
          aQueue.Free;
        end);
      aThread.FreeOnTerminate := false;
      aThread.Start;
      aThread.WaitFor;
      aThread.Free;
    end;
  finally
    Email.Free;
    SSLHandler.Free;
    IdSMTP.Free;
    IdSMTP.Disconnect;
  end;
end;

end.
Closed Thread

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 08:19 PM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2017, vBulletin Solutions, Inc.