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
320 lines
10 KiB
ObjectPascal
320 lines
10 KiB
ObjectPascal
unit uROIndyEmailChannel;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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,
|
|
{$IFDEF RemObjects_INDY10} IdAttachment, {$ENDIF}
|
|
uROClient, uROClientIntf, uROAsync, IdSMTP, IdPOP3;
|
|
|
|
type
|
|
TROCustomEmailChannel = class(TROTransportChannel, IROTransport, IROAsyncTransportChannel)
|
|
private
|
|
fClientEmail: string;
|
|
fServerEmail: string;
|
|
fSmtpClient: TIdSMTP;
|
|
fPop3Client: TIdPOP3;
|
|
fDeleteOldResponses: boolean;
|
|
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);
|
|
function GetPop3Password: string;
|
|
function GetPop3username: string;
|
|
procedure SetPop3password(const Value: string);
|
|
procedure SetPop3Username(const Value: string);
|
|
protected
|
|
{ IROTransport }
|
|
function GetTransportObject: TObject; override;
|
|
|
|
{ IROAsyncTransport }
|
|
function CheckStatus(const iMessageID:string):Boolean;
|
|
function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string;
|
|
procedure RetrieveResponse(const aMessageID:string; aResponse:TStream);
|
|
|
|
procedure IntDispatch(aRequest, aResponse : TStream); override;
|
|
|
|
public
|
|
constructor Create(aOwner:TComponent); override;
|
|
destructor Destroy; 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 ClientEmail:string read fClientEmail write fClientEmail;
|
|
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 DeleteOldResponses:boolean read fDeleteOldResponses write fDeleteOldResponses default false;
|
|
procedure CheckProperties; override;
|
|
end;
|
|
|
|
TROEmailChannel = class(TROCustomEmailChannel)
|
|
published
|
|
property Pop3ServerAddress;
|
|
property SmtpServerAddress;
|
|
property ServerEmail;
|
|
property ClientEmail;
|
|
property SmtpClient;
|
|
property Pop3Client;
|
|
property Pop3Username;
|
|
property Pop3Password;
|
|
property DeleteOldResponses;
|
|
published
|
|
property SynchronizedProbing;
|
|
property OnSendStream;
|
|
property OnReceiveStream;
|
|
property ServerLocators;
|
|
property DispatchOptions;
|
|
property OnServerLocatorAssignment;
|
|
property ProbeServers;
|
|
property ProbeFrequency;
|
|
property OnBeforeProbingServers;
|
|
property OnAfterProbingServers;
|
|
property OnBeforeProbingServer;
|
|
property OnAfterProbingServer;
|
|
property OnLoginNeeded;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DELPHI5}Windows,{$ENDIF}
|
|
SysUtils, IdMessage, uROClasses, {$IFDEF RemObjects_INDY9}IdMessageCoder,{$ENDIF}
|
|
uROIndyEmail;
|
|
|
|
{ TROCustomEmailChannel }
|
|
|
|
constructor TROCustomEmailChannel.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fSmtpClient := TIdSMTP.Create(self);
|
|
fSmtpClient.Name := 'InternalSmtpClient';
|
|
fPop3Client := TIdPOP3.Create(self);
|
|
fPop3Client.Name := 'InternalPop3Client';
|
|
{$IFDEF VER140UP}
|
|
fSmtpClient.SetSubComponent(true);
|
|
fPop3Client.SetSubComponent(true);
|
|
{$ENDIF VER140UP}
|
|
end;
|
|
|
|
destructor TROCustomEmailChannel.Destroy;
|
|
begin
|
|
FreeAndNil(fSmtpClient);
|
|
FreeAndNil(fPop3Client);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TROCustomEmailChannel.GetTransportObject: TObject;
|
|
begin
|
|
result := self;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetSmtpClient(const Value: TIdSMTP);
|
|
begin
|
|
fSmtpClient.Assign(Value);
|
|
end;
|
|
|
|
function TROCustomEmailChannel.GetSmtpServerAddress: string;
|
|
begin
|
|
result := fSmtpClient.Host;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetSmtpServerAddress(const Value: string);
|
|
begin
|
|
fSmtpClient.Host := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetPopClient(const Value: TIdPOP3);
|
|
begin
|
|
fPop3Client.Assign(Value);
|
|
end;
|
|
|
|
function TROCustomEmailChannel.GetPop3Password: string;
|
|
begin
|
|
result := fPop3Client.Password;
|
|
end;
|
|
|
|
function TROCustomEmailChannel.GetPop3ServerAddress: string;
|
|
begin
|
|
result := fPop3Client.Host;
|
|
end;
|
|
|
|
function TROCustomEmailChannel.GetPop3username: string;
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
result := fPop3Client.UserId;
|
|
{$ELSE}
|
|
result := fPop3Client.Username;
|
|
{$ENDIF RemObjects_INDY8}
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetPop3password(const Value: string);
|
|
begin
|
|
fPop3Client.Password := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetPop3ServerAddress(const Value: string);
|
|
begin
|
|
fPop3Client.Host := Value;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.SetPop3Username(const Value: string);
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
fPop3Client.UserId := Value;
|
|
{$ELSE}
|
|
fPop3Client.Username := Value;
|
|
{$ENDIF RemObjects_INDY8}
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.IntDispatch(aRequest, aResponse: TStream);
|
|
var
|
|
lMessageID:string;
|
|
begin
|
|
lMessageID := InvokeRequest(aRequest);
|
|
while not CheckStatus(lMessageID) do Sleep(1000); //ToDo: this is a lame workaround to get synchronous requests running now.
|
|
RetrieveResponse(lMessageID,aResponse);
|
|
end;
|
|
|
|
function TROCustomEmailChannel.InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string;
|
|
begin
|
|
CheckProperties;
|
|
try
|
|
result := NewGuidAsString();
|
|
uROIndyEmail.SendMessage(fSmtpClient,aRequest,REQUEST_MESSAGE_PREFIX,result,ClientEmail,ServerEmail);
|
|
finally
|
|
aRequest.Free();
|
|
end;
|
|
end;
|
|
|
|
function TROCustomEmailChannel.CheckStatus(const iMessageID:string):Boolean;
|
|
var
|
|
i:integer;
|
|
lMessage:TIdMessage;
|
|
begin
|
|
CheckProperties;
|
|
result := false;
|
|
fPop3Client.Connect();
|
|
try
|
|
for i := 1 to fPop3Client.CheckMessages do begin
|
|
lMessage := TIdMessage.Create(fPop3Client);
|
|
try
|
|
if fPop3Client.RetrieveHeader(i,lMessage) and
|
|
(lMessage.Subject = RESPONSE_MESSAGE_PREFIX+' '+iMessageID) then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
finally
|
|
FreeAndNil(lMessage);
|
|
end;
|
|
end;
|
|
finally
|
|
fPop3Client.Disconnect();
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.RetrieveResponse(const aMessageID:string; aResponse:TStream);
|
|
var
|
|
i,j:integer;
|
|
lMessage:TIdMessage;
|
|
lAttachment:TIdAttachment;
|
|
lTempFile:string;
|
|
lFileStream:TFileStream;
|
|
lSuccess:boolean;
|
|
begin
|
|
lSuccess := false;
|
|
CheckProperties;
|
|
fPop3Client.Connect();
|
|
try
|
|
for i := 1 to fPop3Client.CheckMessages do begin
|
|
lMessage := TIdMessage.Create(fPop3Client);
|
|
try
|
|
if fPop3Client.RetrieveHeader(i,lMessage) then begin
|
|
if (lMessage.Subject = RESPONSE_MESSAGE_PREFIX+' '+aMessageID) then begin
|
|
|
|
fPop3Client.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 = aMessageID+MESSAGE_FILE_EXTENSION then begin
|
|
lTempFile := GetTempPath+lAttachment.Filename;
|
|
lAttachment.SaveToFile(lTempFile);
|
|
try
|
|
lFileStream := TFileStream.Create(lTempFile,fmOpenRead);
|
|
try
|
|
aResponse.CopyFrom(lFileStream,lFileStream.Size);
|
|
finally
|
|
lFileStream.Free();
|
|
end;
|
|
finally
|
|
DeleteFile(lTempFile);
|
|
end;
|
|
lSuccess := true;
|
|
|
|
fPop3Client.Delete(i);
|
|
if not DeleteOldResponses then exit;
|
|
end;
|
|
if not lSuccess then RaiseError('Invalid Response email found for this communication: No response message attachment.');
|
|
end;
|
|
end;
|
|
|
|
end
|
|
else if DeleteOldResponses and (Pos(RESPONSE_MESSAGE_PREFIX+' ', lMessage.Subject) = 1) then begin
|
|
fPop3Client.Delete(i);
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
FreeAndNil(lMessage);
|
|
end;
|
|
end;
|
|
finally
|
|
fPop3Client.Disconnect();
|
|
end;
|
|
|
|
if not lSuccess then
|
|
raise EROAsyncNoAnswerYet.Create('No Response email found for this communication, yet.');
|
|
end;
|
|
|
|
procedure TROCustomEmailChannel.CheckProperties;
|
|
begin
|
|
inherited;
|
|
Check(Pop3ServerAddress = '', Name + '.Pop3ServerAddress must be set.');
|
|
Check(SmtpServerAddress = '', Name + '.SmtpServerAddress must be set.');
|
|
Check(ServerEmail = '', Name + '.ServerEmail must be set.');
|
|
Check(ClientEmail = '', Name + '.ClientEmail must be set.');
|
|
Check(Pop3Username = '', Name + '.Pop3Username must be set.');
|
|
Check(Pop3Password = '', Name + '.Pop3Password must be set.');
|
|
end;
|
|
|
|
initialization
|
|
RegisterTransportChannelClass(TROEmailChannel);
|
|
|
|
finalization
|
|
UnRegisterTransportChannelClass(TROEmailChannel);
|
|
|
|
end.
|