DELPHI-KYLIX

Creating an SMTP Server

A POP3 server only does half the job when it comes to email. In this article you will learn how to build an SMTP server.

Author Info:

By: Leidago

Poor Best

Rating:

/ 17

May 08, 2006

TABLE OF CONTENTS:

procedure TForm1.IdSMTPServer1MsgReceive(ASender:
TIdSMTPServerContext;
AMsg: TStream; var LAction: TIdDataReply);
var
lmsg : TIdMessage;
LStream : TFileStream;
toad,from,sub,body:string;
abuff:tstrings;
six:int64;
begin
CoInitialize(nil);
//get message size..
six:=amsg.Size;
LStream := TFileStream.Create(ExtractFilePath
(Application.exename) + 'test.eml', fmCreate);
Try
//put message contents in LStream...
LStream.CopyFrom(AMsg, 0);
Finally
FreeAndNil(LStream);
End;
mess.NoDecode:=true;
//Load the message into idMessage component
mess.LoadFromFile('test.eml',false);
label4.Caption:=datetostr(mess.Date);
label1.Caption:=mess.Recipients.EMailAddresses;
label2.Caption:=mess.From.Address;
label3.Caption:=mess.Subject;
memo1.Lines.Text:=mess.Body.Text;
//if mess.From.Address <> '' then begin
ado1.TableName:='email';
ado1.Active:=true;
ado1.Insert;
ado1.FieldByName('to').Text:=mess.Recipients.EMailAddresses;
ado1.FieldByName('from').Text:= mess.From.Address;
ado1.FieldByName('subject').Text:=mess.Subject;
ado1.FieldByName('mbody').AsString:=mess.Body.Text;
//Date: Wed, 1 Feb 2006 17:34:43 +0000
ado1.FieldByName('mdate').AsDateTime:=mess.Date;
ado1.FieldByName('msize').value:=six;
ado1.FieldByName('ismarked').value:=0;
ado1.Post;
CoUnInitialize;
//end;
end;

The message is received in a stream and is therefore stored physically on disk by the TFilestream method. It is loaded again to be stored in the database.

Next is the rcptTo command, here you just validate the entered emailAddress. The Address is stored in the "AAddress: String;" bit of the procedure header. All that I did here is to check that the entered email address contains a '@' character, since all email addresses have to contain one. If the email address contains a '@' character then Vaction is set to AddressOK, otherwise it's set to InValid or any of the responses outlined in the code below:

procedure TForm1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
const AAddress: String; var VAction: TIdRCPToReply;
var VForward: String);
begin

// The following actions can be returned to the server:
{
    rAddressOk, //address is okay
    rRelayDenied, //we do not relay for third-parties
    rInvalid, //invalid address
    rWillForward, //not local - we will forward
    rNoForward, //not local - will not forward - please use
    rTooManyAddresses, //too many addresses
    rDisabledPerm, //disabled permanently - not accepting E-Mail
    rDisabledTemp //disabled temporarily - not accepting E-Mail
}
  if Pos('@', AAddress) > 0 then begin

VAction := rAddressOk;
end
else begin
VAction :=rInvalid;
end;
end;

procedure TForm1.IdSMTPServer1Received(ASender:
TIdSMTPServerContext;
var AReceived: String);
begin
// This is a new event in the rewrite of IdSMTPServer for Indy
10.
// It lets you control the Received: header that is added to the
e-mail.
// If you do not want a Received here to be added, set
AReceived := '';
// Formatting 'keys' are available in the received header --
please check
// the IdSMTPServer source for more detail.
AReceived := '';
end;

procedure TForm1.IdSMTPServer1UserLogin(ASender:
TIdSMTPServerContext;
const AUsername, APassword: String; var VAuthenticated:
Boolean);
begin
// This event is fired if a user attempts to login to the server
// Normally used to grant relay access to specific users etc.
//Search for the username and password in "users" table..
q2.SQL.Text := 'SELECT * from users WHERE uname=:user AND
upass=:pwd';
        q2.Parameters.ParamByName('user').Value :=AUsername;
        q2.Parameters.ParamByName('pwd').Value := APassword;
        q2.open;
//if the user is not found, set authentication to false
if q2.RecordCount = 0 then begin

VAuthenticated := False;
end else begin
VAuthenticated := True;
end;
end;

Same as RcptTo, check if the email address contains a '@'
character and reply accordingly...

procedure TForm1.IdSMTPServer1MailFrom(ASender:
TIdSMTPServerContext;
const AAddress: String; var VAction: TIdMailFromReply);
begin
// Here we are testing the MAIL FROM line sent to the server.
// MAIL FROM address comes in via AAddress. VAction sets the
return action to the //server.
// The following actions can be returned to the server:
{ mAccept, mReject }

if Pos('@', AAddress) > 0 then begin
VAction:= mAccept;

end
else begin
VAction := mReject;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
idsmtpserver1.Greeting.SetReply(220,'Welcome to SMTP Server');
end;

procedure TForm1.IdSMTPServer1Execute(AContext: TIdContext);
begin
logfile.DoLogWriteString(acontext.Connection.IOHandler.ReadLn);
end;

procedure TForm1.IdSMTPServer1Exception(AContext: TIdContext;
AException: Exception);
begin
acontext.Connection.IOHandler.Write(aexception.Message);
end;

Next: Conclusion >>