Jump to content
Ian Branch

Using Events when creating a component??

Recommended Posts

Hi Team,

This is a general question I know and should probably be elsewhere, however, I am trying to do it in/with Indy so I would appreciate your indulgence..

I am creating the Indy components on the fly..

...
....
  //
  IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(self);
  IdSMTP1 := TIdSMTP.Create(self);
  IdMessage1 := TIdMessage.Create(self);
  //
....
...

I have come across routines to update a progress bar in Delphi for Indy.

The use the following events...

    procedure IdSMTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure IdSMTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);

I suspect they would normally be called by the IdSMTP component events, however, per above, I don't have the component physically on the form.

How do I link my created IdSMTP1 to these 'events' please?

Again, I know this is not an Indy specific question.  My apologies.

 

Regards & TIA,

Ian

Share this post


Link to post

Hi Team,

For reference/interest, this is what I am trying to get to work..

procedure TForm1.btnSendClick(Sender: TObject);
var
  Attachmentfile: TIdAttachmentFile;
  sSendReportTo, sSendReportCC: string;
begin
  //
  IdSMTP1 := TIdSMTP.Create(nil);
  //
  try
    //
    IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(IdSMTP1);
    IdMessage1 := TIdMessage.Create(IdSMTP1);
    //
    // IO HANDLER SETTINGS //
    with IdSSLIOHandlerSocketOpenSSL1 do
    begin
      MaxLineAction := maException;
      SSLOptions.Method := sslvTLSv1;
      SSLOptions.Mode := sslmUnassigned;
      SSLOptions.VerifyMode := [];
      SSLOptions.VerifyDepth := 0;
    end;
    //
    // SETTING SMTP COMPONENT DATA //
    IdSMTP1.Host := 'smtp-mail.outlook.com';
    IdSMTP1.Port := 587;
    IdSMTP1.Username := 'xxxxxx@someplace.com'; // please change to your gmail address //
    IdSMTP1.Password := 'MyPWD';
    IdSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
    IdSMTP1.AuthType := satDefault;
    IdSMTP1.UseTLS := utUseExplicitTLS;
    //
    // SETTING email MESSAGE DATA //
    IdMessage1.Clear;
    //
    sSendReportTo := 'yyyyyy@someplace.com'; // Temporary while testing this functionality.
    sSendReportCC := 'zzzzzz@someplace.com;aaaaaa@someplace.com;bbbbbbb@someplace.com'; // Temporary while testing this functionality.
    // Process TO: Addressees.
    while StrTokenCount(sSendReportTo, ';') > 0 do
    begin
      //
      with IdMessage1.Recipients.Add do
      begin
        Name := '';
        Address := StrToken(sSendReportTo, ';');
      end;
      //
    end;
    //  Process CC: Addressees.
    while StrTokenCount(sSendReportCC, ';') > 0 do
    begin
      //
      with IdMessage1.CCList.Add do
      begin
        Name := '';
        Address := StrToken(sSendReportCC, ';');
      end;
      //
    end;
    // add Attachment to mail //
    Attachmentfile := TIdAttachmentFile.Create(IdMessage1.MessageParts, 'E:\IndySMTPEmailTest\ReadMe.txt');
    //
    IdMessage1.From.Address := 'xxxxxx@someplace.com'; // please change to your gmail address //;
    IdMessage1.Subject := 'Test Email Subject';
    IdMessage1.Body.Text := 'Test Email Body';
    IdMessage1.Priority := mpHigh;
    //
    with TIdText.Create(IdMessage1.MessageParts, nil) do
    begin
      Body.Text :=
        '<p style="color: #5e9ca0;">This is a test&nbsp;<strong>message</strong> for <span style="color: #ff0000;"><strong>emailing</strong></span>.</p><h1 style="color: #5e9ca0;">&nbsp;</h1>';
      ContentType := 'text/html';
    end;
    //
    IdMessage1.ContentType := 'multipart/mixed';
    //
    try
      IdSMTP1.Connect();
      IdMessage1.SaveToStream(TmpStream, False);                //  TmpStream declared as a form variable.    TmpStream: TStream;
      IdSMTP1.Send(IdMessage1);
      ShowMessage('Email sent');
      IdSMTP1.Disconnect();
    except
      on e: Exception do
      begin
        ShowMessage('Error message is - ' + e.Message);
        IdSMTP1.Disconnect();
      end;
    end;
    //
    Attachmentfile.Free;
    //
  finally
    IdSMTP1.Free;
  end
  //
