Re: SMTP mail server not forwarding attachment to recipients if more than one

Giganews Newsgroups
Subject: Re: SMTP mail server not forwarding attachment to recipients if more than one
Posted by:  Remy Lebeau (TeamB) (no.spam@no.spam.com)
Date: Tue, 10 Jan 2006

"Codeman II" <thegentlem…@webmail.co.za> wrote in message
news:5871E5D6F4E8E240thegentlem…@webmail.co.za...

> Everything is working fine but when I include more than one
> email address in the To: field of my email client, only the first
> email are sent WITH the attachments (when attachments have
> been added). All the rest of the emails are sent with the subject
> and body text but no attachments.

There are several problems with your code.  See below.

> I am using the idSMTPServer component and here is my code
> for the OnReceiveMessageParsed event:

I *STRONGLY* advise you not to use that event.  Indy 9's message parsers are
very outdated, especially when it comes to parsing multipart messages (which
includes attachments).  Modern email messages have evolved to the point
where Indy 9 can't handle them very well anymore.  Worse, not only may the
parsers not be able to handle the data, but the encoders are just as
outdated.  You are risking Indy completely messing up your message data,
because it is first parsing the data, and then re-encoding what is was able
to parse.  As such, there is no guarantee that what you send to
TIdSMTPServer will be what is sent back out later on.

Given the code you have shown, you would be best off using the OnReceiveRaw
or OnReceiveMessage event instead.  This is because you are not doing any
processing on the contents of each message, so it is best to forward the
content as-is without any parsing/re-encoding at all.  This is also more
portable to Indy 10, where the parsing events have been completely removed
anyway, and you are only provided with raw data now.

If you want to continue using the OnReceiveMessageParsed event, then at
least set the server's NoDecode and NoEncode properties both to True.  This
will effectively have the same effect as using the OnReceiveMessage event,
except that you will still have the TIdMessage.BCCList property filled in
(you won't with the other events).

>    lblTo.Caption := AMsg.Recipients.EMailAddresses;
>    lblFrom.Caption := AMsg.From.Text;
>    lblSubject.Caption := AMsg.Subject;
>    memBody.Clear;
>
>    AMsg.MessageParts.CountParts;
>    If AMsg.MessageParts.TextPartCount > 0 then
>      memBody.Lines.Add(TIdText(AMsg.MessageParts.Items[1]).Body.Text)
>    Else
>      memBody.Lines := AMsg.Body;

That code is not thread-safe.  TIdSMTPServer is multi-threaded.  It is not
safe to directly access the GUI from the context of a worker thread.

>    // Implement your file system here :)
>    idSMTP.Host := 'smtp.saix.net';

That is also not thread-safe.  You are sharing a single TIdSMTP instance
across multiple threads.  I would suggest that you dynamically create a new
TIdSMTP instance each time the event is triggered.  Otherwise, you have to
provide serialized access to the shared TIdSMTP instance so that only one
thread can access it at a time.

> MessageDLG('An error occurred: ' + IntToStr(GetLastError) + '.',
> mtError, [mbOk], 0);

That is also not thread-safe.  MessageDlg() displays a VCL TForm.  TForm is
not safe to use outside the context of the main thread.

With that said, there is also a design flaw in your event handling.  You are
not taking into account that multiple recipient domains may be specified in
a message.  You should grab a list of all of the domains and then connect to
each individual SMTP server separately, forwarding your message to just the
recipients that belong to each server.  You can use the TIdDNSResolver
component for getting the SMTP hostname for each domain listed in the
message.

For example (untested):

    type
        TDomainItem = class(TCollectionItem)
        private
            FDomain: String;
            FRecipients: TStrings;
            FServers: TStrings;
        public
            constructor Create(ACollection: TColection); override;
            destructor Destroy; override;
            property Domain: String read FDomain write FDomain;
            property Recipients: TStrings read FRecipients;
            property Servers: TStrings read FServers;
        end;

        TDomainList = class(TCollection)
        private
            function GetDomain(Index: Integer): TDomainItem;
        public
            constructor Create; reintroduce;
            procedure AddRecipients(ARecipients: TIdEMailAddressList);
            function IndexOf(const ADomain: String): Integer;
            property Domains[Index: Integer]: TDomainItem read GetDomain
default;
        end;

    constructor TDomainItem.Create(ACollection: TColection);
    begin
        inherited Create(ACollection);
        FRecipients := TStringList.Create;
        FServers := TStringList.Create;
    end;

    destructor TDomainItem.Destroy;
    begin
        FRecipients.Free;
        FServers.Free;
        inherited Destroy;
    end;

    constructor TDomainList.Create;
    begin
        inherited Create(TDomainItem);
    end;

    procedure TDomainList.AddRecipients(ARecipients: TIdEMailAddressList);
    var
        I, J: Integer;
        S: String;

        function EnsureDomain(const ADomain: String): TDomainItem;
        var
            I :Integer;
        begin
            for I := 0 to Count-1 do
            begin
                Result := Domains[I];
                if AnsiSameText(Result.Domain, ADomain) then Exit;
            end;
            Result := TDomainItem(inherited Add);
            Result.Domain := ADomain;
        end;

    begin
        for I := ARecipients.Count-1 do
        begin
            S := ARecipients[I].Address;
            J := Pos(S, '@');
            if J <> 0 then EnsureDomain(Copy(S, J+1,
MaxInt)).Recipients.Add(S);
        end;
    end;

    function TDomainList.GetDomain(Index: Integer): TDomainItem;
    begin
        Result := TDomainItem(inherited GetItems(Index));
    end;

    procedure TForm1.IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var
VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String);
    var
        Domains: TDomainList;

        procedure ResolveServers;
        var
            DNS: TIdDNSResolver;
            I: Integer;
        begin
            DNS := TIdDNSResolver.Create(nil);
            try
                DNS.Host := 'whatever DNS server you want to use';
                DNS.QueryRecords := [qtMX];
                for I := 0 to Domains.Count-1 do
                begin
                    DNS.QueryResult.Clear;
                    DNS.Resolve(Domains[I].Domain);
                    for J := 0 to DNS.QueryResult.Count-1 do
                    begin
                        if DNS.QueryResult[J] is TMXRecord then

