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

Reply via email to