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

unit uROIndyHTTPChannel;

{----------------------------------------------------------------------------}
{ 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
  {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
  Classes, uROClientIntf, uROIndyTCPChannel, IdTCPCLient, IdHTTP;

type
  { TROIndyHTTPChannel }
  TROIndyHTTPChannel = class(TROCustomIndyTCPChannel, IROTransport, IROTCPTransport, IROHTTPTransport)
  private
    fTargetURL: string;

    function GetIndyClient: TIdHTTP;

  protected
    procedure IntDispatch(aRequest, aResponse : TStream); override;
    function CreateIndyClient : TIdTCPClientBaseClass; 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 GetPathInfo : string;
    function GetLocation : string;
    function GetQueryString: String;
    procedure IntSetServerLocator(aServerLocator: TROServerLocator); override;
  public
    procedure SetPathInfo(const aValue: String);
    procedure CheckProperties; override;
  published
    property IndyClient : TIdHTTP read GetIndyClient;

    property TargetURL : string read GetTargetURL write SetTargetURL;
    property KeepAlive;
  end;

implementation

uses
  SysUtils, IdException, uROClient,
  uRORes, uROHTTPTools, uROClasses;

{ TROIndyHTTPChannel }
function TROIndyHTTPChannel.CreateIndyClient: TIdTCPClientBaseClass;
begin
  result := TIdHTTP.Create(Self);
  TIdHTTP(result).Request.UserAgent := str_ProductName;
  TIdIndy10HackClient(result).Port := 80;
  TIdIndy10HackClient(result).Host := '127.0.0.1';
  TargetURL := '';
end;

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

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

function TROIndyHTTPChannel.GetIndyClient: TIdHTTP;
begin
  result := TIdHTTP(inherited IndyClient);
end;

procedure TROIndyHTTPChannel.IntDispatch(aRequest, aResponse : TStream);
{$IFNDEF RemObjects_INDY8}
var
  lErrorResponse:string;
{$ENDIF}
begin
  CheckProperties;
  {$IFDEF DESIGNTIME}
  {$IFDEF MSWINDOWS}
  NoIndyAtDesigntime();
  {$ENDIF MSWINDOWS}
  {$ENDIF DESIGNTIME}


  try
    {$IFNDEF RemObjects_INDY8}
    if KeepAlive then
      IndyClient.HTTPOptions := IndyClient.HTTPOptions + [hoKeepOrigProtocol]
    else
      IndyClient.HTTPOptions := IndyClient.HTTPOptions - [];
    {$ENDIF}
    IndyClient.Post(TargetURL, aRequest, aResponse);
  except
    {$IFDEF RemObjects_INDY8}
    raise
    {$ELSE}
    on E:EIdHTTPProtocolException do begin
      {$IFDEF RemObjects_INDY9}
      if E.ReplyErrorCode <> 500 then raise
      {$ELSE}
      if E.ErrorCode <> 500 then raise
      {$ENDIF}

      else begin
        // Indy raises exceptions when HTTP headers contain HTTP/1.0 500 Internal Server Error
        // We want to continue processing instead
        aResponse.Size := 0; // Just in case
        lErrorResponse := E.ErrorMessage;
        aResponse.Write(lErrorResponse[1],Length(E.ErrorMessage));
        aResponse.Seek(0,soFromBeginning);
      end;
    end
    {$ENDIF}
  end;
end;

function TROIndyHTTPChannel.GetHeaders(const aName: string): string;
begin
  {$IFDEF RemObjects_INDY8}
  result := GetHeaderValue(IndyClient.Request.ExtraHeaders, aName);
  {$ELSE}
  result := GetHeaderValue(IndyClient.Request.RawHeaders, aName);
  {$ENDIF}
end;

procedure TROIndyHTTPChannel.SetHeaders(const aName, aValue: string);
begin
  {$IFDEF RemObjects_INDY8}
  SetHeaderValue(IndyClient.Request.ExtraHeaders, aName, aValue);
  {$ELSE}
  SetHeaderValue(IndyClient.Request.CustomHeaders, aName, aValue);
  {$ENDIF}
end;

function TROIndyHTTPChannel.GetContentType: string;
begin
  result := IndyClient.Request.ContentType;
end;

procedure TROIndyHTTPChannel.SetContentType(const aValue: string);
begin
  IndyClient.Request.ContentType := aValue;
end;

function TROIndyHTTPChannel.GetUserAgent: string;
begin
  result := IndyClient.Request.UserAgent;
end;

procedure TROIndyHTTPChannel.SetUserAgent(const aValue: string);
begin
  IndyClient.Request.UserAgent := aValue;
end;

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

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

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

function TROIndyHTTPChannel.GetQueryString: String;
begin
  result := '';
end;

procedure TROIndyHTTPChannel.SetPathInfo(const aValue: String);
begin
  // do nothing; server side only
end;

procedure TROIndyHTTPChannel.IntSetServerLocator(
  aServerLocator: TROServerLocator);
begin
  TargetURL := aServerLocator.Host;
end;

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

initialization
  RegisterTransportChannelClass(TROIndyHTTPChannel);

finalization
  UnRegisterTransportChannelClass(TROIndyHTTPChannel);

end.