david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
386 lines
12 KiB
ObjectPascal
386 lines
12 KiB
ObjectPascal
unit uROIndyEmailServer;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Indy Components }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
IdBaseComponent, IdSMTP, IdPOP3,
|
|
{$IFDEF RemObjects_INDY10} IdAttachment, {$ENDIF}
|
|
uROClientIntf, uROServer, uROThread, SyncObjs, SysUtils;
|
|
|
|
type
|
|
TROEmailServerThread = class;
|
|
|
|
TROExceptionEvent = procedure (aSender:TObject; aExceptionClass:TClass; const aExceptionMessage:string) of object;
|
|
|
|
TROCustomEmailServer = class(TROServer, IROTransport)
|
|
private
|
|
fServerEmail: string;
|
|
fSmtpClient: TIdSMTP;
|
|
fPop3Client: TIdPOP3;
|
|
fPop3CheckInterval: integer;
|
|
fWorkThread: TROEmailServerThread;
|
|
fOnException: TROExceptionEvent;
|
|
procedure SetSmtpClient(const Value: TIdSMTP);
|
|
function GetSmtpServerAddress: string;
|
|
procedure SetSmtpServerAddress(const Value: string);
|
|
procedure SetPopClient(const Value: TIdPOP3);
|
|
function GetPop3ServerAddress: string;
|
|
procedure SetPop3ServerAddress(const Value: string);
|
|
procedure SetPop3CheckInterval(const Value: integer);
|
|
|
|
procedure TriggerOnException(aExceptionClass:TClass; const aExceptionMessage:string);
|
|
function GetPop3Password: string;
|
|
function GetPop3username: string;
|
|
procedure SetPop3password(const Value: string);
|
|
procedure SetPop3Username(const Value: string);
|
|
|
|
public
|
|
constructor Create(aOwner:TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
protected
|
|
function GetTransportObject: TObject;
|
|
procedure IntSetActive(const Value: boolean); override;
|
|
function IntGetActive : boolean; override;
|
|
|
|
public { for publishing in descendand classes }
|
|
property Pop3ServerAddress:string read GetPop3ServerAddress write SetPop3ServerAddress;
|
|
property SmtpServerAddress:string read GetSmtpServerAddress write SetSmtpServerAddress;
|
|
property ServerEmail:string read fServerEmail write fServerEmail;
|
|
property SmtpClient:TIdSMTP read fSmtpClient write SetSmtpClient;
|
|
property Pop3Client:TIdPOP3 read fPop3Client write SetPopClient;
|
|
property Pop3Username: string read GetPop3username write SetPop3Username;
|
|
property Pop3Password: string read GetPop3Password write SetPop3password;
|
|
property Pop3CheckInterval:integer read fPop3CheckInterval write SetPop3CheckInterval default 60;
|
|
property OnException:TROExceptionEvent read fOnException write fOnException;
|
|
procedure CheckProperties; override;
|
|
end;
|
|
|
|
TROEmailServer = class(TROCustomEmailServer)
|
|
property Pop3ServerAddress;
|
|
property SmtpServerAddress;
|
|
property ServerEmail;
|
|
property SmtpClient;
|
|
property Pop3Client;
|
|
property Pop3Username;
|
|
property Pop3Password;
|
|
property Pop3CheckInterval;
|
|
property OnException;
|
|
end;
|
|
|
|
TROEmailServerThread = class(TROServerCheckMessageThread)
|
|
private
|
|
fSync_ExceptionClass:TClass;
|
|
fSync_aExceptionMessage:string;
|
|
procedure Sync_TriggerOnException(aExceptionClass:TClass; const aExceptionMessage:string);
|
|
procedure Synced_TriggerOnException;
|
|
protected
|
|
procedure CheckForMessages; override;
|
|
procedure ProcessMessage(aRequest:TStream; const aMessageID,aFrom:string);
|
|
public
|
|
constructor Create(aOwner:TROCustomEmailServer); reintroduce;
|
|
end;
|
|
|
|
TROEmailServerProcessMessageThread = class(TROThread)
|
|
private
|
|
fOwner:TROCustomEmailServer;
|
|
fRequest:TStream;
|
|
fMessageID:string;
|
|
fFrom:string;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(aOwner:TROCustomEmailServer; aRequest:TStream; const aMessageID,aFrom:string); reintroduce;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IdMessage,
|
|
uROAsync, uROClasses, uROIndyEmail, uROServerIntf;
|
|
|
|
{ TROCustomEmailServer }
|
|
|
|
procedure TROCustomEmailServer.CheckProperties;
|
|
begin
|
|
inherited;
|
|
if not (csDesigning in ComponentState) then begin
|
|
Check(Pop3ServerAddress = '', Name + '.Pop3ServerAddress must be set.');
|
|
Check(SmtpServerAddress = '', Name + '.SmtpServerAddress must be set.');
|
|
Check(ServerEmail = '', Name + '.ServerEmail must be set.');
|
|
Check(Pop3Username = '', Name + '.Pop3Username must be set.');
|
|
Check(Pop3Password = '', Name + '.Pop3Password must be set.');
|
|
end;
|
|
end;
|
|
|
|
constructor TROCustomEmailServer.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fSmtpClient := TIdSMTP.Create(self);
|
|
fSmtpClient.Name := 'InternalSmtpClient';
|
|
fPop3Client := TIdPOP3.Create(self);
|
|
fPop3Client.Name := 'InternalPop3Client';
|
|
Pop3CheckInterval := 60;
|
|
{$IFDEF VER140UP}
|
|
fSmtpClient.SetSubComponent(true);
|
|
fPop3Client.SetSubComponent(true);
|
|
{$ENDIF VER140UP}
|
|
fWorkThread := TROEmailServerThread.Create(self);
|
|
end;
|
|
|
|
destructor TROCustomEmailServer.Destroy;
|
|
begin
|
|
fWorkThread.Free;
|
|
FreeAndNil(fSmtpClient);
|
|
FreeAndNil(fPop3Client);
|
|
inherited;
|
|
end;
|
|
|
|
function TROCustomEmailServer.GetPop3Password: string;
|
|
begin
|
|
result := fPop3Client.Password;
|
|
end;
|
|
|
|
function TROCustomEmailServer.GetPop3ServerAddress: string;
|
|
begin
|
|
result := fPop3Client.Host;
|
|
end;
|
|
|
|
function TROCustomEmailServer.GetPop3username: string;
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
result := fPop3Client.UserId;
|
|
{$ELSE}
|
|
result := fPop3Client.Username;
|
|
{$ENDIF RemObjects_INDY8}
|
|
end;
|
|
|
|
function TROCustomEmailServer.GetSmtpServerAddress: string;
|
|
begin
|
|
result := fSmtpClient.Host;
|
|
end;
|
|
|
|
function TROCustomEmailServer.GetTransportObject: TObject;
|
|
begin
|
|
result := self;
|
|
end;
|
|
|
|
function TROCustomEmailServer.IntGetActive: boolean;
|
|
begin
|
|
result := fWorkThread.Active;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.IntSetActive(const Value: boolean);
|
|
begin
|
|
CheckProperties;
|
|
fWorkThread.Active := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetPop3CheckInterval(const Value: integer);
|
|
begin
|
|
fPop3CheckInterval := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetPop3password(const Value: string);
|
|
begin
|
|
fPop3Client.Password := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetPop3ServerAddress(const Value: string);
|
|
begin
|
|
fPop3Client.Host := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetPop3Username(const Value: string);
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
fPop3Client.UserId := Value;
|
|
{$ELSE}
|
|
fPop3Client.Username := Value;
|
|
{$ENDIF RemObjects_INDY8}
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetPopClient(const Value: TIdPOP3);
|
|
begin
|
|
fPop3Client.Assign(Value);
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetSmtpClient(const Value: TIdSMTP);
|
|
begin
|
|
fSmtpClient.Assign(Value);
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.SetSmtpServerAddress(const Value: string);
|
|
begin
|
|
fSmtpClient.Host := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailServer.TriggerOnException(aExceptionClass: TClass; const aExceptionMessage: string);
|
|
begin
|
|
if Assigned(OnException) then
|
|
OnException(self, aExceptionClass, aExceptionMessage);
|
|
end;
|
|
|
|
{ TROEmailServerThread }
|
|
|
|
constructor TROEmailServerThread.Create(aOwner:TROCustomEmailServer);
|
|
begin
|
|
inherited Create('RemObjects Email Server Worker Thread',aOwner,aOwner.Pop3CheckInterval);
|
|
end;
|
|
|
|
procedure TROEmailServerThread.CheckForMessages;
|
|
var
|
|
i,j:integer;
|
|
lMessage:TIdMessage;
|
|
lAttachment:TIdAttachment;
|
|
lTempFile:string;
|
|
lFileStream:TFileStream;
|
|
lRequest:TMemoryStream;
|
|
lMessageID:string;
|
|
lOwner:TROCustomEmailServer;
|
|
begin
|
|
if Terminated then Exit;
|
|
try
|
|
|
|
lOwner := Owner as TROCustomEmailServer;
|
|
|
|
lOwner.Pop3Client.Connect();
|
|
try
|
|
for i := 1 to lOwner.Pop3Client.CheckMessages do begin
|
|
lMessage := TIdMessage.Create(lOwner.Pop3Client);
|
|
try
|
|
if lOwner.Pop3Client.RetrieveHeader(i,lMessage) then begin
|
|
if Pos(REQUEST_MESSAGE_PREFIX+' ',lMessage.Subject) = 1 then begin
|
|
|
|
lMessageID := lMessage.Subject;
|
|
Delete(lMessageID,1,Length(REQUEST_MESSAGE_PREFIX)+1);
|
|
|
|
lOwner.Pop3Client.Retrieve(i,lMessage);
|
|
for j := 0 to lMessage.MessageParts.Count-1 do begin
|
|
|
|
if (lMessage.MessageParts[j] is TIdAttachment) then begin
|
|
|
|
lAttachment := TIdAttachment(lMessage.MessageParts[j]);
|
|
if lAttachment.Filename = lMessageID+MESSAGE_FILE_EXTENSION then begin
|
|
|
|
lRequest := TMemoryStream.Create();
|
|
try
|
|
|
|
lTempFile := GetTempPath+lAttachment.Filename;
|
|
lAttachment.SaveToFile(lTempFile);
|
|
try
|
|
lFileStream := TFileStream.Create(lTempFile,fmOpenRead);
|
|
try
|
|
lRequest.CopyFrom(lFileStream,lFileStream.Size);
|
|
finally
|
|
lFileStream.Free();
|
|
end;
|
|
finally
|
|
DeleteFile(lTempFile);
|
|
end;
|
|
ProcessMessage(lRequest,lMessageID,lMessage.From.Address);
|
|
|
|
finally
|
|
//lRequest will be freed by worker thread.
|
|
end;
|
|
|
|
lOwner.Pop3Client.Delete(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
FreeAndNil(lMessage);
|
|
end;
|
|
end;
|
|
finally
|
|
lOwner.Pop3Client.Disconnect();
|
|
end;
|
|
|
|
except
|
|
on E:Exception do begin
|
|
Sync_TriggerOnException(E.ClassType, E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROEmailServerThread.ProcessMessage(aRequest: TStream; const aMessageID, aFrom: string);
|
|
begin
|
|
TROEmailServerProcessMessageThread.Create(Owner as TROCustomEmailServer, aRequest, aMessageID, aFrom);
|
|
end;
|
|
|
|
procedure TROEmailServerThread.Sync_TriggerOnException(aExceptionClass:TClass; const aExceptionMessage:string);
|
|
begin
|
|
if Terminated then exit;
|
|
fSync_ExceptionClass := aExceptionClass;
|
|
fSync_aExceptionMessage := aExceptionMessage;
|
|
Synchronize(Synced_TriggerOnException);
|
|
end;
|
|
|
|
procedure TROEmailServerThread.Synced_TriggerOnException;
|
|
begin
|
|
(Owner as TROCustomEmailServer).TriggerOnException(fSync_ExceptionClass,fSync_aExceptionMessage);
|
|
end;
|
|
|
|
{ TROEmailServerProcessMessageThread }
|
|
|
|
constructor TROEmailServerProcessMessageThread.Create(aOwner: TROCustomEmailServer; aRequest: TStream; const aMessageID, aFrom: string);
|
|
begin
|
|
inherited Create(true,'TROEmailServer Message Processing Thread');
|
|
fOwner := aOwner;
|
|
fRequest := aRequest;
|
|
fMessageID := aMessageID;
|
|
fFrom := aFrom;
|
|
FreeOnTerminate := true;
|
|
Resume();
|
|
end;
|
|
|
|
destructor TROEmailServerProcessMessageThread.Destroy;
|
|
begin
|
|
FreeAndNil(fRequest);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROEmailServerProcessMessageThread.Execute;
|
|
var
|
|
lResponse:TStream;
|
|
lResponseOptions:TROResponseOptions;
|
|
begin
|
|
inherited;
|
|
|
|
lResponse := TMemoryStream.Create();
|
|
try
|
|
fOwner.DispatchMessage(fOwner, fRequest, lResponse, lResponseOptions);
|
|
if not (roNoResponse in lResponseOptions) then begin
|
|
uROIndyEmail.SendMessage(fOwner.SmtpClient, lResponse, RESPONSE_MESSAGE_PREFIX, fMessageID, fOwner.ServerEmail, fFrom);
|
|
end;
|
|
finally
|
|
lResponse.Free();
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterServerClass(TROEmailServer);
|
|
finalization
|
|
UnregisterServerClass(TROEmailServer);
|
|
end.
|