unit thSMTPServer;
interface
uses System.Classes, IdSMTPServer, IdMessage, System.SysUtils, IdAttachment;
type
TSMTPServer=class(TThread)
private
FPort: Integer;
FIPAddress:
string;
FIdSMTP: TIdSMTPServer;
FPendingPath:
string;
FTempPath:
string;
procedure IdSMTPServer1MsgReceive(ASender: TIdSMTPServerContext;
AMsg: TStream;
var LAction: TIdDataReply);
procedure IdSMTPServer1UserLogin(ASender: TIdSMTPServerContext;
const AUsername, APassword:
String;
var VAuthenticated: Boolean);
procedure IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
const AAddress:
String; AParams: TStrings;
var VAction: TIdRCPToReply;
var VForward:
String);
procedure IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
const AAddress:
String; AParams: TStrings;
var VAction: TIdMailFromReply);
procedure IdSMTPServer1Received(ASender: TIdSMTPServerContext;
var AReceived:
String);
public
constructor Create(Suspended: Boolean; Port: Integer; IPAddress:
string; PendingPath:
string; TempPath:
string);
protected
procedure Execute;
override;
end;
implementation
uses
frmMain;
{ TPOP3Server }
constructor TSMTPServer.Create(Suspended: Boolean; Port: Integer; IPAddress:
string; PendingPath:
string; TempPath:
string);
begin
inherited Create(Suspended);
FPort:=Port;
FIPAddress:=IPAddress;
FPendingPath:=PendingPath;
FTempPath:=TempPath;
FIdSMTP:=TIdSMTPServer.Create(
nil);
// Self.FreeOnTerminate:=true;
Self.NameThreadForDebugging('
SMTP-Server-Thread');
end;
procedure TSMTPServer.IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
const AAddress:
String; AParams: TStrings;
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 }
// For now, we will just always allow the mail from address.
VAction := mAccept;
end;
procedure TSMTPServer.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.
end;
procedure TSMTPServer.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
const AAddress:
String; AParams: TStrings;
var VAction: TIdRCPToReply;
var VForward:
String);
begin
// Here we are testing the RCPT TO lines sent to the server.
// These commands denote where the e-mail should be sent.
// RCPT To address comes in via AAddress. VAction sets the return action to the server.
// Here, you would normally do:
// Check if the user has relay rights, if the e-mail address is not local
// If the e-mail domain is local, does the address exist?
// 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 permentantly - not accepting E-Mail
rDisabledTemp //disabled temporarily - not accepting E-Mail
}
// For now, we will just always allow the rcpt address.
VAction := rAddressOk;
end;
procedure TSMTPServer.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.
VAuthenticated := True;
end;
procedure TSMTPServer.IdSMTPServer1MsgReceive(ASender: TIdSMTPServerContext;
AMsg: TStream;
var LAction: TIdDataReply);
var
LMsg : TIdMessage;
//LStream : TFileStream;
DestinationNumber:
string;
From:
string;
i: Integer;
begin
// When a message is received by the server, this event fires.
// The message data is made available in the AMsg : TStream.
// In this example, we will save it to a temporary file, and the load it using
// IdMessage and parse some header elements.
LMsg := TIdMessage.Create;
Try
LMsg.LoadFromStream(AMsg);
DestinationNumber := LMsg.Subject;
From:=LMsg.From.Text;
for i := 0
to LMsg.MessageParts.Count-1
do
if LMsg.MessageParts.Items[i]
is TIdAttachment
then
if (LowerCase(ExtractFileExt(LMsg.MessageParts.Items[i].FileName))='
.pdf')
or
(LowerCase(ExtractFileExt(LMsg.MessageParts.Items[i].FileName))='
.bmp')
or
(LowerCase(ExtractFileExt(LMsg.MessageParts.Items[i].FileName))='
.jpg')
then
begin
(LMsg.MessageParts.Items[i]
as TIdAttachment).SaveToFile(FPendingPath+LMsg.MessageParts.Items[i].FileName);
Synchronize(
procedure
begin
frm_main.AddToPending(From, DestinationNumber, LMsg.MessageParts.Items[i].FileName);
end);
end;
Finally
FreeAndNil(LMsg);
End;
end;
procedure TSMTPServer.Execute;
var
i: Integer;
begin
try
if FIPAddress<>'
'
then
begin
FIdSMTP.Bindings.Clear;
with FIdSMTP.Bindings.Add
do
IP:=FIPAddress;
end;
for i := 0
to FIdSMTP.Bindings.Count-1
do
FIdSMTP.Bindings[i].Port:=FPort;
FIdSMTP.OnMsgReceive:=IdSMTPServer1MsgReceive;
FIdSMTP.OnUserLogin:=IdSMTPServer1UserLogin;
FIdSMTP.OnRcptTo:=IdSMTPServer1RcptTo;
FIdSMTP.OnMailFrom:=IdSMTPServer1MailFrom;
FIdSMTP.OnReceived:=IdSMTPServer1Received;
FIdSMTP.Active:=True;
while not Terminated
do
begin
Sleep(200);
end;
finally
FIdSMTP.Active:=False;
//self.Free;
end;
end;
end.