Jump to content
Plainer

Batch / bulk email program that reads a database for addresses.

Recommended Posts

I am trying to create an email program that will send a email to mutable email addresses by reading in a database file and sending out a

email / newsletter to each record in the database. (for my wife's sewing club)
 
I have been using the "OverbyteIcsSslMailSnd" sample / demo program as an guide.

 

Everything works correctly if I select a record and the send the email. The problem I am having is trying to figure out a way to send the

email to each listed email in the database automatically.

 

I can not find a direct means to send the batch of emails, I was thinking that if  within the "All In One" button I added a while loop to repeat

the process until the database is empty, however that did not work.

 

So next I tried was to add a test button that calls the "All In One" button using the .click method of the button.


Procedure
Newbutton
Database gotop

while not database.eof do
begin
  allinonebutton.click;
  skip database one record;
end;

 

The problem I am having on the second loop "Record 2" I receive a error "SMTP Component not ready".

 

I am thinking that I may need some sort of a delay timer between iterations.

 

What am I overlooking?


Thanks
Will

Share this post


Link to post

Hi...:classic_cool:

i think ist confused. :classic_happy:

 

Please show the code of your program...

 

Principle:

1: loop ( while not Database.Eof do ...from Query)

2: create Mail complete with sender, receiver (from database "FieldByName"), body (the same)  ...

procedure Send(Sender: string; Receiver: string; Body: string);

3: send

 

Quote

allinonebutton.click

Sorry...never use a click procedure...bad design. :classic_huh:

 

Quote

SMTP Component not ready

In the loop use .Open / .Close of the ICS component...imho.

Share this post


Link to post
Quote

The problem I am having on the second loop "Record 2" I receive a error "SMTP Component not ready".

This is because the component is asynchronous: start some operation which is executed in the background while you own code continue. When operation is finished in the background, you receive an event.

 

Your program should use the async way of programming. That is no loop but events and messages.

 

Code outline:

1) procedure to do your SQL request then PostMessage a custom message

2) from the handler of this custom message, take current record and start sending a mail. If EOF then you are done.

3) handle all SMTP component events, chaining commands for OnRequestDone until the mail is fully sent

4) when mail fully sent, use PostMessage to post the custom message.
 

Those 4 step are NOT in line in a single procedure ! They are "chained" thru events or custom message, just like "All-in-one" button does

Share this post


Link to post

I told you before to use the Mail Queue sample, which you did, that is specifically designed for exactly what you are trying to do, sending hundreds of emails by queuing them.  The sample program allows a list of email addresses to be entered.

 

Beware your email supplier AOL may block your email if it thinks you are behaving like  a spammer. you may need a proper email account. 

 

Angus

Share this post


Link to post

I have been looking over the sample program and was wondering if I am on the correct path, I was going to give the following a try but wanted some input first.

 

I was thinking that I can send the next email by using the ClientRequestDone event.

 

I made my additions in bold text so you can see them.

 

 

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientRequestDone(
    Sender : TObject;
    RqType : TSmtpRequest;
    Error  : Word);
