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.