Refactor TBaseTransport and TBaseTCPTransport so http and tcp transports no longer manage filtering which is now done by TBaseTransport and TBaseTCPTransport

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1675 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/client_utils.pas

@@ -35,6 +35,7 @@ Type
     procedure SetFilterString(const Value: string);
     procedure FilterInput(ASource, ADest : TStream);
     procedure FilterOutput(ASource, ADest : TStream);
+    procedure DoSendAndReceive(ARequest,AResponse:TStream); virtual; abstract;
   public
     constructor Create();override;
     destructor Destroy();override;
@@ -45,12 +46,120 @@ Type
   published
     property FilterString : string read GetFilterString write SetFilterString;
   End;
+
+  { TBaseTCPTransport }
+
+  TBaseTCPTransport = class(TBaseTransport,ITransport)
+  private
+    FContentType : string;
+    FFormat : string;
+    FTarget : string;
+  protected
+    procedure DoSend(const AData; const ALength : Int64); virtual; abstract;
+    function DoReceive(var AData; const ALength : Int64) : Int64; virtual; abstract;
+  public
+    procedure SendAndReceive(ARequest,AResponse:TStream); override;
+  Published
+    property Target : string Read FTarget Write FTarget;
+    property ContentType : string Read FContentType Write FContentType;
+    property Format : string read FFormat write FFormat;
+  end;
+
 {$M+}
 
 
 implementation
 uses
-  wst_consts;
+  wst_consts, binary_streamer, Math;
+
+{ TBaseTCPTransport }
+
+procedure TBaseTCPTransport.SendAndReceive(ARequest, AResponse : TStream);
+
+  procedure ReadResponse(ADest : TStream);
+  var
+    bufferLen : LongInt;
+    i, j, c : PtrInt;
+    locBinBuff : TByteDynArray;
+  begin
+    bufferLen := 0;
+    DoReceive(bufferLen,SizeOf(bufferLen));
+    bufferLen := Reverse_32(bufferLen);
+    ADest.Size := bufferLen;
+    if ( bufferLen > 0 ) then begin
+      c := 0;
+      i := 1024;
+      if ( i > bufferLen ) then
+        i := bufferLen;
+      SetLength(locBinBuff,i);
+      repeat
+        j := DoReceive(locBinBuff[0],i);
+        ADest.Write(locBinBuff[0],j);
+        Inc(c,j);
+        i := Min(1024,(bufferLen-c));
+      until ( i =0 ) or ( j <= 0 );
+    end;
+    ADest.Position := 0;
+  end;
+
+Var
+  wrtr : IDataStore;
+  buffStream : TMemoryStream;
+  binBuff : TByteDynArray;
+  locTempStream, locTempRes : TMemoryStream;
+begin
+  locTempStream := nil;
+  locTempRes := nil;
+  buffStream := TMemoryStream.Create();
+  Try
+    wrtr := CreateBinaryWriter(buffStream);
+    wrtr.WriteInt32S(0);
+    wrtr.WriteAnsiStr(Target);
+    wrtr.WriteAnsiStr(ContentType);
+    wrtr.WriteAnsiStr(Self.Format);
+    if not HasFilter() then begin
+      SetLength(binBuff,ARequest.Size);
+      ARequest.Position := 0;
+      ARequest.Read(binBuff[0],Length(binBuff));
+    end else begin
+      locTempStream := TMemoryStream.Create();
+      FilterInput(ARequest,locTempStream);
+{$IFDEF WST_DBG}
+      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
+{$ENDIF WST_DBG}
+      SetLength(binBuff,locTempStream.Size);
+      locTempStream.Position := 0;
+      locTempStream.Read(binBuff[0],Length(binBuff));
+      locTempStream.Size := 0;
+    end;
+    wrtr.WriteBinary(binBuff);
+    SetLength(binBuff,0);
+    buffStream.Position := 0;
+    wrtr.WriteInt32S(buffStream.Size-4);
+    buffStream.Position := 0;
+
+    DoSend(buffStream.Memory^,buffStream.Size);
+
+    if not HasFilter() then begin
+      ReadResponse(AResponse);
+    end else begin
+      locTempRes := TMemoryStream.Create();
+      ReadResponse(locTempRes);
+  {$IFDEF WST_DBG}
+      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
+  {$ENDIF WST_DBG}
+      FilterOutput(locTempRes,AResponse);
+    end;
+
+    {$IFDEF WST_DBG}
+    TMemoryStream(AResponse).SaveToFile('response.log');
+    {$ENDIF WST_DBG}
+  Finally
+    locTempStream.Free();
+    locTempRes.Free();
+    buffStream.Free();
+  End;
+end;
 
 { TBaseTransport }
 
@@ -67,8 +176,35 @@ begin
 end;
 
 procedure TBaseTransport.SendAndReceive(ARequest, AResponse : TStream);
+var
+  locTempStream, locTempRes : TMemoryStream;
 begin