end;

procedure TForm1.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  nPer: Currency;
begin
  //
  nPer := 0.0;
  //
  try
    nPer := (AWorkCount / ProgressBar1.Max) * 100;
  except
  end;
  //
  ProgressBar1.Position := AWorkCount;
  Label1.Caption := CurrToStrF(nPer, ffFixed, 0) + ' %';
  Form1.Update;
end;

procedure TForm1.IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  Label1.Caption := '0 %';
  ProgressBar1.Position := 0;
  ProgressBar1.Max := TmpStream.Size;
  Form1.Update;
end;

procedure TForm1.IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := ProgressBar1.Max;
  Label1.Caption := '100 %';
  Form1.Update;
end;

Regards,

Ian

Share this post


Link to post

Events are just properties, like any other.  You can assign your event handlers like this:

IdSMTP1 := TIdSMTP.Create(nil);
...
IdSMTP1.OnWork := IdSMTP1Work;
IdSMTP1.OnWorkBegin := IdSMTP1WorkBegin;
IdSMTP1.OnWorkEnd := IdSMTP1WorkEnd;
...

 

Edited by Remy Lebeau

Share this post


Link to post

Hi Remy,

Ahhhh, Tks.  As simple as that.  I was half expecting it to be more complex. :-)

I have added that code..

    IdSMTP1.AuthType := satDefault;
    IdSMTP1.UseTLS := utUseExplicitTLS;
    //
    IdSMTP1.OnWork := IdSMTP1Work;
    IdSMTP1.OnWorkBegin := IdSMTP1WorkBegin;
    IdSMTP1.OnWorkEnd := IdSMTP1WorkEnd;
    //

Now when run I get the error message..  "Connection closed Gracefully", and nothing sent. :-(

If I comment out this line..

    try
      IdSMTP1.Connect();
      //IdMessage1.SaveToStream(TmpStream, False);			<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
      IdSMTP1.Send(IdMessage1);
      ShowMessage('Email sent');

and run it,  I get an access violation error when achieving 6%. :-(  Probably not surprising.

This is probably the difference between the original procedure/event definitions, were apparently incompatible,  I don't know..

Old...

 

Quote

    procedure IdSMTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure IdSMTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);

 

New..

type
  TForm1 = class(TForm)
    btnSend: TButton;
    Button2: TButton;
    Button3: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure btnSendClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);

The original procedures, shown in my previous email, are a little old, do they need 'revision'?

I haven't mentioned - D10.4.1 & Indy 10 as distributed with it.

 

Regards & TIA,

Ian

Share this post


Link to post

I suspect this is the issue..

In the WorkBegin there is,  "ProgressBar1.Max := TmpStream.Size."