begin
    { For every operation, we display the status }
    if (Error > 0) and  (Error < 10000) then
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                    ' Error='+ SslSmtpClient.ErrorMessage)
    else
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                            ' Error='+ IntToStr(Error));
    { Check if the user has asked for "All-In-One" demo }
    if not FAllInOneFlag then
        Exit;             { No, nothing more to do here }
    { We are in "All-In-One" demo, start next operation }
    { But first check if previous one was OK            }
    if Error <> 0 then begin
        FAllInOneFlag := FALSE;   { Terminate All-In-One demo }
        Display('Error, stoped All-In-One demo');
        Exit;
    end;
    case RqType of
    smtpConnect:  begin
                      if SslSmtpClient.AuthType = smtpAuthNone then
                          SslSmtpClient.Helo
                      else
                          SslSmtpClient.Ehlo;
                  end;
    smtpHelo:     SslSmtpClient.MailFrom;
    smtpEhlo: if SslSmtpClient.SslType = smtpTlsExplicit then begin
                  Inc(FEhloCount);
                  if FEhloCount = 1 then
                      SslSmtpClient.StartTls
                  else if FEhloCount > 1 then
                      SslSmtpClient.Auth;
              end
              else
                  SslSmtpClient.Auth;
    smtpStartTls: SslSmtpClient.Ehlo; // We need to re-issue the Ehlo command
    smtpAuth:     SslSmtpClient.MailFrom;
    smtpMailFrom: SslSmtpClient.RcptTo;
    smtpRcptTo:   SslSmtpClient.Data;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Check database for EOF if True then finish
       smtpData:     SslSmtpClient.Quit;
       smtpQuit:     Display('All-In-One done !');
      exit;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    end;

 

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Send next email
// Get next record reload component and send
    SslSmtpClient.RcptName.Clear;
    SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    SslSmtpClient.HdrFrom         := FromEdit.Text;
    SslSmtpClient.HdrTo           := ToEdit.Text;
    SslSmtpClient.HdrCc           := CcEdit.Text;
    SslSmtpClient.HdrSubject      := SubjectEdit.Text;
    SslSmtpClient.SignOn          := SignOnEdit.Text;
    SslSmtpClient.FromName        := FromEdit.Text;
    SslSmtpClient.EmailFiles      := FileAttachMemo.Lines;
    SslSmtpClient.SendMode        := smtpCopyToStream;
    SslSmtpClient.Mail;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end;

 

Share this post


Link to post

No point in looking at the code since it is using the wrong component, for the third time.  You are attempting to recreate code that already exists and works in the TIcsMailQueue component.

 

Angus

 

Share this post


Link to post
On 8/16/2020 at 1:12 AM, Angus Robertson said:

No point in looking at the code since it is using the wrong component, for the third time.  You are attempting to recreate code that already exists and works in the TIcsMailQueue component.

 

Angus

 

Angus, the example you are talking about is similar but different, your example does send out an email to multiple address but keeps the content of the email static, the program I am working on sends out a unique message to each recipient, by walking though a database,

 

I have a somewhat working model however one small problem and not sure where it stems from, on the third iteration it hangs, does not give an error simply hangs.  I was thinking it maybe a timing issue sending to much to the mail server to quickly.   I was thinking that if I put in a small pause between each email it  may resolve the issue.

 

Can I send  you a copy of the code for your review and recommendations?

 

Thank you

Will

Share this post


Link to post

The mail queue sample sends the same message to a list, but each message has different headers with a sing;e To: address. There is no reason you can not queue a different message to each address as well.  Which ever way you queue the messages, they are saved as separate messages since they are sent one at time, with multiple attempts if delivery attempts fail.   

 

Essentially using the TIcsMailQueue component means you only have to prepare the messages, all the actual SMTP sending is done for you, and that is what you want to duplicate in your own code, why?  

 

Angus

 

Edited by Angus Robertson

Share this post


Link to post
7 hours ago, Plainer said:

on the third iteration it hangs, does not give an error simply hangs

Are you sure you test all possible error everywhere and don't ignore any exception?

 

The code you gave yesterday is flawed. Your addition in RequestDone handler to start a new mail do not depend on the RqType but is always executed.

 

Share this post


Link to post
17 minutes ago, FPiette said:

Are you sure you test all possible error everywhere and don't ignore any exception?

 

The code you gave yesterday is flawed. Your addition in RequestDone handler to start a new mail do not depend on the RqType but is always executed.

 

I think you are right, The two emails that do send return the following after sending a email. 

First email: RequestDone Rq=5 Error=0

Second email: RequestDone Rq=9 Error=0

 

I put in a 2 second delay between sends (procedure TEMail_Send.SendNextRecord;) but no real progress, It is on the third email that the system hangs up.

 

This is the code I am currently working with.