-  raise ETransportExecption.CreateFmt(SERR_UnsupportedOperation,['SendAndReceive']);
+  if not HasFilter() then begin
+    DoSendAndReceive(ARequest,AResponse);
+  end else begin
+    locTempRes := nil;
+    locTempStream := TMemoryStream.Create();
+    try
+      FilterInput(ARequest,locTempStream);
+{$IFDEF WST_DBG}
+      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
+{$ENDIF WST_DBG}
+      locTempRes := TMemoryStream.Create();
+      DoSendAndReceive(locTempStream,locTempRes);
+      locTempStream.Clear();
+  {$IFDEF WST_DBG}
+      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
+  {$ENDIF WST_DBG}
+      FilterOutput(locTempRes,AResponse);
+    finally
+      locTempRes.Free();
+      locTempStream.Free();
+    end;
+  end;
+{$IFDEF WST_DBG}
+  TMemoryStream(ARequest).SaveToFile('request.log');
+  TMemoryStream(AResponse).SaveToFile('response.log');
+{$ENDIF}
 end;
 
 function TBaseTransport.GetCookieManager() : ICookieManager;

wst/trunk/fpc_http_protocol.pas

@@ -52,23 +52,24 @@ Type
     FConnection : TFPHTTPClient;
     FAddress : string;
     FFormat : string;
-    FSoapAction: string;
     FCookieManager : ICookieManager;
   private  
     function GetAddress: string;
     function GetContentType: string;
+    function GetSoapAction : string;
     procedure SetAddress(const AValue: string);
     procedure SetContentType(const AValue: string);
+    procedure DoSendAndReceive(ARequest,AResponse:TStream); override;
+    procedure SetSoapAction(const AValue : string);
   Public
     constructor Create();override;
     destructor Destroy();override;      
     function GetTransportName() : string; override;
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
     function GetCookieManager() : ICookieManager; override;
   Published
     property ContentType : string Read GetContentType Write SetContentType;
     property Address : string Read GetAddress Write SetAddress;
-    property SoapAction : string read FSoapAction write FSoapAction;
+    property SoapAction : string read GetSoapAction write SetSoapAction;
     property Format : string read FFormat write FFormat;
   End;
 {$M+}
@@ -79,6 +80,9 @@ implementation
 uses
   wst_consts;
 
+const
+  s_soapAction_Header = 'soapAction';
+
 { THTTPTransport }
 
 function THTTPTransport.GetAddress: string;
@@ -91,6 +95,11 @@ begin
   Result := FConnection.GetHeader('Content-type');
 end;
 
+function THTTPTransport.GetSoapAction : string;
+begin
+  Result := FConnection.GetHeader(s_soapAction_Header);
+end;
+
 procedure THTTPTransport.SetAddress(const AValue: string);
 begin
   FAddress := AValue;
@@ -119,44 +128,25 @@ begin
   Result := sTRANSPORT_NAME;
 end;
 
-procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
+procedure THTTPTransport.DoSendAndReceive(ARequest, AResponse: TStream);
-
 var
   EMsg : String;
-  req,resp : TStream;
-  
 begin
-  If not HasFilter then
-    begin
-    Req:=ARequest;
-    Resp:=AResponse;
-    end
-  else      
-    begin
-    Req:=TMemoryStream.Create();
-    Resp:=TMemoryStream.Create();
-    end;
   try
-    if HasFilter then
+    ARequest.position:=0;
-      FilterInput(ARequest,req);  
+    FConnection.RequestBody:=ARequest;
-    try
+    FConnection.Post(FAddress,AResponse);
-      Req.position:=0;
-      FConnection.RequestBody:=Req;
-      FConnection.Post(FAddress,Resp);
-      if HasFilter then
-        FilterOutput(Resp,AResponse);
   except
     On E : Exception do
     EMsg:=E.Message;
   end;
   if (EMsg<>'') then
     raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
-  finally
-    if Req<>ARequest then
-      Req.Free;
-    if Resp<>AResponse then
-      Resp.Free;
 end;
+
+procedure THTTPTransport.SetSoapAction(const AValue : string);
+begin
+  FConnection.AddHeader(s_soapAction_Header,AValue);
 end;
 
 function THTTPTransport.GetCookieManager() : ICookieManager; 

wst/trunk/fpc_tcp_protocol.pas

@@ -31,29 +31,22 @@ Type
 
 {$M+}
   { TTCPTransport }
-  TTCPTransport = class(TBaseTransport,ITransport)
+  TTCPTransport = class(TBaseTCPTransport,ITransport)
   Private
-    FFormat : string;
     FConnection : TInetSocket;
-    FContentType : string;
-    FTarget: string;
     FAddress : string;
     FPort : string;
-    procedure ReadResponse(ADest: TStream);
-    procedure SendRequest(ARequest: TStream);
   private
     procedure Connect();
