unit uROIndyUDPServer;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Indy Components                                   }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Provided by Nico Schoemaker (nico.schoemaker@teamro.remobjects.com         }
{                                                                            }
{ 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,SysUtils,
  IdUDPServer, IdSocketHandle, IdGlobal,
  uROServer, uROClasses, uROClientIntf;


type


  TROIndyUDPServer = class;

  TROIndyUDPTransport = class(TInterfacedObject, IROTransport, IROTCPTransport)
  private
    FBinding: TIdSocketHandle;
    FServer: TROIndyUDPServer;
  protected
    function GetTransportObject : TObject;
    function GetClientAddress : string;
  public
    property Binding: TIdSocketHandle read FBinding;
    property Server: TROIndyUDPServer read FServer;

    constructor Create(aServer: TROIndyUDPServer;aBinding: TIdSocketHandle);
  end;

  TROIndyUDPTransportclass = class of TROIndyUDPTransport;

  TXPIdUDPServer = class(TIdUDPServer)
  private
    function GetActive: boolean; reintroduce;
  public
    procedure IndySetActive(Value : boolean);
  published
    property Active : boolean read GetActive;
  end;

  TROIndyUDPServer = class(TROServer, IROTransport)
  private
    FUDPSvr: TIdUDPServer;
    FIDSize: Integer;

    function GetIndyUDPServer: TXPIdUDPServer;
    function GetPort: integer;
    procedure SetPort(const Value: integer);
  protected
    function GetMessageID(aStream: TStream): String;
    function FormatDispStream(aStream: TStream): TMemoryStream;

    { TROServer }
    procedure IntSetActive(const Value: boolean);override;
    function  IntGetActive : boolean;override;

    { IROTransport }
    function GetTransportObject : TObject;

    {$IFDEF RemObjects_INDY10}
    procedure InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); virtual;
    {$ELSE}
    procedure InternalUDPRead(Sender: TObject;AData: TStream;ABinding: TIdSocketHandle); virtual;
    {$ENDIF}
    function  CreateUDPServer: TXPIdUDPServer;virtual;

    function  GetTransportClass: TROIndyUDPTransportClass;virtual;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
  published
    property IndyUDPServer: TXPIdUDPServer read GetIndyUDPServer;
    property Port : integer read GetPort write SetPort;
  end;

implementation

{ TROIndyUDPServer }

constructor TROIndyUDPServer.Create(AOwner: TComponent);
begin
  inherited;
  FUDPSvr := CreateUDPServer;
  {$IFDEF DELPHI6UP}
  FUDPSvr.SetSubComponent(TRUE);
  {$ENDIF}
end;

function TROIndyUDPServer.CreateUDPServer: TXPIdUDPServer;
begin
  result := TXPIdUDPServer.Create(Self);
  result.OnUDPRead := InternalUDPRead;
  result.Name := 'InternalIndyServer';
  result.DefaultPort := 8090;
  // In case the result of NewGuidAsString change's in the future
  FIDSize := Length(NewGuidAsString);
end;

destructor TROIndyUDPServer.Destroy;
begin
  inherited;
end;

function TROIndyUDPServer.GetIndyUDPServer: TXPIdUDPServer;
begin
 result := TXPIdUDPServer(FUDPSvr);
end;
function TROIndyUDPServer.GetPort: integer;
begin
  Result := IndyUDPServer.DefaultPort;
end;

procedure TROIndyUDPServer.SetPort(const Value: integer);
begin
  IndyUDPServer.DefaultPort := Value; 
end;

function TROIndyUDPServer.GetTransportClass: TROIndyUDPTransportClass;
begin
  result := TROIndyUDPTransport;
end;

function TROIndyUDPServer.GetTransportObject: TObject;
begin
  result := Self;
end;

{$IFDEF RemObjects_INDY10}
procedure TROIndyUDPServer.InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
{$ELSE}
procedure TROIndyUDPServer.InternalUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
{$ENDIF}
var lResp: TStringStream;
    lReq: TMemoryStream;
    lRespS: String;
    lTransport: IROTCPTransport;
    lMesgID: String;
    lStream: TStream;