Domains[I].Servers.Add(TMXRecord(DNS.QueryResult[J]).ExchangeServer);
                    end;
                end;
            finally
                DNS.Free;
            end;
        end;

        procedure ForwardMessage;
        var
            SMTP: TIdSMTP;
            I: Integer;

            function SendToDomain(ADomain: TDomainItem);
            var
                J: Integer;
                LThread: TIdSMTPServerThread;
            begin
                Result := False;
                LThread := TIdSMTPServerThread(ASender.Thread);
                for I := 0 to ADomain.Servers.Count-1 do
                begin
                    SMTP.Host := ADomain.Servers[I];
                    try
                        Connect;
                    except
                        Continue;
                    end;
                    try
                        // copied from TIdSMTP.Send()...
                        SMTP.SendCmd('RSET');
                        if (SMTP.AuthenticationType <> atNone) and
(SMTP.AuthSchemesSupported.IndexOf('LOGIN') <> -1) then
                            SMTP.Authenticate;
                        SMTP.SendCmd('MAIL FROM:<' + LThread.From + '>',
250);
                        for J := 0 to ADomain.Recipients.Count-1 do
                            SMTP.SendCmd('RCPT TO:<' + ADomain.Recipients[J]
+ '>', [250, 251]);
                        SMTP.SendCmd('DATA', 354);
                        SMTP.WriteStream(VStream);
                        SMTP.SendCmd('.', 250);
                    finally
                        SMTP.Disconnect;
                    end;
                    Result := True;
                    Exit;
                end;
            end;

        begin
            SMTP := TIdSMTP.Create(nil);
            try
                SMTP.Port := 25;
                // set up other SMTP properties as needed...

                for I := 0 to Domains.Count-1 do
                begin
                    if not SendToDomain(Domains[I]) then
                        // failed to send message to Domain, do something
...
                end;
            finally
                SMTP.Free;
            end;
        end;

    begin
        // save VStream data as desired, then ...
        Domains := TDomainList.Create;
        try
            Domains.AddRecipients(RCPT);
            ResolveServers;
            ForwardMessage;
        finally
            Domains.Free;
        end;
    end;

Gambit

Replies

None

In response to

SMTP mail server not forwarding attachment to recipients if more than one posted by Codeman II on Tue, 10 Jan 2006