+  protected
+    procedure DoSend(const AData; const ALength : Int64); override;
+    function DoReceive(var AData; const ALength : Int64) : Int64; override;
   public
-    constructor Create();override;
     destructor Destroy();override;
     function GetTransportName() : string; override;      
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
   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 Format : string read FFormat write FFormat;
   End;
 
 procedure FPC_RegisterTCP_Transport();
@@ -61,7 +54,7 @@ procedure FPC_RegisterTCP_Transport();
 implementation
 
 uses
-  binary_streamer, Math, wst_types;
+  wst_consts, binary_streamer, Math, wst_types;
 
 { TTCPTransport }
 
@@ -72,9 +65,47 @@ begin
     FConnection:=TInetSocket.Create(FAddress,StrToInt(Port));
 end;
 
-constructor TTCPTransport.Create();
+procedure TTCPTransport.DoSend(const AData; const ALength : Int64);
+var
+  c, len : integer;
+  P : PByte;
 begin
-  inherited Create();
+  Connect();
+  P := PByte(@AData);
+  len := ALength;
+  Repeat
+    C:=FConnection.Write(P^,len);
+    if (C<0) then
+       Raise ETCPException.CreateFmt(SERR_ErrorSendindDataToSocket,[FConnection.LastError]);
+    If (C>0) then
+      begin
+        inc(P,C);
+        Dec(len,C);
+      end;
+  Until (len=0);
+end;
+
+function TTCPTransport.DoReceive(var AData; const ALength : Int64) : Int64;
+Var
+  P : PByte;
+  C : integer;
+  len : Int64;
+begin
+  if (ALength=0) then
+    exit;
+  len := ALength;
+  P:=PByte(@AData);
+  repeat
+    C:=FConnection.Read(P^,len);
+    If (C<=0) then
+      Raise ETCPException.CreateFmt(SERR_ErrorReadindDataToSocket,[FConnection.LastError]);
+    If (C>0) then
+      begin
+        Inc(P,C);
+        Dec(len,C);
+      end
+  Until (len=0);
+  Result := ALength;
 end;
 
 destructor TTCPTransport.Destroy();
@@ -88,139 +119,6 @@ begin
   Result := sTRANSPORT_NAME;  
 end;
 
-procedure TTCPTransport.SendRequest(ARequest : TStream);
-
-  Procedure SendBuffer(P : PByte; ACount : Integer);
-
-  Var
-    c : integer;
-
-  begin
-    Repeat
-      C:=FConnection.Write(P^,ACount);
-      if (C<0) then
-         Raise ETCPException.CreateFmt('Error %d sending data to socket',[FConnection.LastError]);
-      If (C>0) then
-        begin
-        inc(P,C);
-        Dec(ACount,C);
-        end;
-    Until (ACount=0);
-  end;
-
-
-Var
-  M : TMemoryStream;
-  binBuff : TByteDynArray;
-  wrtr : IDataStore;
-
-begin
-  SetLength(binBuff,ARequest.Size);
-  ARequest.Position := 0;
-  ARequest.ReadBuffer(binBuff[0],Length(binBuff));
-  M := TMemoryStream.Create();
-  Try
-    wrtr:=CreateBinaryWriter(M);
-    wrtr.WriteInt32S(0);
-    wrtr.WriteAnsiStr(Target);
-    wrtr.WriteAnsiStr(ContentType);
-    wrtr.WriteAnsiStr(Self.Format);
-    wrtr.WriteBinary(binBuff);
-    M.Position := 0;
-    wrtr.WriteInt32S(M.Size-4);
-    M.Position := 0;
-    SendBuffer(TMemoryStream(M).Memory,M.Size);
-  Finally
-    M.Free;
-  end;
-end;
-
-procedure TTCPTransport.ReadResponse(ADest : TStream);
-
-  Procedure ReadBuffer(Var Buf; ACount : Integer);
-
-  Var
-    P : PByte;
-    C : integer;
-
-  begin
-    if (ACount=0) then exit;
-    P:=PByte(@Buf);
-    repeat
-      C:=FConnection.Read(P^,ACount);
-      If (C<=0) then
-        Raise ETCPException.CreateFmt('Error %d reading data from socket',[FConnection.LastError]);
-      If (C>0) then
-        begin
-        Inc(P,C);
-        Dec(ACount,C);
-        end
-    Until (ACount=0);
-  end;
-
-var
-  bufferLen : LongInt;
-  i, j, c : PtrInt;
-  locBinBuff : TByteDynArray;
-begin
-  bufferLen := 0;
-  ReadBuffer(BufferLen,SizeOf(BufferLen));
-  bufferLen := Reverse_32(bufferLen);
-  ADest.Size := bufferLen;
-  ADest.Position:=0;
-  if (bufferLen>0) then
-    begin
-    c := 0;
-    i := Min(1024,Bufferlen);
-    SetLength(locBinBuff,i);
-    repeat
-      ReadBuffer(locBinBuff[0],i);
-      ADest.Write(locBinBuff[0],i);
-      Inc(c,i);
-      i:=Min(1024,(bufferLen-c));
-    until (i=0);
-    end;
-end;
-
-procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
-
-Var
-  buffStream : TMemoryStream;
-  binBuff : TByteDynArray;
-  M : TStream;
-begin
-  // Connect
-  Connect();
-  // Filter
-  if HasFilter() then
-    M:=TMemoryStream.Create()
-  else
-    M:=ARequest;
-  try
-    if HasFilter() then
-      FilterInput(ARequest,M);
-    // Actually send buffer
-    SendRequest(M);
-  Finally
-    if (M<>ARequest) then
-      FreeAndNil(M);
-  end;
-  // Prepare to read response
-  if HasFilter() then
-    M:=TmemoryStream.Create
-  else
-    M:=AResponse;
-  try
-    // Actually read response
-    ReadResponse(M);
-    if HasFilter() then
-      FilterOutput(M,AResponse);
-  Finally
-    if (M<>AResponse) then
-      FreeAndNil(M);
-  end;
-end;
-
 procedure FPC_RegisterTCP_Transport();
 begin
   GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TTCPTransport) as IItemFactory);