.Max is an Integer, .Size is an Int64. :-(

Investigating..

 

 

 

Share this post


Link to post

Nope.  Red herring.  Got the error because I had the Save to stream commented out. :-(

Back to the closed gracefully message but nothing sent.

Share this post


Link to post

Attached is the Stack trace from when the button is clicked..

It 'seems' to be working but to be honest I have no idea what should be happening/seen here..

Certainly nothing is sent.

 

Screenshot_3.jpg

Share this post


Link to post

Hi Team,

Can someone offer some assistance/advice here?

I still can't get the code to work..

procedure TForm1.btnSendClick(Sender: TObject);
var
  Attachmentfile: TIdAttachmentFile;
  sSendReportTo, sSendReportCC: string;
begin
  //
  IdSMTP1 := TIdSMTP.Create(nil);
  //
  try
    //
    IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(IdSMTP1);
    IdMessage1 := TIdMessage.Create(IdSMTP1);
    //
    // IO HANDLER SETTINGS //
    with IdSSLIOHandlerSocketOpenSSL1 do
    begin
      MaxLineAction := maException;
      SSLOptions.Method := sslvTLSv1;
      SSLOptions.Mode := sslmUnassigned;
      SSLOptions.VerifyMode := [];
      SSLOptions.VerifyDepth := 0;
      SSLOptions.Mode := sslmClient;
    end;
    //
    // SETTING SMTP COMPONENT DATA //
    IdSMTP1.Host := 'smtp-server.somewhere.com';
    IdSMTP1.Port := 587;
    IdSMTP1.Username := 'MyName@somewhere.com'; // please change to your gmail address //
    IdSMTP1.Password := 'Abc123456';
    IdSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
    IdSMTP1.AuthType := satDefault;
    IdSMTP1.UseTLS := utUseExplicitTLS;
    //
    IdSMTP1.OnWork := IdSMTP1Work;
    IdSMTP1.OnWorkBegin := IdSMTP1WorkBegin;
    IdSMTP1.OnWorkEnd := IdSMTP1WorkEnd;
    //
    try
      IdSMTP1.Connect;
    except
      on E: Exception do
      begin
        MessageDlg('Connection to Mail Server unsuccessful!  The following information was returned..: ' +
          E.Message, mtWarning, [mbOK], 0);
        Exit;
      end;
    end;
    //
    // SETTING email MESSAGE DATA //
    IdMessage1.Clear;
    //
    IdMessage1.Recipients.EMailAddresses := 'ToAddress@somewhere.com';
    IdMessage1.CCList.EMailAddresses := 'CCAddress@somewhere.com';
    // add Attachment to mail //
    Attachmentfile := TIdAttachmentFile.Create(IdMessage1.MessageParts, 'E:\IndySMTPEmailTest\ReadMe.txt');
    //
    IdMessage1.From.Address := 'myname@somewhere.com';
    IdMessage1.Subject := 'Test Email Subject';
    IdMessage1.Body.Text := 'Test Email Body';
    IdMessage1.Priority := mpHigh;
    //
    with TIdText.Create(IdMessage1.MessageParts, nil) do
    begin
      Body.Text :=
        '<p style="color: #5e9ca0;">This is a test&nbsp;<strong>message</strong> for <span style="color: #ff0000;"><strong>emailing</strong></span>.</p><h1 style="color: #5e9ca0;">&nbsp;</h1>';
      ContentType := 'text/html';
    end;
    //
    IdMessage1.ContentType := 'multipart/mixed';
    //
    try
      IdMessage1.SaveToStream(TmpStream, False);
      IdSMTP1.Send(IdMessage1);
      ShowMessage('Email sent');
      IdSMTP1.Disconnect();
    except
      on e: Exception do
      begin
        ShowMessage('Error message is - ' + e.Message);
        IdSMTP1.Disconnect();
      end;
    end;
    //
    Attachmentfile.Free;
    //
  finally
    IdSMTP1.Free;
  end
  //
end;

procedure TForm1.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  nPer: Currency;
begin
  //
  nPer := 0.0;
  //
  try
    nPer := (AWorkCount / ProgressBar1.Max) * 100;
  except
  end;
  //
  ProgressBar1.Position := AWorkCount;
  Label1.Caption := CurrToStrF(nPer, ffFixed, 0) + ' %';
  Form1.Update;
end;

procedure TForm1.IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
var
  sStreamSize: string;
  iValue: Int64;
begin

  Label1.Caption := '0 %';
  ProgressBar1.Position := 0;
  iValue := TmpStream.Size;
  sStreamSize := iValue.ToString;
  ShowMessage('Stream Size = ' + sStreamSize);
  ProgressBar1.Max := TmpStream.Size;
  Form1.Update;
end;

procedure TForm1.IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := ProgressBar1.Max;
  Label1.Caption := '100 %';
  Form1.Update;
end;

It seemingly errors out with "Error message is - Connection Closed Gracefully", there is no apparent 'progress indication and no email is sent. 😞

If I comment out the assignment of the Events and the "IdMessage1.SaveToStream(TmpStream, False);", the email is sent, which indicates the basics are fine.

 

Help!

 

Regards & TIA,

Ian

Share this post


Link to post

Hmmm.  Given the following snippet..

      Codesite.Send('IdMessage1.SaveToStream(TmpStream, False);');
      IdMessage1.SaveToStream(TmpStream, False);
      Codesite.Send('IdSMTP1.Send(IdMessage1);');
      IdSMTP1.Send(IdMessage1);

I never see the second Codesite message, suggesting that it is falling over at the IdMessage1.SaveToStream.....

Share this post


Link to post
12 hours ago, Ian Branch said:

Can someone offer some assistance/advice here?

First off, I would suggest getting rid of TempStream completely.  You did not show what it actually is, but I'm assuming it is a TMemoryStream.  You are using it only to determine the email's total byte size for progress tracking.  Indy has a TIdCalculateSizeStream class you can use for that purpose instead.  No need to hold on to a TStream object for the lifetime of the transmission.  For example:

private
  EmailSize: Int64;

...

procedure TForm1.btnSendClick(Sender: TObject);
var
  Attachmentfile: TIdAttachmentFile;
  sSendReportTo, sSendReportCC: string;
  CalcStream: TIdCalculateSizeStream;
begin
  //
  IdSMTP1 := TIdSMTP.Create(nil);
  //
  try
    //
    IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(IdSMTP1);
    IdMessage1 := TIdMessage.Create(IdSMTP1);
    //
    // IO HANDLER SETTINGS //
    with IdSSLIOHandlerSocketOpenSSL1 do
    begin
      MaxLineAction := maException;
      SSLOptions.Method := sslvTLSv1;
      SSLOptions.Mode := sslmUnassigned;
      SSLOptions.VerifyMode := [];
      SSLOptions.VerifyDepth := 0;
      SSLOptions.Mode := sslmClient;
    end;
    //
    // SETTING SMTP COMPONENT DATA //
    IdSMTP1.Host := 'smtp-server.somewhere.com';
    IdSMTP1.Port := 587;
    IdSMTP1.Username := 'MyName@somewhere.com'; // please change to your gmail address //
    IdSMTP1.Password := 'Abc123456';
    IdSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
    IdSMTP1.AuthType := satDefault;
    IdSMTP1.UseTLS := utUseExplicitTLS;
    //
    IdSMTP1.OnWork := IdSMTP1Work;
    IdSMTP1.OnWorkBegin := IdSMTP1WorkBegin;
    IdSMTP1.OnWorkEnd := IdSMTP1WorkEnd;
    //
    // SETTING email MESSAGE DATA //
    IdMessage1.Recipients.EMailAddresses := 'ToAddress@somewhere.com';
    IdMessage1.CCList.EMailAddresses := 'CCAddress@somewhere.com';
    // add Attachment to mail //
    Attachmentfile := TIdAttachmentFile.Create(IdMessage1.MessageParts, 'E:\IndySMTPEmailTest\ReadMe.txt');
    //
    IdMessage1.From.Address := 'myname@somewhere.com';
    IdMessage1.Subject := 'Test Email Subject';
    IdMessage1.Body.Text := 'Test Email Body';
    IdMessage1.Priority := mpHigh;
    //
    with TIdText.Create(IdMessage1.MessageParts, nil) do
    begin
      Body.Text :=
        '<p style="color: #5e9ca0;">This is a test <strong>message</strong> for <span style="color: #ff0000;"><strong>emailing</strong></span>.</p><h1 style="color: #5e9ca0;"> </h1>';
      ContentType := 'text/html';
    end;
    //
    IdMessage1.ContentType := 'multipart/mixed';
    //
    CalcStream := TIdCalculateSizeStream.Create;
    try
      IdMessage1.SaveToStream(CalcStream, False);
      EmailSize := CalcStream.Size;
    finally
      CalcStream.Free;
    end;
    //
    try
      IdSMTP1.Connect;
    except
      on E: Exception do
      begin
        MessageDlg('Connection to Mail Server unsuccessful!  The following information was returned..: ' +
          E.Message, mtWarning, [mbOK], 0);
        Exit;
      end;
    end;
    try
      try
        IdSMTP1.Send(IdMessage1);
      finally
        IdSMTP1.Disconnect();
      end;
    except
      on e: Exception do
      begin
        MessageDlg('Mail send unsuccessful!  The following information was returned..: ' +
          E.Message, mtWarning, [mbOK], 0);
        Exit;
      end;
    end;
    //
  finally
    IdSMTP1.Free;
  end
  //
  ShowMessage('Email sent');
end;

procedure TForm1.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  nPercent: Integer;
begin
  if AWorkMode <> wmWrite then Exit;
  //
  if EmailSize > 0 then
  begin
    nPercent := Trunc((Double(AWorkCount) / EmailSize) * 100);
    //
    ProgressBar1.Position := nPercent;
    Label1.Caption := IntToStr(nPercent) + ' %';
  end else
  begin
    ProgressBar1.Position := 0;
    Label1.Caption := IntToStr(AWorkCount) + ' b';
  end;
  Update;
end;

procedure TForm1.IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if AWorkMode <> wmWrite then Exit;
  Label1.Caption := '0 %';
  ProgressBar1.Position := 0;
  ProgressBar1.Max := 100;
  ShowMessage('Stream Size = ' + EmailSize.ToString);
  Update;
end;

procedure TForm1.IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  if AWorkMode <> wmWrite then Exit;
  ProgressBar1.Position := 100;
  Label1.Caption := '100 %';
  Update;
end;
Quote

I still can't get the code to work..

Your failure is happening inside of TIdMessage.SaveToStream() itself, so 99% of the code you have shown is irrelevant since it is not actually being used.

Quote

It seemingly errors out with "Error message is - Connection Closed Gracefully", there is no apparent 'progress indication and no email is sent. 😞

That is because the code is failing before TIdSMTP.Send() is reached, so there is no progress to report.

Quote

If I comment out the assignment of the Events and the "IdMessage1.SaveToStream(TmpStream, False);", the email is sent, which indicates the basics are fine.

Since the crash is happening inside of TIdMessage.SaveToStream(), the events are not going to be fired at all, since there is no SMTP transmission in progress.

 

As for why the crash is occurring in the first place, given the call stack shown, there are only 2 possibilities:

 

- TIdIOHandler.ClosedGracefully is True when it should not be.  This gets set when a read operation returns 0 bytes, a write operation fails with a non-timeout error, or TIdIOHandler.CloseGracefully() is called.

 

- TIdIOHandlerStream.StreamingAvailable() is returning False when it should not be.  This happens when there are no TStream objects assigned to the IOHandler.

 

TIdMessage.SaveToStream() uses a write-only TIdIOHandlerStream, writing to the specified output TStream.  So TIdIOHandlerStream should not be trying to read from a non-existent input TStream at all, thus TIdIOHandlerStream.StreamingAvailable() should always return True, unless the IOHandler has been closed prematurely.  And TIdIOHandler.ClosedGracefully should never be False unless the target TStream fails to write, which would be an indication of a larger issue.  And Indy never calls TIdIOHandler.CloseGracefully().

 

So, you are just going to have to do some debugging, and figure out which of the above conditions is actually causing TIdIOHandlerStream.CheckForDisconnect() to think it needs to raise the exception.  It should not be happening under normal conditions.

 

Edited by Remy Lebeau

Share this post


Link to post

Remy,

Thank you very much.  I had sussed it out to a degree but your code is more refined than mine.

Thank you for pointing out TIdCalculateSizeStream.

All working as desired now.

 

Regards & Tks again.

Ian

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×