Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROIndyTCPServer.pas

unit uROIndyTCPServer;

{----------------------------------------------------------------------------}
{ 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}

{TODO: Do like in the webmodule. Save a pointer to the user's OnExecute and fire it }

interface

uses
  {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
  {$IFDEF RemObjects_INDY10}IdContext, {$ELSE} IdThreadMgr,{$ENDIF}
  Classes, uROServer, uROClientIntf, IdTCPServer, IdComponent, IdSocketHandle, IdIntercept;

type
  {$IFDEF RemObjects_INDY10}
  TIdThreadClass = TIdContext;
  {$ELSE}
  TIdThreadClass = TIdPeerThread;
  {$ENDIF}

  { TIndyTCPConnectionTransport }
  TIndyTCPConnectionTransport = class(TInterfacedObject, IROTransport, IROTCPTransport)
  private
    fThread: TIdThreadClass;

  protected
    { IROTransport }
    function GetTransportObject : TObject;
    function GetClientAddress : string;

  public
    constructor Create(aThread: TIdThreadClass);

    property Thread : TIdThreadClass read fThread;
  end;

  { TROTIdTCPServer }
  TROTIdTCPServer = class(TIdTCPServer)
  private
    function GetActive: boolean;

  public
    procedure IndySetActive(Value : boolean);

  published
    property Active : boolean read GetActive;
  end;

  { TROIndyTCPServer }
  TROCustomIndyTCPServer = class(TROServer, IROTransport)
  private
    fIndyServer : TComponent;
    fKeepAlive: boolean;
    fDisableNagle: boolean;


  protected
    function GetIndyServer : TROTIdTCPServer;
    function GetPort: Integer;
    procedure SetPort(const Value: Integer);

    function GetKeepAlive: boolean; virtual;
    procedure SetKeepAlive(const Value: boolean); virtual;

    function GetDisableNagle: boolean; virtual;
    procedure SetDisableNagle(const Value: boolean); virtual;

    function CreateIndyServer : TComponent; virtual;
    procedure IntSetActive(const Value: boolean); override;
    function IntGetActive : boolean; override;

    procedure InternalOnExecute(AThread: TIdThreadClass);

    { IROTransport }
    function GetTransportObject : TObject;

  public
    constructor Create(aComponent : TComponent); override;

    property IndyServer: TROTIdTCPServer read GetIndyServer;
    property Port:Integer read GetPort write SetPort;
    property DisableNagle : boolean read GetDisableNagle write SetDisableNagle default FALSE;
    property KeepAlive : boolean read GetKeepAlive write SetKeepAlive default false;
  end;

  { TROIndyTCPServer }
  TROIndyTCPServer = class(TROCustomIndyTCPServer, IROTransport)
  published
    property IndyServer;
    property Port;
    property DisableNagle;
    property KeepAlive;
  end;

implementation

uses SysUtils, uRORes,
     {$IFNDEF RemObjects_INDY8}IdIoHandlerSocket,{$ENDIF}
     {$IFDEF RemObjects_INDY10}IdStreamVCL,{$ENDIF}
     IdTCPConnection, idstackconsts;

{ TROCustomIndyTCPServer }

constructor TROCustomIndyTCPServer.Create(aComponent: TComponent);
begin
  inherited;

  fIndyServer := CreateIndyServer;
  fIndyServer.Name := 'InternalIndyServer';
  {$IFDEF DELPHI6UP}
  fIndyServer.SetSubComponent(True);
  {$ENDIF}
end;

function TROCustomIndyTCPServer.CreateIndyServer: TComponent;
begin
  result := TROTIdTCPServer.Create(Self);
  TROTIdTCPServer(result).OnExecute := InternalOnExecute;
  TROTIdTCPServer(result).DefaultPort := 8090;
end;

function TROCustomIndyTCPServer.GetIndyServer: TROTIdTCPServer;
begin
  result := TROTIdTCPServer(fIndyServer)
end;

procedure TROCustomIndyTCPServer.IntSetActive(const Value: boolean);
begin
  IndyServer.IndySetActive(Value);
  if not Value
    then IndyServer.Bindings.Clear;
end;

function TROCustomIndyTCPServer.IntGetActive : boolean;
begin
  result := IndyServer.Active
end;

procedure TROCustomIndyTCPServer.InternalOnExecute(AThread: TIdThreadClass);
var
  req, resp : TMemoryStream;
  tcptransport : IROTCPTransport;
  {$IFDEF RemObjects_INDY10A}
  lStream: TIdStreamVCL;
  {$ENDIF}
begin
  req := TMemoryStream.Create;
  resp := TMemoryStream.Create;

  tcptransport := TIndyTCPConnectionTransport.Create(aThread);

  try
    with AThread do begin
      while AThread.Connection.Connected do
      begin
        if DisableNagle then begin
          {$IFDEF RemObjects_INDY8}
          Connection.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True),  SizeOf(Id_SO_True));
          {$ELSE}
            {$IFDEF RemObjects_INDY9}
            (Connection.IoHandler as TIdIoHandlerSocket).Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True),  SizeOf(Id_SO_True));
            {$ELSE}
            (Connection.IoHandler as TIdIoHandlerSocket).Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, Id_SO_True);
            {$ENDIF}
          {$ENDIF}
        end;

        {$IFDEF RemObjects_INDY10A}
          lStream := TIdStreamVCL.Create(req, false);
          try
            Connection.IOHandler.ReadStream(lStream);
          finally
            FreeAndNil(lStream);
          end;
          req.Position := 0;
          DispatchMessage(tcptransport, req, resp);
          lStream := TIdStreamVCL.Create(resp, false);
          try
            Connection.IOHandler.Write(lStream, lStream.Size, TRUE);
          finally
            FreeAndNil(lStream);
          end;

        {$ELSE}
          {$IFDEF RemObjects_INDY10B}
            Connection.IOHandler.ReadStream(req);
            req.Position := 0;
            DispatchMessage(tcptransport, req, resp);
            Connection.IOHandler.Write(resp, resp.Size, TRUE);
          {$ELSE}
            Connection.ReadStream(req);
            req.Position := 0;
            DispatchMessage(tcptransport, req, resp);
            Connection.WriteStream(resp, TRUE, TRUE);
          {$ENDIF}
        {$ENDIF}

        if not KeepAlive
          then Connection.Disconnect
        else
        begin
          resp.Position := 0;
          req.Position := 0;
          resp.Size := 0;
          req.Size := 0;
        end;
      end;
    end;
  finally
    req.Free;
    resp.Free;
  end;