wst/trunk/indy_http_protocol.pas

@@ -50,8 +50,6 @@ Type
   Private
     FFormat : string;
     FConnection : TidHttp;
-    FSoapAction: string;
-    FContentType: string;
     FCookieManager : ICookieManager;
   private
     function GetAddress: string;
@@ -66,20 +64,25 @@ Type
     procedure SetProxyPort(const AValue: Integer);
     procedure SetProxyServer(const AValue: string);
     procedure SetProxyUsername(const AValue: string);
+    function GetContentType: string;
+    procedure SetContentType(const Value: string);
+    function GetSoapAction: string;
+    procedure SetSoapAction(const Value: string);
+  protected
+    procedure DoSendAndReceive(ARequest,AResponse:TStream);override;
   public
     constructor Create();override;
     destructor Destroy();override;
     function GetTransportName() : string; override;
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
     function GetCookieManager() : ICookieManager; override;
   published
-    property ContentType : string Read FContentType Write FContentType;
+    property ContentType : string Read GetContentType Write SetContentType;
     property Address : string Read GetAddress Write SetAddress;
     property ProxyServer : string Read GetProxyServer Write SetProxyServer;
     property ProxyPort : Integer Read GetProxyPort Write SetProxyPort;
     property ProxyUsername : string read GetProxyUsername write SetProxyUsername;
     property ProxyPassword : string read GetProxyPassword write SetProxyPassword;
-    property SoapAction : string read FSoapAction write FSoapAction;
+    property SoapAction : string read GetSoapAction write SetSoapAction;
     property Format : string read FFormat write FFormat;
     property ProtocolVersion : string read GetProtocolVersion write SetProtocolVersion;
   End;
@@ -143,6 +146,11 @@ begin
   Result := FConnection.ProxyParams.ProxyUsername;
 end;
 
+function THTTPTransport.GetSoapAction: string;
+begin
+  Result := FConnection.Request.CustomHeaders.Values['SOAPAction'];
+end;
+
 function THTTPTransport.GetTransportName() : string;
 begin
   Result := sTRANSPORT_NAME;
@@ -153,6 +161,11 @@ begin
   FConnection.Request.URL := AValue;
 end;
 
+procedure THTTPTransport.SetContentType(const Value: string);
+begin
+  FConnection.Request.ContentType := Value;
+end;
+
 procedure THTTPTransport.SetProtocolVersion(const AValue : string);
 var
   locValue : TIdHTTPProtocolVersion;
@@ -184,6 +197,11 @@ begin
   FConnection.ProxyParams.ProxyUsername := AValue;
 end;
 
+procedure THTTPTransport.SetSoapAction(const Value: string);
+begin
+  FConnection.Request.CustomHeaders.Values['SOAPAction'] := Value;
+end;
+
 constructor THTTPTransport.Create();
 begin
   inherited;
@@ -196,13 +214,7 @@ begin
   inherited Destroy();
 end;
 
-procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
+procedure THTTPTransport.DoSendAndReceive(ARequest, AResponse: TStream);
-var
-  locTempStream, locTempRes : TMemoryStream;
-{$IFDEF WST_DBG}
-  s : TBinaryString;
-  i : Int64;
-{$ENDIF WST_DBG}
 begin
   if not ( IsStrEmpty(FConnection.ProxyParams.ProxyUsername) and
            IsStrEmpty(FConnection.ProxyParams.ProxyPassword)
@@ -210,43 +222,12 @@ begin
   then begin
     FConnection.ProxyParams.BasicAuthentication := True;
   end;
-  FConnection.Request.CustomHeaders.Clear();
-  FConnection.Request.CustomHeaders.Values['SOAPAction'] := SoapAction;
-  FConnection.Request.ContentType := ContentType;
-{$IFDEF WST_DBG}
-  TMemoryStream(ARequest).SaveToFile('request.log');
-{$ENDIF WST_DBG}
-  if not HasFilter() then begin
   FConnection.Post(Address,ARequest, AResponse);
-  end else begin
-    locTempRes := nil;
-    locTempStream := TMemoryStream.Create();
-    try
-      FilterInput(ARequest,locTempStream);
-{$IFDEF WST_DBG}
-      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
-{$ENDIF WST_DBG}
-      locTempRes := TMemoryStream.Create();
-      FConnection.Post(Address,locTempStream,locTempRes);
-  {$IFDEF WST_DBG}
-      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
-  {$ENDIF WST_DBG}
-      FilterOutput(locTempRes,AResponse);
-    finally
-      locTempRes.Free();
-      locTempStream.Free();
 end;
-  end;
+
-  {$IFDEF WST_DBG}
+function THTTPTransport.GetContentType: string;
-  if IsConsole then begin
+begin
-    i := AResponse.Size;
+  Result := FConnection.Request.ContentType;
-    SetLength(s,i);
-    Move(TMemoryStream(AResponse).Memory^,s[1],i);
-    WriteLn('--------------------------------------------');
-    WriteLn(s);
-  end;
-  TMemoryStream(AResponse).SaveToFile('response.log');
-  {$ENDIF WST_DBG}
 end;
 
 function THTTPTransport.GetCookieManager() : ICookieManager;

wst/trunk/indy_tcp_protocol.pas

@@ -31,36 +31,33 @@ Type
   End;
 
   { TTCPTransport }
-  TTCPTransport = class(TBaseTransport,ITransport)
+  TTCPTransport = class(TBaseTCPTransport,ITransport)
   Private
-    FFormat : string;
     FConnection : TIdTCPClient;
-    FContentType : string;
-    FTarget: string;
     FAddress : string;
     FPort : string;
     FDefaultTimeOut: Integer;
   private
     procedure Connect();
+  protected
+    procedure DoSend(const AData; const ALength : Int64); override;
+    function DoReceive(var AData; const ALength : Int64) : Int64; override;
   public
     constructor Create();override;
     destructor Destroy();override;
     function GetTransportName() : string; override;
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
   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;
 
   procedure INDY_RegisterTCP_Transport();
 
 implementation
 uses
-  binary_streamer, wst_types;
+  binary_streamer, wst_types,
+  IdGlobal;
 
 { TTCPTransport }
 
@@ -100,83 +97,67 @@ begin
   inherited Destroy();
 end;
 
+function TTCPTransport.DoReceive(var AData; const ALength: Int64): Int64;
+const
+  BUFFER_LEN = 8 * 1024;
+var
+  locBuffer : TIdBytes;
+  p : PByte;
+  k : Integer;
+  len : Integer;
+begin
+  Result := 0;
+  if (ALength=0) then
+    exit;
+
+  p := PByte(@AData);
+  len := ALength;
+  repeat
+    if (len > BUFFER_LEN) then
+      k := BUFFER_LEN
+    else
+      k := len;
+    FConnection.IOHandler.ReadBytes(locBuffer,k,False);
+    Move(locBuffer[0],p^,k);
+    Inc(P,k);
+    Dec(len,k);
+  until (len=0);
+  Result := ALength;
+end;
+
+procedure TTCPTransport.DoSend(const AData; const ALength: Int64);
+const
+  BUFFER_LEN = 8 * 1024;
+var
+  locBuffer : TIdBytes;
+  p : PByte;
+  k : Integer;
+  len : Integer;
+begin
+  if (ALength < 1) then
+    exit;
+
+  Connect();
+  SetLength(locBuffer,BUFFER_LEN);
+  p := PByte(@AData);
+  len := ALength;
+  repeat
+    if (len > BUFFER_LEN) then
+      k := BUFFER_LEN
+    else
+      k := len;
+    Move(p^,locBuffer[0],k);
+    FConnection.IOHandler.Write(locBuffer,k);
+    Inc(P,k);
+    Dec(len,k);
+  until (len=0);
+end;
+
 function TTCPTransport.GetTransportName() : string;
 begin
   Result := sTRANSPORT_NAME;
 end;
 
-procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
-var
-  wrtr : IDataStore;
-  buffStream : TMemoryStream;
-  binBuff : TByteDynArray;
-  bufferLen : LongInt;
-  locTempStream : TMemoryStream;
-begin
-{$IFDEF WST_DBG}
-  TMemoryStream(ARequest).SaveToFile('request.log');
-{$ENDIF WST_DBG}
-  locTempStream := nil;
-  buffStream := TMemoryStream.Create();
-  try
-    wrtr := CreateBinaryWriter(buffStream);
-    wrtr.WriteInt32S(0);
-    wrtr.WriteAnsiStr(Target);
-    wrtr.WriteAnsiStr(ContentType);
-    wrtr.WriteAnsiStr(Self.Format);
-    if not HasFilter() then begin
-      SetLength(binBuff,ARequest.Size);
-      ARequest.Position := 0;
-      ARequest.Read(binBuff[0],Length(binBuff));
-    end else begin
-      locTempStream := TMemoryStream.Create();
-      FilterInput(ARequest,locTempStream);
-{$IFDEF WST_DBG}
-      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
-{$ENDIF WST_DBG}
-      SetLength(binBuff,locTempStream.Size);
-      locTempStream.Position := 0;
-      locTempStream.Read(binBuff[0],Length(binBuff));
-      locTempStream.Size := 0;
-    end;
-    wrtr.WriteBinary(binBuff);
-    buffStream.Position := 0;
-    wrtr.WriteInt32S(buffStream.Size-4);
-    buffStream.Position := 0;
-
-    Connect();
-    FConnection.IOHandler.Write(buffStream,buffStream.Size,False);
-
-    bufferLen := FConnection.IOHandler.ReadLongInt(False);
-    bufferLen := Reverse_32(bufferLen);
-    if not HasFilter() then begin
-      AResponse.Size := bufferLen;
-      if ( bufferLen > 0 ) then begin
-        AResponse.Position := 0;
-        FConnection.IOHandler.ReadStream(AResponse,bufferLen,False);
-      end;
-    end else begin
-      locTempStream.Size := bufferLen;
-      if ( bufferLen > 0 ) then begin
-        locTempStream.Position := 0;
-        FConnection.IOHandler.ReadStream(locTempStream,bufferLen,False);
-  {$IFDEF WST_DBG}
-        TMemoryStream(locTempStream).SaveToFile('response.log.wire');
-  {$ENDIF WST_DBG}
-        FilterOutput(locTempStream,AResponse);
-        locTempStream.Size := 0;
-      end;
-    end;
-    AResponse.Position := 0;
-    {$IFDEF WST_DBG}
-    TMemoryStream(AResponse).SaveToFile('response.log');
-    {$ENDIF WST_DBG}
-  finally
-    locTempStream.Free();
-    buffStream.Free();
-  end;
-end;
-
 procedure INDY_RegisterTCP_Transport();
 begin
   GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TTCPTransport) as IItemFactory);

