Hi, Rainer:
Have you considered the use of the SMTP.OnWork, OnWorkBegin, OnWorkEnd
and OnStatus events?
Best regards,
Chuck Belanger
Richmond, CA
Here is some code that I use in a form for my application:
PROCEDURE TfrmCloseSesNotes.SMTPStatus(ASender : TObject;
CONST AStatus : TIdStatus; CONST AStatusText : STRING);
BEGIN
IF Utility.BatchEmail AND
Assigned(frmBatchEmail) AND
frmBatchEmail.visible THEN
BEGIN
frmBatchEmail.fcStatusBar1.SimpleText := AStatusText + ' | ' +
Utility.StatBar;
frmBatchEmail.fcStatusBar1.Update;
END
ELSE
BEGIN
fcStatusBar1.Panels[0].Text := AStatusText;
//5/2009 nead to keep repainting window and maintaining focus
//adding to SMTPWork, too
frmCloseSesNotes.Repaint;
IF frmCloseSesNotes.CanFocus THEN
BEGIN frmCloseSesNotes.SetFocus END;
END;
END;
PROCEDURE TfrmCloseSesNotes.SMTPWork(ASender : TObject;
AWorkMode : TWorkMode; AWorkCount : INT64);
VAR
sStatusText : STRING;
i : INTEGER;
BEGIN
//12/17/09 if StopEmail button clicked then attempt to disconnect
IF Utility.StopSendingEmail THEN
BEGIN
IF Utility.BatchEmail AND
Assigned(frmBatchEmail) AND
frmBatchEmail.visible THEN
BEGIN
frmBatchEmail.fcStatusBar1.SimpleText := 'Attempting to Abort
Sending email...' + ' | ' + Utility.StatBar;
frmBatchEmail.fcStatusBar1.Update;
END
ELSE
BEGIN
fcStatusBar1.Panels[0].Text := 'Attempting to Abort Sending
email...';
fcStatusBar1.update;
btnStopEmail.Visible := FALSE;
btnEmailSend.Visible := TRUE;
END;
//12/19/09 per Indy forum, put Disconnect in a Try...Except for Send
// Utility.StopSendingEmail := FALSE; do not reset here, otherwise
only current email is aborted
//throw this exception, which is trapped in the Try..Except for send
Abort();
END
ELSE
BEGIN
IF Utility.BatchEmail AND
Assigned(frmBatchEmail) AND
frmBatchEmail.visible THEN
BEGIN
IF frmBatchEmail.pbEmail.Max > 0 THEN
BEGIN
sStatusText := 'Sending ' + IntToStr(AWorkCount) +
' bytes of ' + IntToStr(frmBatchEmail.pbEmail.Max) + ' bytes.';
frmBatchEmail.pbEmail.Progress := AWorkCount;
frmBatchEmail.pbEmail.Update; //needed or no change is visible
END
ELSE
BEGIN
sStatusText := 'Sending ' + IntToStr(AWorkCount) + ' bytes.';
END;
frmBatchEmail.fcStatusBar1.SimpleText := sStatusText + ' | ' +
Utility.StatBar;
frmBatchEmail.fcStatusBar1.Update;
frmBatchEmail.update;
Application.Processmessages;
END
ELSE //not batchemailer
BEGIN
//if the progess bar has an upper setting then
IF pbEmail.Max > 0 THEN
BEGIN
sStatusText := 'Sending ' + IntToStr(AWorkCount) +
' bytes of ' + IntToStr(pbEmail.Max) + ' bytes.';
pbEmail.Progress := AWorkCount;
pbEmail.Update; //needed or no change is visible
END
ELSE
BEGIN
sStatusText := 'Sending ' + IntToStr(AWorkCount) + ' bytes.';
END;
fcStatusBar1.Panels[0].Text := sStatusText;
//5/2009 nead to keep repainting window and maintaining focus
//adding to SMTPWork, too
//6/29/09 this doesn't completely work as expected; the window stays
painted, but the
//progress bar is not updated if you click to another window
//Adding a separate PB update after repainting the window
IF (AWorkCount MOD 1000 = 0) THEN
BEGIN
frmCloseSesNotes.Repaint;
IF frmCloseSesNotes.CanFocus THEN
BEGIN frmCloseSesNotes.SetFocus END;
pbEmail.Update;
Application.Processmessages;
END;
END;
END;
END;
PROCEDURE TfrmCloseSesNotes.SMTPWorkBegin(ASender : TObject;
AWorkMode : TWorkMode; AWorkCountMax : INT64);
BEGIN
IF Utility.BatchEmail THEN
BEGIN WITH frmBatchEmail DO
BEGIN
pbEmail.Progress := 0;
pbEmail.Update; //this is needed
//per NG AWorkCountMax always gives 0, useless, have to calc size with
streams
pbEmail.Max := EmailSize;
END END
ELSE
BEGIN
pbEmail.Progress := 0;
pbEmail.Update; //this is needed
//per NG AWorkCountMax always gives 0, useless, have to calc size with
streams
pbEmail.Max := EmailSize;
END;
END;
PROCEDURE TfrmCloseSesNotes.SMTPWorkEnd(ASender : TObject;
AWorkMode : TWorkMode);
BEGIN
IF Utility.BatchEmail THEN
BEGIN WITH frmBatchEmail DO
BEGIN
pbEmail.Progress := pbEmail.Max;
pbEmail.Update;
frmBatchEmail.fcStatusBar1.SimpleText := 'Finished' + ' | ' +
Utility.StatBar;
frmBatchEmail.fcStatusBar1.Update;
END END
ELSE
BEGIN
pbEmail.Progress := pbEmail.Max;
pbEmail.Update;
fcStatusBar1.Panels[0].Text := 'Finished';
//12/17/09 put buttons back to default
btnEmailSend.Visible := TRUE;
btnStopEmail.Visible := FALSE;
END;
END;
Hi Bjarne,
The code you suggest is precisely what I do. The problem is that the
Send completes before sending is complete -- it returns once the
message has been loaded into the outgoing buffer. And the disconnect
also completes successfully before the outgoing buffer has actually
transmitted its contents over the internet.
So ... my problem is ... How do I know when the transmission is
actually complete, and it is safe to end the program?
Thanks,
Rainer
_______________________________________________
Delphi mailing list
Delphi@elists.org
http://lists.elists.org/cgi-bin/mailman/listinfo/delphi
_______________________________________________
Delphi mailing list
Delphi@elists.org
http://lists.elists.org/cgi-bin/mailman/listinfo/delphi