end;

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

function TROCustomIndyTCPServer.GetPort: Integer;
begin
  Result := IndyServer.DefaultPort;
end;

procedure TROCustomIndyTCPServer.SetPort(const Value:Integer);
begin
  IndyServer.DefaultPort := Value;
end;

function TROCustomIndyTCPServer.GetKeepAlive: boolean;
begin
  result := fKeepAlive
end;

procedure TROCustomIndyTCPServer.SetKeepAlive(const Value: boolean);
begin
  fKeepAlive := Value
end;

function TROCustomIndyTCPServer.GetDisableNagle: boolean;
begin
  result := fDisableNagle
end;

procedure TROCustomIndyTCPServer.SetDisableNagle(const Value: boolean);
begin
  fDisableNagle := Value
end;

{ TROTIdTCPServer }

function TROTIdTCPServer.GetActive: boolean;
begin
  result := inherited Active;
end;

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

{ TIndyTCPConnectionTransport }

constructor TIndyTCPConnectionTransport.Create(aThread: TIdThreadClass);
begin
  inherited Create;
  fThread := aThread;
end;

function TIndyTCPConnectionTransport.GetClientAddress: string;
begin
  {$IFDEF RemObjects_INDY8}
  result := fThread.Connection.Binding.PeerIP
  {$ELSE}
  result := fThread.Connection.Socket.Binding.PeerIP
  {$ENDIF}
end;

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

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