wst/trunk/synapse_http_protocol.pas

@@ -52,26 +52,28 @@ Type
     FConnection : THTTPSend;
     FAddress : string;
     FFormat : string;
-    FSoapAction: string;
     FCookieManager : ICookieManager;
   private
+    function IndexOfHeader(const AHeader : string) :Integer;
     function GetAddress: string;
     function GetContentType: string;
     function GetProxyPassword: string;
     function GetProxyPort: Integer;
     function GetProxyServer: string;
     function GetProxyUsername: string;
+    function GetSoapAction : string;
     procedure SetAddress(const AValue: string);
     procedure SetContentType(const AValue: string);
     procedure SetProxyPassword(const AValue: string);
     procedure SetProxyPort(const AValue: Integer);
     procedure SetProxyServer(const AValue: string);
     procedure SetProxyUsername(const AValue: string);
+    procedure SetSoapAction(const AValue : string);
+    procedure DoSendAndReceive(ARequest,AResponse:TStream); override;
   Public
     constructor Create();override;
     destructor Destroy();override;      
     function GetTransportName() : string; override;
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
     function GetCookieManager() : ICookieManager; override;
   Published
     property ContentType : string Read GetContentType Write SetContentType;
@@ -80,7 +82,7 @@ Type
     property ProxyPort : Integer Read GetProxyPort Write SetProxyPort;
     property ProxyUsername : string read GetProxyUsername write SetProxyUsername;
     property ProxyPassword : string read GetProxyPassword write SetProxyPassword;
-    property SoapAction : string read FSoapAction write FSoapAction;
+    property SoapAction : string read GetSoapAction write SetSoapAction;
     property Format : string read FFormat write FFormat;
   End;
 {$M+}
@@ -91,8 +93,29 @@ implementation
 uses
   wst_consts;
 
+const
+  s_soapAction_Header = 'soapAction:';
+
 { THTTPTransport }
 
+function THTTPTransport.IndexOfHeader(const AHeader : string) : Integer;
+var
+  i : Integer;
+  locList : TStringList;
+  s : string;
+begin
+  Result := -1;
+  locList := FConnection.Headers;
+  if (locList.Count > 0) then begin
+    s := LowerCase(AHeader);
+    for i := 0 to locList.Count - 1 do
+      if (Pos(s,LowerCase(locList[i])) = 1) then begin
+        Result := i;
+        Break;
+      end;
+  end;
+end;
+
 function THTTPTransport.GetAddress: string;
 begin
   Result := FAddress;
@@ -123,6 +146,19 @@ begin
   Result := FConnection.ProxyUser;
 end;
 