procedure TEMail_Send.BitBtn4Click(Sender: TObject);
begin
    DataBase_Mail.GoTop; // not sure about this

    if SslSmtpClient.Connected then begin
        MessageBeep(MB_OK);
        Display('All-In-One demo start in connected state.');
        Display('Please quit or abort the connection first.');
        Exit;
    end;

    FAllInOneFlag               := TRUE;
    FEhloCount                  := 0;
    { Initialize all SMTP component properties from our GUI }
    SslSmtpClient.Host          := wDataBase_Cfg.GetTrimString('CHOST');
    SslSmtpClient.Port          := wDataBase_Cfg.GetTrimString('CPORTHOST');
    SslSmtpClient.SignOn        := wDataBase_Cfg.GetTrimString('CSIGNON');
    SslSmtpClient.FromName      := wDataBase_Cfg.GetTrimString('CFROM');;
    SslSmtpClient.HdrFrom       := wDataBase_Cfg.GetTrimString('CFROM');
    SslSmtpClient.HdrTo         := DataBase_Mail.GetTrimString('COWN1EMAIL');
    SslSmtpClient.HdrCc         := DataBase_Mail.GetTrimString('COWN2EMAIL');
    SslSmtpClient.HdrSubject    := DataBase_EMailText.GetString('CSUBLINE');
    SslSmtpClient.EmailFiles    := nil; // FileAttachMemo.Lines;
    SslSmtpClient.AuthType      := TSmtpAuthType(wDataBase_Cfg.GetInteger('NAUTHTYPE'));
    SslSmtpClient.SslType       := TSmtpSslType(wDataBase_Cfg.GetInteger('NSSLType'));

    if SslSmtpClient.SslType <> smtpTlsNone then begin
        SslContext1.SslPrivKeyFile := ''; //KeyEdit.Text;
        SslContext1.SslPassPhrase  := ''; //PassPhraseEdit.Text;
        SslContext1.SslCertFile    := ''; //CertEdit.Text;
        SslContext1.SslCAFile      := ''; //CAFileEdit.Text;
        SslContext1.SslCAPath      := ''; //CAPathEdit.Text;
        //SslContext1.SslVerifyPeer  := false; //VerifyPeerCheckBox.Checked;
        SslContext1.SslVerifyPeer  := wDataBase_Cfg.GetLogical('LSSLVERPER');
        if SslContext1.SslVerifyPeer then begin
            SslSmtpClient.OnSslVerifyPeer := SslSmtpClientSslVerifyPeer;
            SslSmtpClient.OnSslHandshakeDone := SslSmtpClientSslHandshakeDone;
        end
        else begin
            SslSmtpClient.OnSslVerifyPeer := nil;
            SslSmtpClient.OnSslHandshakeDone := nil;
        end;
    end;

    SslSmtpClient.Username       := wDataBase_Cfg.GetTrimString('CUSERNAME');
    SslSmtpClient.Password       := wDataBase_Cfg.GetTrimString('CPASSWORD');
    SslSmtpClient.HdrPriority    := TSmtpPriority(wDataBase_Cfg.GetInteger('NPriority'));
    { Recipient list is computed from To, Cc and Bcc fields }
    SslSmtpClient.RcptName.Clear;
    //SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    SslSmtpClient.RcptNameAdd(DataBase_Mail.GetTrimString('COWN1EMAIL'), DataBase_Mail.GetTrimString('COWN2EMAIL'), '');

    Display('Connecting to SMTP server...');
    { Start first operation to do to send an email          }
    { Next operations are started from OnRequestDone event  }

  //BuildRcptList;

  //SendNextEmail;

    SslSmtpClient.Connect;

end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

 

procedure TEMail_Send.SslSmtpClientRequestDone(Sender: TObject;
  RqType: TSmtpRequest; ErrorCode: Word);
