Ian Branch 128 Posted March 6, 2021 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
Ian Branch 128 Posted March 6, 2021 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 <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'; // 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
Remy Lebeau 1436 Posted March 7, 2021 (edited) 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 March 7, 2021 by Remy Lebeau Share this post Link to post
Ian Branch 128 Posted March 7, 2021 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
Ian Branch 128 Posted March 7, 2021 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
Ian Branch 128 Posted March 7, 2021 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
Ian Branch 128 Posted March 7, 2021 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. Share this post Link to post
Ian Branch 128 Posted March 15, 2021 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 <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'; // 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
Ian Branch 128 Posted March 15, 2021 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
Remy Lebeau 1436 Posted March 15, 2021 (edited) 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 March 15, 2021 by Remy Lebeau Share this post Link to post
Ian Branch 128 Posted March 15, 2021 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
![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