+function THTTPTransport.GetSoapAction : string;
+var
+  i : Integer;
+begin
+  i := IndexOfHeader(s_soapAction_Header);
+  if (i >= 0) then begin
+    Result := FConnection.Headers[i];
+    Result := Copy(Result,(Length(s_soapAction_Header)+1),Length(Result));
+  end else begin
+    Result := '';
+  end;
+end;
+
 procedure THTTPTransport.SetAddress(const AValue: string);
 begin
   FAddress := AValue;
@@ -153,6 +189,27 @@ begin
   FConnection.ProxyUser := AValue;
 end;
 
+procedure THTTPTransport.SetSoapAction(const AValue : string);
+var
+  i : Integer;
+  s : string;
+begin
+  i := IndexOfHeader(s_soapAction_Header);
+  s := s_soapAction_Header + AValue;
+  if (i >= 0) then
+    FConnection.Headers[i] := s
+  else
+    FConnection.Headers.Add(s);
+end;
+
+procedure THTTPTransport.DoSendAndReceive(ARequest, AResponse : TStream);
+begin
+  FConnection.Document.CopyFrom(ARequest,0);
+  if not FConnection.HTTPMethod('POST',FAddress) then
+    raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
+  AResponse.CopyFrom(FConnection.Document,0);
+end;
+
 constructor THTTPTransport.Create();
 begin
   inherited Create();
@@ -171,67 +228,6 @@ begin
   Result := sTRANSPORT_NAME;
 end;
 
-procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
-{$IFDEF WST_DBG}
-  procedure Display(const AStr : string);
-  begin
-    if IsConsole then
-      WriteLn(AStr)
-    {else
-      ShowMessage(AStr)};
-  end;
-{$ENDIF WST_DBG}
-var
-{$IFDEF WST_DBG}
-  s : TBinaryString;
-{$ENDIF WST_DBG}
-  locTempStream, locTempRes : TMemoryStream;
-begin
-{$IFDEF WST_DBG}
-  TMemoryStream(ARequest).SaveToFile('request-1.log');
-{$ENDIF}
-  FConnection.Document.Size := 0;
-  FConnection.Headers.Add('soapAction:' + SoapAction);
-  if not HasFilter() then begin
-    FConnection.Document.CopyFrom(ARequest,0);
-    if not FConnection.HTTPMethod('POST',FAddress) then
-      raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
-    AResponse.CopyFrom(FConnection.Document,0);
-  end else begin
-    locTempRes := nil;
-    locTempStream := TMemoryStream.Create();
-    try
-      FilterInput(ARequest,locTempStream);
-{$IFDEF WST_DBG}
-      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
-{$ENDIF WST_DBG}
-      FConnection.Document.CopyFrom(locTempStream,0);
-      if not FConnection.HTTPMethod('POST',FAddress) then
-        raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
-      locTempRes := TMemoryStream.Create();
-      locTempRes.CopyFrom(FConnection.Document,0);
-  {$IFDEF WST_DBG}
-      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
-  {$ENDIF WST_DBG}
-      FilterOutput(locTempRes,AResponse);
-    finally
-      locTempRes.Free();
-      locTempStream.Free();
-    end;
-  end;
-  FConnection.Clear();
-{$IFDEF WST_DBG}
-  TMemoryStream(ARequest).SaveToFile('request.log');
-  SetLength(s,ARequest.Size);
-  Move(TMemoryStream(ARequest).Memory^,s[1],Length(s));
-  Display(s);
-  SetLength(s,AResponse.Size);
-  Move(TMemoryStream(AResponse).Memory^,s[1],Length(s));
-  TMemoryStream(AResponse).SaveToFile('response.log');
-  Display(s);
-{$ENDIF}
-end;
-
 function THTTPTransport.GetCookieManager() : ICookieManager;
 begin
   if (FCookieManager = nil) then

wst/trunk/synapse_tcp_protocol.pas

@@ -17,7 +17,7 @@ interface
 
 uses
   Classes, SysUtils,
-  service_intf, imp_utils, base_service_intf, client_utils,
+  service_intf, base_service_intf, client_utils,
   blcksock;
 
 //{$DEFINE WST_DBG}
@@ -32,29 +32,25 @@ Type
   
 {$M+}
   { TTCPTransport }
-  TTCPTransport = class(TBaseTransport,ITransport)
+  TTCPTransport = class(TBaseTCPTransport,ITransport)
   Private
-    FFormat : string;
     FConnection : TTCPBlockSocket;
-    FContentType : string;
-    FTarget: string;
     FAddress : string;
     FPort : string;
     FDefaultTimeOut: Integer;
   private
     procedure Connect();
+  protected
+    procedure DoSend(const AData; const ALength : Int64); override;
+    function DoReceive(var AData; const ALength : Int64) : Int64; override;
   public
     constructor Create();override;
     destructor Destroy();override;      
     function GetTransportName() : string; override;      
-    procedure SendAndReceive(ARequest,AResponse:TStream); override;
   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+}
 
