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

unit uROSynapseHTTPChannel;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ Provided by Carlo Kok (carlokok@teamro.com)                                }
{ Requires the Synapse TCP/IP Library available at http://www.ararat.cz/synapse }
{                                                                            }
{ (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
  {vcl:} Classes, uROClientIntf, uROClient, uROClasses,
  {Synapse:} httpsend;

type
  TROSynapseHTTPChannel = class(TROTransportChannel, IROTransport, IROTCPTransport, IROHTTPTransport)
  private
    fhttp: THTTPSend;
    fTargetURL: string;
    function GetKeepAlive: Boolean;
    procedure SetKeepAlive(const Value: Boolean);
  protected
    procedure IntDispatch(aRequest, aResponse: TStream); override;

    { IROTCPTransport }
    function GetClientAddress: string;

    { IROHTTPTransport }
    procedure SetHeaders(const aName, aValue: string);
    function GetHeaders(const aName: string): string;
    function GetContentType: string;
    procedure SetContentType(const aValue: string);
    function GetUserAgent: string;
    procedure SetUserAgent(const aValue: string);

    procedure SetTargetURL(const Value: string);
    function GetTargetURL: string;

    function GetQueryString : string;
    function GetPathInfo: string;
    function GetLocation: string;
    procedure SetPathInfo(const aValue: String);

  public
    property http: THTTPSend read fhttp;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckProperties; override;
  published
    property TargetURL: string read GetTargetURL write SetTargetURL;
    property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive;
  published
    property SynchronizedProbing;
    property OnSendStream;
    property OnReceiveStream;
    property ServerLocators;
    property DispatchOptions;
    property OnServerLocatorAssignment;
    property ProbeServers;
    property ProbeFrequency;
    property OnBeforeProbingServers;
    property OnAfterProbingServers;
    property OnBeforeProbingServer;
    property OnAfterProbingServer;
    property OnLoginNeeded;
  end;

implementation

uses
  {vcl:} SysUtils;

{ TROSynapseHTTPChannel }

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

procedure TROSynapseHTTPChannel.SetTargetURL(const Value: string);
begin
  fTargetURL := Trim(Value)
end;

procedure TROSynapseHTTPChannel.IntDispatch(aRequest, aResponse: TStream);
begin
  CheckProperties;
  
  fhttp.Headers.Clear;
  fhttp.Document.Position := 0;
  fhttp.Document.Size := 0;
  fhttp.Document.CopyFrom(aRequest, 0);
  if fhttp.KeepAlive then
    fhttp.Headers.Add('Connection: keep-alive');
  if not fhttp.HTTPMethod('POST', TargetURL) then
    raise EROException.Create('Unable to connect to remote server');
  aResponse.CopyFrom(http.Document, 0);
end;

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

procedure TROSynapseHTTPChannel.SetHeaders(const aName, aValue: string);
begin
  fhttp.Headers.Values[aName] := aValue;
end;

function TROSynapseHTTPChannel.GetContentType: string;
begin
  Result := fhttp.MimeType;
end;

procedure TROSynapseHTTPChannel.SetContentType(const aValue: string);
begin
  fhttp.MimeType := aValue;
end;

function TROSynapseHTTPChannel.GetUserAgent: string;
begin
  Result := fhttp.UserAgent;
end;

procedure TROSynapseHTTPChannel.SetUserAgent(const aValue: string);
begin
  fhttp.UserAgent := aValue;
end;

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

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

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

function TROSynapseHTTPChannel.GetKeepAlive: Boolean;
begin
  Result := fhttp.KeepAlive;
end;

procedure TROSynapseHTTPChannel.SetKeepAlive(const Value: Boolean);
begin
  fhttp.KeepAlive := Value;
end;

constructor TROSynapseHTTPChannel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fhttp := THTTPSend.Create;
  fhttp.Protocol := '1.1';
  fhttp.Status100 := False;
end;

destructor TROSynapseHTTPChannel.Destroy;
begin
  fhttp.Free;
  inherited Destroy;
end;

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

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

procedure TROSynapseHTTPChannel.CheckProperties;
begin
  Check(TargetURL = '', Name + '.TargetURL must be set.');
  inherited;
end;

initialization
  RegisterTransportChannelClass(TROSynapseHTTPChannel);

finalization
  UnRegisterTransportChannelClass(TROSynapseHTTPChannel);

end.