Creating an SMTP Server - The Code
(Page 4 of 5 )
Take a look at the communication between an SMTP Server and a client. This is an intercept:
127.0.0.1:3976 Stat Connected.
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 220 Welcome to SMTP Server<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: EHLO LEIDAGO<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 250-Hello LEIDAGO
<EOL>250-AUTH LOGIN<EOL>250-ENHANCEDSTATUSCODES<EOL>250
PIPELINING<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: AUTH LOGIN<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 334 VXNlcm5hbWU6<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: amFjcXVlcw==<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 334 UGFzc3dvcmQ6<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: bm9haA==<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 235 2.7.0 welcome
Leidago<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: RSET<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 250 Ok<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: MAIL FROM:
<admin@localhost><EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 250 2.1.0
admin@localhost Address Okay<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:57: RCPT
TO:<admin@localhost.com><EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:57: 250 2.1.5
admin@localhost.com Address Okay<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:58: RSET<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:58: 250 Ok<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:03:58: RSET<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:03:58: 250 Ok<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: MAIL FROM:
<admin@localhost><EOL>
127.0.0.1:3976 Sent 18/02/2006 18:04:01: 250 2.1.0
admin@localhost Address Okay<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: RCPT
TO:<admin@localhost.com><EOL>
127.0.0.1:3976 Sent 18/02/2006 18:04:01: 250 2.1.5
admin@localhost.com Address Okay<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: DATA<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:04:01: 354 Start mail input;
end with <CRLF>.<CRLF><EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: From: admin@localhost
<admin@localhost><EOL>Subject: hello<EOL>To:
admin@localhost.com<EOL>Date: Sat, 18 Feb 2006 18:03:57
+0000<EOL><EOL><EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: <EOL>.<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:04:01: 250 Ok<EOL>
127.0.0.1:3976 Recv 18/02/2006 18:04:01: QUIT<EOL>
127.0.0.1:3976 Sent 18/02/2006 18:04:01: 221 Signing Off<EOL>
127.0.0.1:3976 Stat Disconnected.
0.0.0.0:0 Stat Disconnected.
************************** End intercept************************
I will heavily comment the code where it is not easy to work out what is happening.
This procedure is triggered when the server receives a message:
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 >>
More Delphi-Kylix Articles
More By Leidago
