Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Closed Thread
 
Thread Tools Display Modes
  #1  
Old 09-10-2017, 03:07 PM
Luiz Eduardo Luiz Eduardo is offline
Member
 
Join Date: May 2014
Posts: 34
Unhappy trouble: 2 threads accessing simultaneous the same item of a queue thread

I have this code below that send email based in queue threads but if not pause (eg: Sleep(1000)) by a certain time, two threads try access the same item of queue simultaneous.

Someone know how solve this trouble?

Code:
uses
  System.Types, Generics.Collections, IdMessage;

type
  TThreadItem = class;
  TThreadList = TObjectList;
  TMessageItem = TIdMessage;
  TMessageQueue = TThreadedQueue;

  TThreadPool = class
  private
    FQueue: TMessageQueue;
    FThreads: TThreadList;
  public
    constructor Create(Count: Integer);
    destructor Destroy; override;
    procedure Shutdown;
    property Queue: TMessageQueue read FQueue;
  end;

  TThreadItem = class(TThread)
  private
    FQueue: TMessageQueue;
  protected
    procedure Execute; override;
  public
    constructor Create(Queue: TMessageQueue); reintroduce;
  end;

implementation

{ TThreadPool }

constructor TThreadPool.Create(Count: Integer);
var
  I: Integer;
  Thread: TThreadItem;
