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.