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

unit uROBPDXTCPServer;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ 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, uROServer, uROClientIntf,
     {$IFDEF RemObjects_USE_RODX}
     uRODXString, uRODXSock, uRODXServerCore;
     {$ELSE}
     DXString, DXSock, DXServerCore;
     {$ENDIF}

type
  { TROBPDXTCPTransport }
  TROBPDXTCPTransport = class(TInterfacedObject, IROTransport, IROTCPTransport)
  private
    fClientThread: TDXClientThread;

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

  public
    constructor Create(aClientThread: TDXClientThread);

    property ClientThread: TDXClientThread read fClientThread;
  end;

  { TROBPDXTCPServer }
  TROBPDXTCPServer = class(TROServer)
  private
    fBPDXServer: TDXServerCore;
    function GetPort: integer;
    procedure SetPort(const Value: integer);

  protected
    function CreateBPDXServer : TDXServerCore; virtual;
    procedure IntSetActive(const Value: boolean); override;
    function IntGetActive : boolean; override;

    procedure InternalOnNewConnect(ClientThread:TDXClientThread);

  public
    constructor Create(aComponent: TComponent); override;
    destructor Destroy; override;

  published
    property BPDXServer: TDXServerCore read fBPDXServer;
    property Port:integer read GetPort write SetPort;
  end;

implementation

uses SysUtils,
     uRORes;


{ TROBPDXTCPTransport }

constructor TROBPDXTCPTransport.Create(aClientThread: TDXClientThread);
begin
  inherited Create;
  fClientThread := aClientThread;
end;

function TROBPDXTCPTransport.GetClientAddress: string;
begin
  result := fClientThread.Socket.PeerIPAddress;
end;

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

{ TROBPDXTCPServer }

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

  fBPDXServer := CreateBPDXServer;
  fBPDXServer.Name := 'InternalBPDXServer';
  {$IFDEF DELPHI6UP}
  fBPDXServer.SetSubComponent(True);
  {$ENDIF}
end;

function TROBPDXTCPServer.CreateBPDXServer: TDXServerCore;
begin
  //DXSock.TDXXferTimeout := 100;
  result:=TDXServerCore.Create(Self);
  result.ServerPort:=8090;
  result.BindTo:=''; // blank = ALL IP's!
  result.ThreadCacheSize := 10;
  result.OnNewConnect:=InternalOnNewConnect; // accept new connections

  // Optimized settings
  {$IFNDEF LINUX}
  result.ListenerThreadPriority := tpIdle;
  result.SocketOutputBufferSize := bsfNormal;
  result.SpawnedThreadPriority := tpIdle;
  {$ENDIF LINUX}
  result.UseThreadPool := FALSE;
end;

destructor TROBPDXTCPServer.Destroy;
begin
  fBPDXServer.Stop; // terminate all sessions!
  fBPDXServer.Free;

  inherited;
end;

procedure TROBPDXTCPServer.InternalOnNewConnect(
  ClientThread: TDXClientThread);
var req:TMemoryStream;
    resp:TMemoryStream;
    transport : IROTCPTransport;
begin
  req:=TMemoryStream.Create;
  resp:=TMemoryStream.Create;
  try
    ClientThread.Socket.SetNagle(true);
    // this is the same as INDY, will read a stream for the 4 byte length header
    // or fatal socket error
    // or time out of 120,000ms (2 minutes).
    ClientThread.Socket.SaveToStreamWithSize(req,120000);

    //If ClientThread.Socket.DroppedConnection then Exit; BIG BOTTLENECK!

    transport := TROBPDXTCPTransport.Create(ClientThread);
    req.Position := 0;
    DispatchMessage(transport, req, resp);
    //ProcessMessage(MessageIntf, transport, req, resp);

    resp.Seek(0,0); // A MUST!
    
    ClientThread.Socket.WriteInteger(resp.Size);
    ClientThread.Socket.Write(resp.Memory, resp.Size);
  finally
    resp.Free;
    req.Free;
  end;
end;

function TROBPDXTCPServer.IntGetActive: boolean;
begin
  result := fBPDXServer.IsActive and not fBPDXServer.Suspend
end;

procedure TROBPDXTCPServer.IntSetActive(const Value: boolean);
begin
  if Value then begin
    if not fBPDXServer.IsActive then fBPDXServer.Start
    else if fBPDXServer.Suspend then fBPDXServer.Resume;
  end
  else fBPDXServer.Pause
end;

procedure TROBPDXTCPServer.SetPort(const Value:integer);
begin
  BPDXServer.ServerPort := Value;
end;

function TROBPDXTCPServer.GetPort: integer;
begin
  Result := BPDXServer.ServerPort;
end;

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