begin
  inherited Create;
  { this will create thread queue that will wait for push and pop of its items INFINITE
    time; that's useful for thread sleeping }
  FQueue := TMessageQueue.Create;
  FThreads := TThreadList.Create;

  for I := 0 to Count-1 do
  begin
    Thread := TThreadItem.Create(FQueue);
    FThreads.Add(Thread);
  end;
end;

destructor TThreadPool.Destroy;
begin
  Shutdown;
  FThreads.Free;
  FQueue.Free;
  inherited;
end;

procedure TThreadPool.Shutdown;
var
  Thread: TThreadItem;
  Message: TMessageItem;
begin
  { signal threads for termination }
  for Thread in FThreads do
    Thread.Terminate;
  { shutdown the queue to "unlock" sleeping threads }
  FQueue.DoShutDown;
  { free all the unprocessed enqueued message items }
  Message := FQueue.PopItem;
  while Assigned(Message) do
  begin
    Message.Free;
    Message := FQueue.PopItem;
  end;
end;

{ TThreadItem }

constructor TThreadItem.Create(Queue: TMessageQueue);
begin
  inherited Create;
  FQueue := Queue;
end;

procedure TThreadItem.Execute;
var
  Message: TMessageItem;
begin
  { <- create and setup Indy sending object here }
  try
    while not Terminated do
      { here we'll wait for INFINITE time for an item or until queue is shutted down;
        you should consider checking for error state as well }
      if FQueue.PopItem(Message) = wrSignaled then
      try
        { <- send the Message through the Indy sending object here }
      finally
        Message.Free;
      end;
  finally
    { <- destroy Indy sending object here }
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////

{ Possible usage: }

Pool := TThreadPool.Create(2); { <- create 2 threads }
for I := 0 to 99 do
begin
  Message := TMessageItem.Create(nil);
  Message.Subject := 'Message subject';
  ...
  Pool.Queue.PushItem(Message);
end;
  #2  
Old 09-11-2017, 04:19 PM
rojam rojam is offline
Senior Member
 
Join Date: Jun 2015
Posts: 173
Default

What happens if you change the execute method to FIRST check to see if the thread is terminated and only create the INDY components if there's an item in the Queue:

Code:
procedure TThreadItem.Execute;
var
  Message: TMessageItem;
begin
  while not Terminated do
  begin
    if FQueue.PopItem(Message) = wrSignaled then
    try
      { <- create and setup Indy sending object here }
      try
        { <- send the Message through the Indy sending object here }
      finally
        { <- destroy Indy sending object here }
      end;
    finally
      Message.Free;
    end;
  end;
end;
There's no sense creating the INDY components if the thread has been terminated, so the FIRST thing to do in EXECUTE is check TERMINATED or if there's no items in the Queue.

Last edited by rojam; 09-11-2017 at 04:24 PM.
  #3  
Old 09-12-2017, 01:52 AM
Luiz Eduardo Luiz Eduardo is offline
Member
 
Join Date: May 2014
Posts: 34
Default

@Rojam,

following is a minimal and complete example about how is my code:

Code:
uses
 IdSMTP, IdMessage, IdText, IdSSLOpenSSL, IdGlobal, SyncObjs, Generics.Collections;

type
  TThreadItem = class;
  TThreadList = TObjectList;
  TMessageItem = TIdMessage;
  TMessageQueue = TThreadedQueue;

  TThreadPool = class
  private
    FQueue: TMessageQueue;
    FThreads: TThreadList;
  public
    constructor Create(Count: Integer);
    destructor Destroy; override;
    procedure Shutdown;
    property Queue: TMessageQueue read FQueue;
  end;

  TThreadItem = class(TThread)
  private
    FQueue: TMessageQueue;
  protected
    procedure Execute; override;
  public
    constructor Create(Queue: TMessageQueue); reintroduce;
  end;

type
    ThreadEmail = class(TThread)
      public
      procedure Execute; Override;
    end;

...	
	
var
 Pool: TThreadPool;
 TEmail: ThreadEmail;
 _Message_: TMessageItem;
 IdText: TIdText;
 IdSMTP: TIdSMTP;
 SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
 
procedure ExecuteAll;
begin
  TEmail := ThreadEmail;.Create(true);
  TEmail.FreeOnTerminate := true;
  TEmail.Start;
end;
 
constructor TThreadPool.Create(Count: Integer);
var
  I: Integer;
  Thread: TThreadItem;
begin
  inherited Create;

  FQueue := TMessageQueue.Create;
  FThreads := TThreadList.Create;

  for I := 0 to Count-1 do
  begin
    Thread := TThreadItem.Create(FQueue);
    FThreads.Add(Thread);
  end;
end;

destructor TThreadPool.Destroy;
begin
  Shutdown;
  FThreads.Free;
  FQueue.Free;
  inherited;
end;

procedure TThreadPool.Shutdown;
var
  Thread: TThreadItem;
begin

  for Thread in FThreads do
    Thread.Terminate;

  FQueue.DoShutDown;

  _Message_ := FQueue.PopItem;
  while Assigned(_Message_) do
  begin
    _Message_.Free;
    _Message_ := FQueue.PopItem;
  end;
end;

constructor TThreadItem.Create(Queue: TMessageQueue);
begin
  inherited Create;
  FQueue := Queue;
end;

procedure TThreadItem.Execute;
begin
  try
   
    while not Terminated do
        
      if FQueue.PopItem(_Message_) = wrSignaled then
        try
		
         if IdSMTP.Connected then
          begin
           IdSMTP.Send(_Message_);
           MessageDlg('Sent with success!', mtInformation, [mbOK], 0);
          end;
        except
          On E: Exception do
          begin
           MessageDlg('Error to send: ' + E.Message, mtWarning, [mbOK], 0);
          end;
        end;
  finally
    _Message_.Free;
    _Message_.Destroy;
  end;
end;

procedure ThreadEmail.Execute;
begin
    IdSMTP := TIdSMTP.Create(nil);
    SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    Pool := TThreadPool.Create(2); // <- two threads

    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 := 'myusername@hotmail.com';
        IdSMTP.Password := Pass;
        IdSMTP.UseTLS := utUseExplicitTLS;

for I := 0 to Form1.MemoEmails.Lines.Count - 1 do
begin
      
        _Message_ := TMessageItem.Create(nil);
        _Message_.From.Address := 'myusername@hotmail.com';
      
        _Message_.From.Name := 'Myname';

        _Message_.Recipients.EmailAddresses := Form1.MemoEmails.Lines.Strings[I];
        _Message_.Subject := 'Message subject';
        _Message_.ContentType := 'multipart/related; type="multipart/alternative"';
        _Message_.CharSet := 'utf-8';

        idtTextPart:= TIdText.Create(_Message_.MessageParts,nil);

        idtTextPart.ContentType := 'text/plain; charset=utf-8';
          
        idtTextPart.Body.add('this is a test message');

        if FileExists('C:\myfile.txt') then
        begin
           TIdAttachmentFile.Create( _Message_.MessageParts, 'C:\myfile.txt');
        end;

        try
          if (not IdSMTP.Connected) then
          begin
            IdSMTP.Connect;
            IdSMTP.Authenticate;
          end;
       except
          on E: Exception do
          begin
            MessageDlg(E.Message,
              mtWarning, [mbOK], 0);
            exit;
          end;
       end;

       Pool.Queue.PushItem(_Message_);
finally
    SSLHandler.Free;
    IdSMTP.Free;
    IdSMTP.Disconnect;
    Pool.Shutdown;
end;
end;
See that TThreadItem.Execute; is actived only when Pool.Queue.PushItem(_Message_); is called.

Note: My goal is make a sender email so fast as a brute force program that use several number of threads:


Last edited by Luiz Eduardo; 09-12-2017 at 02:05 AM.
  #4  
Old 09-12-2017, 04:09 PM
rojam rojam is offline
Senior Member
 
Join Date: Jun 2015
Posts: 173
Default

You really need to rethink your logic, this time remembering you are attempting to have a multi-threaded process.

In procedure ThreadEmail.Execute, you set up IdSMTP, Pool, SSHandler, the push the _Message_ onto your Queue, and then Free IdSMTP, SSHandler and shutdown Pool. Your TThreadItem apparently expects them to be available because you reference them. By the time TThreadItem.Execute gets around to using IdSMTP, it probably doesn't exist anymore, same for SSHandler and the Pool has been shutdown.

Also, You have multiple places you are outputting a message using MessageDlg in a try/except block. I'm sure you've heard, you cannot interact with the User Interface from within a thread. MessageDlg needs access to the main thread to display correctly.

Also, in TThreadItem.Execute, you do
_Message_.Free;
_Message_.Destroy;

Never call an Object's Destroy method. Free does that for you already.
Closed Thread

Tags
multithreading, queue

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:20 PM.


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