You've already forked lazarus-ccr
+Added Indy TCP transport (client)
Make registry getter inline TBinaryString should be used a binary buffer git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@535 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -73,11 +73,9 @@ type
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
base_soap_formatter, server_service_intf,
|
base_soap_formatter, server_service_intf
|
||||||
{$IFNDEF FPC}
|
{$IFNDEF FPC}
|
||||||
xmldom, wst_delphi_xml
|
, xmldom, wst_delphi_xml
|
||||||
{$ELSE}
|
|
||||||
DOM, XmlRead, XmlWrite
|
|
||||||
{$ENDIF};
|
{$ENDIF};
|
||||||
|
|
||||||
const
|
const
|
||||||
|
@ -69,6 +69,8 @@ Type
|
|||||||
procedure INDY_RegisterHTTP_Transport();
|
procedure INDY_RegisterHTTP_Transport();
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
uses
|
||||||
|
wst_types;
|
||||||
|
|
||||||
{ THTTPTransport }
|
{ THTTPTransport }
|
||||||
|
|
||||||
@ -143,7 +145,7 @@ end;
|
|||||||
procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||||
{$IFDEF WST_DBG}
|
{$IFDEF WST_DBG}
|
||||||
var
|
var
|
||||||
s : string;
|
s : TBinaryString;
|
||||||
i : Int64;
|
i : Int64;
|
||||||
{$ENDIF WST_DBG}
|
{$ENDIF WST_DBG}
|
||||||
begin
|
begin
|
||||||
|
159
wst/trunk/indy_tcp_protocol.pas
Normal file
159
wst/trunk/indy_tcp_protocol.pas
Normal file
@ -0,0 +1,159 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Web Service Toolkit
|
||||||
|
Copyright (c) 2008 by Inoussa OUEDRAOGO
|
||||||
|
|
||||||
|
This file is provide under modified LGPL licence
|
||||||
|
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||||
|
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
}
|
||||||
|
{$INCLUDE wst_global.inc}
|
||||||
|
unit indy_tcp_protocol;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils,
|
||||||
|
service_intf, imp_utils, base_service_intf,
|
||||||
|
IdTCPClient;
|
||||||
|
|
||||||
|
//{$DEFINE WST_DBG}
|
||||||
|
|
||||||
|
Const
|
||||||
|
sTRANSPORT_NAME = 'TCP';
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
ETCPException = class(EServiceException)
|
||||||
|
End;
|
||||||
|
|
||||||
|
{$M+}
|
||||||
|
{ TTCPTransport }
|
||||||
|
TTCPTransport = class(TSimpleFactoryItem,ITransport)
|
||||||
|
Private
|
||||||
|
FFormat : string;
|
||||||
|
FPropMngr : IPropertyManager;
|
||||||
|
FConnection : TIdTCPClient;
|
||||||
|
FContentType : string;
|
||||||
|
FTarget: string;
|
||||||
|
FAddress : string;
|
||||||
|
FPort : string;
|
||||||
|
FDefaultTimeOut: Integer;
|
||||||
|
private
|
||||||
|
procedure Connect();
|
||||||
|
public
|
||||||
|
constructor Create();override;
|
||||||
|
destructor Destroy();override;
|
||||||
|
function GetPropertyManager():IPropertyManager;
|
||||||
|
procedure SendAndReceive(ARequest,AResponse:TStream);
|
||||||
|
Published
|
||||||
|
property Target : string Read FTarget Write FTarget;
|
||||||
|
property ContentType : string Read FContentType Write FContentType;
|
||||||
|
property Address : string Read FAddress Write FAddress;
|
||||||
|
property Port : string read FPort write FPort;
|
||||||
|
property DefaultTimeOut : Integer read FDefaultTimeOut write FDefaultTimeOut;
|
||||||
|
property Format : string read FFormat write FFormat;
|
||||||
|
End;
|
||||||
|
{$M+}
|
||||||
|
|
||||||
|
procedure INDY_RegisterTCP_Transport();
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
binary_streamer, wst_types;
|
||||||
|
|
||||||
|
{ TTCPTransport }
|
||||||
|
|
||||||
|
procedure TTCPTransport.Connect();
|
||||||
|
var
|
||||||
|
locReconnect : Boolean;
|
||||||
|
begin
|
||||||
|
if not FConnection.Connected() then begin
|
||||||
|
FConnection.ReadTimeout := DefaultTimeOut;
|
||||||
|
FConnection.Connect(Address,StrToInt(Port));
|
||||||
|
end else begin
|
||||||
|
locReconnect := False;
|
||||||
|
try
|
||||||
|
locReconnect := not FConnection.Socket.Binding.Readable(0);
|
||||||
|
except
|
||||||
|
locReconnect := True;
|
||||||
|
end;
|
||||||
|
if locReconnect then begin
|
||||||
|
FConnection.Disconnect();
|
||||||
|
FConnection.ReadTimeout := DefaultTimeOut;
|
||||||
|
FConnection.Connect(Address,StrToInt(Port));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TTCPTransport.Create();
|
||||||
|
begin
|
||||||
|
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||||
|
FConnection := TIdTCPClient.Create(nil);
|
||||||
|
//FConnection.ReadTimeout:=;
|
||||||
|
FDefaultTimeOut := 90000;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TTCPTransport.Destroy();
|
||||||
|
begin
|
||||||
|
FreeAndNil(FConnection);
|
||||||
|
FPropMngr := Nil;
|
||||||
|
inherited Destroy();
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTCPTransport.GetPropertyManager(): IPropertyManager;
|
||||||
|
begin
|
||||||
|
Result := FPropMngr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||||
|
var
|
||||||
|
wrtr : IDataStore;
|
||||||
|
buffStream : TMemoryStream;
|
||||||
|
strBuff : TBinaryString;
|
||||||
|
bufferLen : LongInt;
|
||||||
|
begin
|
||||||
|
buffStream := TMemoryStream.Create();
|
||||||
|
try
|
||||||
|
wrtr := CreateBinaryWriter(buffStream);
|
||||||
|
wrtr.WriteInt32S(0);
|
||||||
|
wrtr.WriteStr(Target);
|
||||||
|
wrtr.WriteStr(ContentType);
|
||||||
|
wrtr.WriteStr(Self.Format);
|
||||||
|
SetLength(strBuff,ARequest.Size);
|
||||||
|
ARequest.Position := 0;
|
||||||
|
ARequest.Read(strBuff[1],Length(strBuff));
|
||||||
|
wrtr.WriteStr(strBuff);
|
||||||
|
buffStream.Position := 0;
|
||||||
|
wrtr.WriteInt32S(buffStream.Size-4);
|
||||||
|
buffStream.Position := 0;
|
||||||
|
|
||||||
|
Connect();
|
||||||
|
FConnection.IOHandler.Write(buffStream,buffStream.Size,False);
|
||||||
|
|
||||||
|
bufferLen := 0;
|
||||||
|
bufferLen := FConnection.IOHandler.ReadLongInt(False);
|
||||||
|
bufferLen := Reverse_32(bufferLen);
|
||||||
|
AResponse.Size := bufferLen;
|
||||||
|
if ( bufferLen > 0 ) then begin
|
||||||
|
AResponse.Position := 0;
|
||||||
|
FConnection.IOHandler.ReadStream(AResponse,bufferLen,False);
|
||||||
|
end;
|
||||||
|
AResponse.Position := 0;
|
||||||
|
{$IFDEF WST_DBG}
|
||||||
|
TMemoryStream(AResponse).SaveToFile('response.log');
|
||||||
|
{$ENDIF WST_DBG}
|
||||||
|
finally
|
||||||
|
buffStream.Free();
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure INDY_RegisterTCP_Transport();
|
||||||
|
begin
|
||||||
|
GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TTCPTransport) as IItemFactory);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
@ -13,7 +13,7 @@
|
|||||||
{$INCLUDE wst_global.inc}
|
{$INCLUDE wst_global.inc}
|
||||||
unit library_protocol;
|
unit library_protocol;
|
||||||
|
|
||||||
{$DEFINE WST_DBG}
|
//{$DEFINE WST_DBG}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
|
@ -205,10 +205,10 @@ Type
|
|||||||
ARequestBuffer : IRequestBuffer;
|
ARequestBuffer : IRequestBuffer;
|
||||||
AServiceRegistry : IServerServiceRegistry = Nil
|
AServiceRegistry : IServerServiceRegistry = Nil
|
||||||
);
|
);
|
||||||
function GetFormatterRegistry():IFormatterRegistry;
|
function GetFormatterRegistry():IFormatterRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
function GetServerServiceRegistry():IServerServiceRegistry;
|
function GetServerServiceRegistry():IServerServiceRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
function GetServiceImplementationRegistry():IServiceImplementationRegistry ;
|
function GetServiceImplementationRegistry():IServiceImplementationRegistry ;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
function GetServiceExtensionRegistry():IServiceExtensionRegistry;
|
function GetServiceExtensionRegistry():IServiceExtensionRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
|
||||||
procedure initialize_server_services_intf();
|
procedure initialize_server_services_intf();
|
||||||
procedure finalize_server_services_intf();
|
procedure finalize_server_services_intf();
|
||||||
|
@ -62,7 +62,8 @@ Type
|
|||||||
procedure SYNAPSE_RegisterTCP_Transport();
|
procedure SYNAPSE_RegisterTCP_Transport();
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses binary_streamer, Math;
|
uses
|
||||||
|
binary_streamer, Math, wst_types;
|
||||||
|
|
||||||
{ TTCPTransport }
|
{ TTCPTransport }
|
||||||
|
|
||||||
@ -110,7 +111,7 @@ procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
|||||||
Var
|
Var
|
||||||
wrtr : IDataStore;
|
wrtr : IDataStore;
|
||||||
buffStream : TMemoryStream;
|
buffStream : TMemoryStream;
|
||||||
strBuff : string;
|
strBuff : TBinaryString;
|
||||||
bufferLen : LongInt;
|
bufferLen : LongInt;
|
||||||
i, j, c : PtrInt;
|
i, j, c : PtrInt;
|
||||||
begin
|
begin
|
||||||
|
Reference in New Issue
Block a user