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
|
||||
uses
|
||||
base_soap_formatter, server_service_intf,
|
||||
base_soap_formatter, server_service_intf
|
||||
{$IFNDEF FPC}
|
||||
xmldom, wst_delphi_xml
|
||||
{$ELSE}
|
||||
DOM, XmlRead, XmlWrite
|
||||
, xmldom, wst_delphi_xml
|
||||
{$ENDIF};
|
||||
|
||||
const
|
||||
|
@ -69,7 +69,9 @@ Type
|
||||
procedure INDY_RegisterHTTP_Transport();
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
wst_types;
|
||||
|
||||
{ THTTPTransport }
|
||||
|
||||
function THTTPTransport.GetAddress: string;
|
||||
@ -143,7 +145,7 @@ end;
|
||||
procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||
{$IFDEF WST_DBG}
|
||||
var
|
||||
s : string;
|
||||
s : TBinaryString;
|
||||
i : Int64;
|
||||
{$ENDIF WST_DBG}
|
||||
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}
|
||||
unit library_protocol;
|
||||
|
||||
{$DEFINE WST_DBG}
|
||||
//{$DEFINE WST_DBG}
|
||||
|
||||
interface
|
||||
|
||||
|
@ -205,10 +205,10 @@ Type
|
||||
ARequestBuffer : IRequestBuffer;
|
||||
AServiceRegistry : IServerServiceRegistry = Nil
|
||||
);
|
||||
function GetFormatterRegistry():IFormatterRegistry;
|
||||
function GetServerServiceRegistry():IServerServiceRegistry;
|
||||
function GetServiceImplementationRegistry():IServiceImplementationRegistry ;
|
||||
function GetServiceExtensionRegistry():IServiceExtensionRegistry;
|
||||
function GetFormatterRegistry():IFormatterRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetServerServiceRegistry():IServerServiceRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetServiceImplementationRegistry():IServiceImplementationRegistry ;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetServiceExtensionRegistry():IServiceExtensionRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
||||
procedure initialize_server_services_intf();
|
||||
procedure finalize_server_services_intf();
|
||||
|
@ -62,7 +62,8 @@ Type
|
||||
procedure SYNAPSE_RegisterTCP_Transport();
|
||||
|
||||
implementation
|
||||
uses binary_streamer, Math;
|
||||
uses
|
||||
binary_streamer, Math, wst_types;
|
||||
|
||||
{ TTCPTransport }
|
||||
|
||||
@ -110,7 +111,7 @@ procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||
Var
|
||||
wrtr : IDataStore;
|
||||
buffStream : TMemoryStream;
|
||||
strBuff : string;
|
||||
strBuff : TBinaryString;
|
||||
bufferLen : LongInt;
|
||||
i, j, c : PtrInt;
|
||||
begin
|
||||
|
Reference in New Issue
Block a user