begin
    { For every operation, we display the status }
    if (Error > 0) and  (Error < 10000) then
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                    ' Error='+ SslSmtpClient.ErrorMessage)
    else
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                            ' Error='+ IntToStr(Error));
    { Check if the user has asked for "All-In-One" demo }
    if not FAllInOneFlag then
        Exit;             { No, nothing more to do here }
    { We are in "All-In-One" demo, start next operation }
    { But first check if previous one was OK            }
    if Error <> 0 then begin
        FAllInOneFlag := FALSE;   { Terminate All-In-One demo }
        Display('Error, stoped All-In-One demo');
        Exit;
    end;
    case RqType of
    smtpConnect:  begin
                      if SslSmtpClient.AuthType = smtpAuthNone then
                          SslSmtpClient.Helo
                      else
                          SslSmtpClient.Ehlo;
                  end;
    smtpHelo:     SslSmtpClient.MailFrom;
    smtpEhlo: if SslSmtpClient.SslType = smtpTlsExplicit then begin
                  Inc(FEhloCount);
                  if FEhloCount = 1 then
                      SslSmtpClient.StartTls
                  else if FEhloCount > 1 then
                      SslSmtpClient.Auth;
              end
              else
                  SslSmtpClient.Auth;

    smtpStartTls: SslSmtpClient.Ehlo; // We need to re-issue the Ehlo command
    smtpAuth:     SslSmtpClient.MailFrom;
    smtpMailFrom: SslSmtpClient.RcptTo;
    smtpRcptTo:   SslSmtpClient.Data;

    smtpData:     if DataBase_Mail.Eof then
                     begin
                     SslSmtpClient.Quit;
                     Display('Mail Done !');
                     end
                  else
                     begin
                     if nSentCount = 0 then
                        begin
                        nSentCount := (nSentCount+1);
                        SentCount.Caption := IntToStr(nSentCount);
                        end;
                     SendNextRecord;
                     end;

    smtpQuit:     if DataBase_Mail.Eof then
                     begin
                     Display('Mail Done !');
                     end;
                  //else
                  //   begin
                  //   SendNextRecord;
                  //   end;

    end;
{*******************************************************************}
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TEMail_Send.SendNextRecord;
begin
    ShowMessage('Start Test');
    Delay(2000);
    ShowMessage('End Test');

    DataBase_Mail.Skip(1);

    if not DataBase_Mail.Eof then
       begin
       FAllInOneFlag                 := True;
       SslSmtpClient.RcptName.Clear;
       SslSmtpClient.RcptNameAdd(Trim(DataBase_Mail.GetTrimString('COWN1EMAIL')), Trim(DataBase_Mail.GetTrimString('COWN2EMAIL')), '');
       SslSmtpClient.HdrFrom         := wDataBase_Cfg.GetTrimString('CFROM');
       SslSmtpClient.HdrTo           := DataBase_Mail.GetTrimString('COWN1EMAIL');
       SslSmtpClient.HdrCc           := DataBase_Mail.GetTrimString('COWN2EMAIL');
       SslSmtpClient.HdrSubject      := DataBase_EMailText.GetString('CSUBLINE');
       SslSmtpClient.SignOn          := wDataBase_Cfg.GetTrimString('CSIGNON');
       SslSmtpClient.FromName        := wDataBase_Cfg.GetTrimString('CFROM');
       SslSmtpClient.EmailFiles      := nil; // FileAttachMemo.Lines;
       SslSmtpClient.Host            := wDataBase_Cfg.GetTrimString('CHOST');
       SslSmtpClient.Port            := wDataBase_Cfg.GetTrimString('CPORTHOST');
       //SslSmtpClient.SendMode        := smtpCopyToStream;
       SslSmtpClient.Mail;
       if nSentCount > 0 then
          begin
          nSentCount := (nSentCount+1);
          SentCount.Caption := IntToStr(nSentCount);
          end;
       end
    else
       exit;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

 

 

 

Share this post


Link to post
8 hours ago, Plainer said:

SslSmtpClient.Mail;

You should start the next mail at MailFrom stage.

 

Share this post


Link to post
14 hours ago, FPiette said:

You should start the next mail at MailFrom stage.

 

Not to clear on what you meant, however I did make a change by moving the next record call within the case statement.  It seemed to make matters worse as it no longer sends out an email but still stops after two records. 

 

    smtpMailFrom: begin
                  SendNextRecord;
                  SslSmtpClient.RcptTo;
                  end;

The solution is simply eluding me, the concept seems simple but proving difficult to do.

 

Can you provide an example on the correct insertion point for the next record call?

 

Thanks

Share this post


Link to post

That was good in your previous run but you called "Mail" instead of "MailFrom".

 

Share this post


Link to post
7 hours ago, FPiette said:

That was good in your previous run but you called "Mail" instead of "MailFrom".

 

Ok, I see that I will make a change and give it a go.  Thanks.

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
×