@@ -62,7 +58,7 @@ Type
 
 implementation
 uses
-  binary_streamer, Math, wst_types;
+  wst_types;
 
 { TTCPTransport }
 
@@ -86,6 +82,18 @@ begin
   end;
 end;
 
+procedure TTCPTransport.DoSend(const AData; const ALength : Int64);
+begin
+  Connect();
+  FConnection.SendBuffer(@AData,ALength);
+end;
+
+function TTCPTransport.DoReceive(var AData; const ALength : Int64) : Int64;
+begin
+  Result := FConnection.RecvBufferEx(@AData,ALength,DefaultTimeOut);
+  FConnection.ExceptCheck();
+end;
+
 constructor TTCPTransport.Create();
 begin
   inherited Create();
@@ -105,95 +113,6 @@ begin
   Result := sTRANSPORT_NAME;  
 end;
 
-procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
-
-  procedure ReadResponse(ADest : TStream);
-  var
-    bufferLen : LongInt;
-    i, j, c : PtrInt;
-    locBinBuff : TByteDynArray;
-  begin
-    bufferLen := 0;
-    FConnection.RecvBufferEx(@bufferLen,SizeOf(bufferLen),DefaultTimeOut);
-    FConnection.ExceptCheck();
-    bufferLen := Reverse_32(bufferLen);
-    ADest.Size := bufferLen;
-    if ( bufferLen > 0 ) then begin
-      c := 0;
-      i := 1024;
-      if ( i > bufferLen ) then
-        i := bufferLen;
-      SetLength(locBinBuff,i);
-      repeat
-        j := FConnection.RecvBufferEx(@(locBinBuff[0]),i,DefaultTimeOut);
-        FConnection.ExceptCheck();
-        ADest.Write(locBinBuff[0],j);
-        Inc(c,j);
-        i := Min(1024,(bufferLen-c));
-      until ( i =0 ) or ( j <= 0 );
-    end;
-    ADest.Position := 0;
-  end;
-
-Var
-  wrtr : IDataStore;
-  buffStream : TMemoryStream;
-  binBuff : TByteDynArray;
-  locTempStream, locTempRes : TMemoryStream;
-begin
-  locTempStream := nil;
-  locTempRes := nil;
-  buffStream := TMemoryStream.Create();
-  Try
-    wrtr := CreateBinaryWriter(buffStream);
-    wrtr.WriteInt32S(0);
-    wrtr.WriteAnsiStr(Target);
-    wrtr.WriteAnsiStr(ContentType);
-    wrtr.WriteAnsiStr(Self.Format);
-    if not HasFilter() then begin
-      SetLength(binBuff,ARequest.Size);
-      ARequest.Position := 0;
-      ARequest.Read(binBuff[0],Length(binBuff));
-    end else begin
-      locTempStream := TMemoryStream.Create();
-      FilterInput(ARequest,locTempStream);
-{$IFDEF WST_DBG}
-      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
-{$ENDIF WST_DBG}
-      SetLength(binBuff,locTempStream.Size);
-      locTempStream.Position := 0;
-      locTempStream.Read(binBuff[0],Length(binBuff));
-      locTempStream.Size := 0;
-    end;
-    wrtr.WriteBinary(binBuff);
-    buffStream.Position := 0;
-    wrtr.WriteInt32S(buffStream.Size-4);
-    buffStream.Position := 0;
-
-    Connect();
-    FConnection.SendBuffer(buffStream.Memory,buffStream.Size);
-
-    if not HasFilter() then begin
-      ReadResponse(AResponse);
-    end else begin
-      locTempRes := TMemoryStream.Create();
-      ReadResponse(locTempRes);
-  {$IFDEF WST_DBG}
-      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
-  {$ENDIF WST_DBG}
-      FilterOutput(locTempRes,AResponse);
-    end;
-
-    {$IFDEF WST_DBG}
-    TMemoryStream(AResponse).SaveToFile('response.log');
-    {$ENDIF WST_DBG}
-  Finally
-    locTempStream.Free();
-    locTempRes.Free();
-    buffStream.Free();
-  End;
-end;
-
 procedure SYNAPSE_RegisterTCP_Transport();
 begin
   GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TTCPTransport) as IItemFactory);

wst/trunk/wst_consts.pas

@@ -25,6 +25,8 @@ resourcestring
   SERR_CannotResolveNamespace        = 'Unable to resolve this namespace : "%s".';
   SERR_DataFilterNotFound            = 'Data Filter not found : "%s".';
   SERR_DuplicateBindingName          = 'Duplicated binding : "%s".';
+  SERR_ErrorReadindDataToSocket      = 'Error %d reading data from socket';
+  SERR_ErrorSendindDataToSocket      = 'Error %d sending data to socket';
   SERR_ExpectedButFound              = '%s expected but %s found.';
   SERR_ExpectedTypeDefinition        = '"%s" was expected to be a type definition.';
   SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".';