david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
288 lines
8.7 KiB
ObjectPascal
288 lines
8.7 KiB
ObjectPascal
unit uROIndySuperHttpChannel;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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,
|
|
{$IFDEF RemObjects_UseEncryption} uRoEncryption, {$ENDIF}
|
|
uROIndyTCPChannel, IdHTTP, uROBaseSuperHttpChannel, idstackconsts;
|
|
|
|
type
|
|
TROIndySuperHTTPChannel = class(TROBaseSuperHttpChannel)
|
|
private
|
|
fClientWait,
|
|
fClientRequest: TIdHTTP;
|
|
fTargetUrl: String;
|
|
fDisableNagle: Boolean;
|
|
protected
|
|
{ IROHTTPTransport }
|
|
procedure SocketConnectedRequest(Sender: TObject);
|
|
procedure SocketConnectedWait(Sender: TObject);
|
|
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;
|
|
{$IFDEF FPC}
|
|
property SessionId;
|
|
{$ENDIF}
|
|
published
|
|
{$IFNDEF FPC}
|
|
property SessionId;
|
|
{$ENDIF}
|
|
property Active;
|
|
property MaxPackageSize;
|
|
property TargetUrl: String read fTargetUrl write fTargetUrl;
|
|
property ClientWait: TIdHTTP read fClientWait;
|
|
property ClientRequest: TIdHTTP read fClientRequest;
|
|
property RequestTimeout;
|
|
property ConnectTimeout;
|
|
property HttpRequestTimeout;
|
|
property DisableNagle: Boolean read fDisableNagle write fDisableNagle default true;
|
|
|
|
property DispatchOptions;
|
|
property ServerLocators;
|
|
property OnServerLocatorAssignment;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
uRORes,uROHTTPTools;
|
|
|
|
{ TROIndySuperHTTPChannel }
|
|
|
|
procedure TROIndySuperHTTPChannel.SocketConnectedRequest(Sender: TObject);
|
|
begin
|
|
|
|
if DisableNagle then begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
fClientRequest.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True), SizeOf(Id_SO_True));
|
|
{$ELSE}
|
|
{$IFDEF RemObjects_INDY9}
|
|
fClientRequest.Socket.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True), SizeOf(Id_SO_True));
|
|
{$ELSE}
|
|
fClientRequest.Socket.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, Id_SO_True);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
procedure TROIndySuperHTTPChannel.SocketConnectedWait(Sender: TObject);
|
|
begin
|
|
|
|
if DisableNagle then begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
fClientWait.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True), SizeOf(Id_SO_True));
|
|
{$ELSE}
|
|
{$IFDEF RemObjects_INDY9}
|
|
fClientWait.Socket.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, PChar(@Id_SO_True), SizeOf(Id_SO_True));
|
|
{$ELSE}
|
|
fClientWait.Socket.Binding.SetSockOpt(Id_IPPROTO_TCP, Id_TCP_NODELAY, Id_SO_True);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.CancelRequest(aWaitingThread: Boolean);
|
|
var
|
|
lSock: TIdHTTP;
|
|
begin
|
|
try
|
|
if aWaitingThread then lSock := fClientWait else lSock := fClientRequest;
|
|
{$IFDEF RemOBjects_INDY8}
|
|
lSock.Binding.CloseSocket();
|
|
{$ELSE}
|
|
{$IFDEF RemObjects_INDY10}
|
|
if assigned(lSock.Socket) and (lSock.Socket.Connected) then
|
|
lSock.Socket.Close;
|
|
{$ELSE}
|
|
lSock.DisconnectSocket;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
except
|
|
// indy will release an exception when closing
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF RemObjects_INDY10}
|
|
type
|
|
TIdIndy10HackClient = class(TIdHTTP)
|
|
public
|
|
property OnConnected;
|
|
end;
|
|
{$ELSE}
|
|
type
|
|
TIdIndy10HackClient = TIdHTTP;
|
|
{$ENDIF}
|
|
|
|
constructor TROIndySuperHTTPChannel.Create(aOwner: TCOmponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
fDisableNagle := true;
|
|
fClientWait := TIdHTTP.Create(nil);
|
|
TIdIndy10HackClient(fClientWait).OnConnected := SocketConnectedWait;
|
|
fClientWait.Request.UserAgent := str_ProductName;
|
|
|
|
fClientRequest := TIdHTTP.Create(nil);
|
|
TIdIndy10HackClient(fClientRequest).OnConnected := SocketConnectedRequest;
|
|
fClientRequest.Request.UserAgent := str_ProductName;
|
|
|
|
{$IFDEF DELPHI6UP}
|
|
fClientWait.SetSubComponent(TRUE);
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI6UP}
|
|
fClientRequest.SetSubComponent(TRUE);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TROIndySuperHTTPChannel.Destroy;
|
|
begin
|
|
Active := false;
|
|
fClientWait.Free;
|
|
fClientRequest.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.DispatchHttpRequest(
|
|
aWaitingThread: Boolean; aRequest: TDynByteArray;
|
|
out aResponse: TDynByteArray);
|
|
var
|
|
lClient: TIdHTTP;
|
|
lRequest, lResponse: TMemoryStream;
|
|
begin
|
|
if aWaitingThread then lClient := fClientWait else lClient := fClientRequest;
|
|
lRequest:= TMemoryStream.Create;
|
|
lResponse := TMemoryStream.Create;
|
|
try
|
|
lRequest.Write(aRequest[0], Length(aRequest));
|
|
lRequest.Position := 0;
|
|
{$IFNDEF REMOBJECTS_INDY8}
|
|
lClient.ReadTimeout := HttpRequestTimeout;
|
|
{$ENDIF}
|
|
{$IFDEF RemObjects_INDY10}
|
|
lClient.ConnectTimeout := ConnectTimeout;
|
|
{$ENDIF}
|
|
lClient.Post(fTargetUrl, lRequest, lResponse);
|
|
SetLength(aResponse, lResponse.Size);
|
|
lResponse.Position := 0;
|
|
lResponse.Read(aResponse[0], Length(aResponse));
|
|
finally
|
|
lRequest.Free;
|
|
lResponse.Free;
|
|
end;
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetClientAddress: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetContentType: string;
|
|
begin
|
|
result := ClientRequest.Request.ContentType;
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetHeaders(const aName: string): string;
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
result := GetHeaderValue(ClientRequest.Request.ExtraHeaders, aName);
|
|
{$ELSE}
|
|
result := GetHeaderValue(ClientRequest.Request.RawHeaders, aName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetLocation: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetPathInfo: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetQueryParameter(
|
|
const aName: string): string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetQueryString: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetTargetURL: string;
|
|
begin
|
|
result := fTargetURL;
|
|
end;
|
|
|
|
function TROIndySuperHTTPChannel.GetUserAgent: string;
|
|
begin
|
|
result := ClientRequest.Request.UserAgent;
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.SetContentType(const aValue: string);
|
|
begin
|
|
ClientWait.Request.ContentType := aValue;
|
|
ClientRequest.Request.ContentType := aValue;
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.SetHeaders(const aName, aValue: string);
|
|
begin
|
|
{$IFDEF RemObjects_INDY8}
|
|
SetHeaderValue(ClientWait.Request.ExtraHeaders, aName, aValue);
|
|
SetHeaderValue(ClientRequest.Request.ExtraHeaders, aName, aValue);
|
|
{$ELSE}
|
|
SetHeaderValue(ClientWait.Request.CustomHeaders, aName, aValue);
|
|
SetHeaderValue(ClientRequest.Request.CustomHeaders, aName, aValue);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.SetPathInfo(const aValue: string);
|
|
begin
|
|
// do nothing; server side only
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.SetTargetURL(const aValue: string);
|
|
begin
|
|
fTargetURL := Trim(aValue)
|
|
end;
|
|
|
|
procedure TROIndySuperHTTPChannel.SetUserAgent(const aValue: string);
|
|
begin
|
|
ClientWait.Request.UserAgent := aValue;
|
|
ClientRequest.Request.UserAgent := aValue;
|
|
end;
|
|
|
|
end.
|