begin
  lResp := TStringStream.Create('');
  lReq := nil;
  try
    {$IFDEF RemObjects_INDY10}
    lStream := TMemoryStream.Create();
    WriteTIdBytesToStream(lStream, AData);
    lStream.Position := 0;
    try
    {$ELSE}
    lStream := AData;
    {$ENDIF}

    lMesgID := GetMessageID(lStream);
    lReq := FormatDispStream(lStream);

    if Assigned(lReq) then  // lReq becomes nil if not a valid (RO) AData Stream
    begin
      lTransport := GetTransportClass.Create(Self,ABinding);
      DispatchMessage(lTransport, lReq, lResp);
      lRespS := lMesgID+lResp.DataString;
      {$IFDEF RemObjects_INDY10}
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, ToBytes(lRespS));
      {$ELSE}
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, lRespS[1], Length(lRespS));
      {$ENDIF}
    end;

    {$IFDEF RemObjects_INDY10}
    finally
      FreeAndNil(lStream);
    end;
    {$ENDIF}

  finally
    if Assigned(lReq) then
      lReq.Free;
    lResp.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TROIndyUDPServer.GetMessageID
  Author:    Nico
  Date:      19-apr-2003
  Arguments: aStream: TStream
  Result:    String
  Extracts the included ID from the stream.
  Returns a empty string if the method is not able to extract the ID.
-----------------------------------------------------------------------------}
function TROIndyUDPServer.GetMessageID(aStream: TStream): String;
var lPos: Integer;
begin
  result := '';
  if not(Assigned(aStream)) then
    exit;
  if aStream.Size < FIDSize then
    Exit;

  lPos := aStream.Position;
  try
    aStream.Position := 0;
    SetLength(result,FIDSize);
    aStream.ReadBuffer(result[1],FIDSize);
  finally
    aStream.Position := lPos;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TROIndyUDPServer.FormatDispStream
  Author:    Nico
  Date:      19-apr-2003
  Arguments: aStream: TStream
  Result:    TStream
  Constructs the given aStream back to a dispatchable RO stream.
  This involves the removing of included ID, that is assumed to be present
  in the given stream.If the method is not able to counstruct a dispatchable
  stream the result will be nil.
-----------------------------------------------------------------------------}
function TROIndyUDPServer.FormatDispStream(aStream: TStream): TMemoryStream;
var lBuf: String;
    lPos: Integer;
begin
  result := nil;
  if not(Assigned(aStream)) then
    Exit;
  if aStream.Size < FIDSize then
    Exit;

  lPos := aStream.Position;
  // Initializa the result stream
  result := TMemoryStream.Create;
  try
    try
      TMemoryStream(result).SetSize(aStream.Size-FIDSize);

      SetLength(lBuf,aStream.Size-FIDSize);
      // Set the given stream pos on 1 byte after the prefixed ID
      aStream.Position := FIDSize;
      // Copy the contens without ID to the local buffer.
      aStream.Read(lBuf[1],aStream.Size-FIDSize);
      // Copy the contents of the buffer into the result stream
      result.Position := 0;
      result.Write(lBuf[1],aStream.Size-FIDSize);
      result.Position := 0;
    except
      // Dont return the result stream
      result.Free;
      result := nil;
      raise;
    end;
  finally
    aStream.Position := lPos;
  end;
end;

//------------------------------------------------------------------------------
                           { TXPIdUDPServer }
//------------------------------------------------------------------------------

function TXPIdUDPServer.GetActive: boolean;
begin
  result := Inherited Active;
end;

procedure TXPIdUDPServer.IndySetActive(Value: boolean);
begin
  inherited Active := Value;
end;

function TROIndyUDPServer.IntGetActive: boolean;
begin
  result := FUDPSvr.Active;
end;

procedure TROIndyUDPServer.IntSetActive(const Value: boolean);
begin
  IndyUDPServer.IndySetActive(Value);
end;

//------------------------------------------------------------------------------
                           { TROIndyUDPTransport }
//------------------------------------------------------------------------------

constructor TROIndyUDPTransport.Create(aServer: TROIndyUDPServer;aBinding: TIdSocketHandle);
begin
  FBinding := aBinding;
  FServer  := aServer;
end;

function TROIndyUDPTransport.GetClientAddress: string;
begin
  result := FBinding.PeerIP;
end;


function TROIndyUDPTransport.GetTransportObject: TObject;
begin
  result := Self;
end;

initialization
  RegisterServerClass(TROIndyUDPServer);
finalization
  UnregisterServerClass(TROIndyUDPServer);
end.