david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
119 lines
3.8 KiB
ObjectPascal
119 lines
3.8 KiB
ObjectPascal
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
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
|
|
Classes, SysUtils, uROClient, uROClientIntf, uROAsync, uROClasses, SyncObjs,
|
|
{$IFDEF RemObjects_UseEncryption} uRoEncryption, {$ENDIF}uROThreadPool,
|
|
httpsend, uROBaseSuperHttpChannel;
|
|
|
|
type
|
|
TROSynapseSuperHttpChannel = class(TROBaseSuperHttpChannel)
|
|
private
|
|
fClientWait,
|
|
fClientRequest: THTTPSend;
|
|
fTargetUrl: String;
|
|
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;
|
|
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);
|
|
fClientWait := THttpSend.Create;
|
|
fClientWait.UserAgent := str_ProductName;
|
|
fClientWait.Protocol := '1.1';
|
|
fClientWait.Status100 := False;
|
|
|
|
fClientRequest := THTTPSend.Create;
|
|
fClientRequest.UserAgent := str_ProductName;
|
|
fClientRequest.Protocol := '1.1';
|
|
fClientRequest.Status100 := False;
|
|
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;
|
|
|
|
end.
|