Componentes.Terceros.RemObjects/internal/5.0.30.691/1/RemObjects SDK for Delphi/Source/uROSynapseSuperHttpChannel.pas

unit uROSynapseSuperHttpChannel;

{----------------------------------------------------------------------------}
{ 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, SysUtils, uROClient, uROClientIntf, uROAsync, uROClasses, SyncObjs,
  {$IFDEF RemObjects_UseEncryption} uROEncryption, {$ENDIF}uROThreadPool,
  httpsend, uROBaseSuperHttpChannel, synsock;

type
  TROSynapseSuperHttpChannel  = class(TROBaseSuperHttpChannel)
  private
    fClientWait,
    fClientRequest: THTTPSend;
    fDisableNagle: Boolean;
    fTargetUrl: String;
    procedure SocketOnAfterConnectRequest(Sender: TObject);
    procedure SocketOnAfterConnectWait(Sender: TObject);
  protected
  { IROHTTPTransport }
    function GetClientAddress : string; override;
    procedure SetHeaders(const aName, aValue : string); override;
    function GetHeaders(const aName : string) : string; override;
    function GetContentType : string; override;
    procedure SetContentType(const aValue : string); override;
    function GetUserAgent : string; override;
    procedure SetUserAgent(const aValue : string); override;
    function GetTargetURL : string; override;
    procedure SetTargetURL(const aValue : string); override;
    procedure SetPathInfo (const aValue : string); override;
    function GetPathInfo : string; override;
    function GetQueryString : string; override;
    function GetLocation : string; override;
    function GetQueryParameter(const aName: string): string; override;
  protected
    procedure CancelRequest(aWaitingThread: Boolean); override;
    procedure DispatchHttpRequest(aWaitingThread: Boolean;
      aRequest: TDynByteArray; out aResponse: TDynByteArray); override;
  public
    constructor Create(aOwner: TCOmponent); override;
    destructor Destroy; override;

    property ClientWait: THTTPSend read fClientWait;
    property ClientRequest: THTTPSend read fClientRequest;
    {$IFDEF FPC}
    property SessionId;
    {$ENDIF}
  published
    {$IFNDEF FPC}
    property SessionId;
    {$ENDIF}    
    property Active;
    property MaxPackageSize;
    property TargetUrl: String read fTargetUrl write fTargetUrl;
    property RequestTimeout;
    property ConnectTimeout;
    property HttpRequestTimeout;

    property DispatchOptions;
    property ServerLocators;
    property OnServerLocatorAssignment;
    property DisableNagle: Boolean read fDisableNagle write fDisableNagle default true;
  end;

implementation
uses
  uRORes;

{ TROSynapseSuperHttpChannel  }

procedure TROSynapseSuperHttpChannel.CancelRequest(aWaitingThread: Boolean);
var
  lSock: THTTPSend;
begin
  try
    if aWaitingThread then lSock := fClientWait else lSock := fClientRequest;
    lSock.Abort;
    if lSock.Sock <> nil then
      lSock.Sock.CloseSocket;
  except
    // indy will release an exception when closing
  end;
end;

constructor TROSynapseSuperHttpChannel.Create(aOwner: TCOmponent);
begin
  inherited Create(aOwner);
  fDisableNagle := true;

  fClientWait := THttpSend.Create;
  fClientWait.UserAgent := str_ProductName;
  fClientWait.Protocol := '1.1';
  fClientWait.Status100 := False;
  fClientWait.Sock.OnAfterConnect := SocketOnAfterConnectWait;


  fClientRequest := THTTPSend.Create;
  fClientRequest.UserAgent := str_ProductName;
  fClientRequest.Protocol := '1.1';
  fClientRequest.Status100 := False;
  fClientRequest.Sock.OnAfterConnect := SocketOnAfterConnectRequest;

end;

procedure TROSynapseSuperHttpChannel.SocketOnAfterConnectWait(Sender: TObject);
var
  lTmpVal: Integer;
begin
  if fDisableNagle then begin
    lTmpVal := 1;
    SetSockOpt(fClientWait.Sock.Socket, 6, 1, @lTmpVal, 4);
  end;
end;

procedure TROSynapseSuperHttpChannel.SocketOnAfterConnectRequest(Sender: TObject);
var
  lTmpVal: Integer;
begin
  if fDisableNagle then begin
    lTmpVal := 1;
    SetSockOpt(fClientRequest.Sock.Socket, 6, 1, @lTmpVal, 4);
  end;
end;

destructor TROSynapseSuperHttpChannel.Destroy;
begin
  Active := false;
  fClientWait.Free;
  fClientRequest.Free;
  inherited Destroy;
end;

procedure TROSynapseSuperHttpChannel.DispatchHttpRequest(
  aWaitingThread: Boolean; aRequest: TDynByteArray;
  out aResponse: TDynByteArray);
var
  lClient: THTTPSend;
begin
  if aWaitingThread then lClient := fClientWait else lClient := fClientRequest;
  lClient.Headers.Clear;
  lClient.Document.Position := 0;
  lClient.Document.Size := 0;
  lClient.Document.Write(aRequest[0], Length(aRequest));
  if lClient.KeepAlive then
    lClient.Headers.Add('Connection: keep-alive');
  if not lClient.HTTPMethod('POST', fTargetUrl) then
    raise EROException.Create('Unable to connect to remote server');
  SetLength(aResponse, lClient.Document.Size);
  lClient.Document.Position := 0;
  lClient.Document.Read(aResponse[0], length(aResponse));
end;

function TROSynapseSuperHttpChannel.GetClientAddress: string;
begin
  result := '';
end;

function TROSynapseSuperHttpChannel.GetContentType: string;
begin
  Result := ClientRequest.MimeType;
end;

function TROSynapseSuperHttpChannel.GetHeaders(
  const aName: string): string;
begin
  Result := ClientRequest.Headers.Values[aName];
end;

function TROSynapseSuperHttpChannel.GetLocation: string;
begin
  result := '';
end;

function TROSynapseSuperHttpChannel.GetPathInfo: string;
begin
  result := '';
end;

function TROSynapseSuperHttpChannel.GetQueryParameter(
  const aName: string): string;
begin
  result := '';
end;

function TROSynapseSuperHttpChannel.GetQueryString: string;
begin
  result := '';
end;

function TROSynapseSuperHttpChannel.GetTargetURL: string;
begin
  result := fTargetURL;
end;

function TROSynapseSuperHttpChannel.GetUserAgent: string;
begin
  Result := ClientRequest.UserAgent;
end;

procedure TROSynapseSuperHttpChannel.SetContentType(const aValue: string);
begin
  ClientWait.MimeType := aValue;
  ClientRequest.MimeType := aValue;  
end;

procedure TROSynapseSuperHttpChannel.SetHeaders(const aName,
  aValue: string);
begin
  ClientWait.Headers.Values[aName] := aValue;
  ClientRequest.Headers.Values[aName] := aValue;
end;

procedure TROSynapseSuperHttpChannel.SetPathInfo(const aValue: string);
begin
  // Do nothing; server only
end;

procedure TROSynapseSuperHttpChannel.SetTargetURL(const aValue: string);
begin
  fTargetURL := Trim(aValue)
end;

procedure TROSynapseSuperHttpChannel.SetUserAgent(const aValue: string);
begin
  ClientWait.UserAgent := aValue;
  ClientRequest.UserAgent := aValue;  
end;

end.