From 8206c61bd6a400cc226f9b32b76e2e27d1cb257c Mon Sep 17 00:00:00 2001
From: inoussa <inoussa@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Fri, 17 Jul 2009 17:15:19 +0000
Subject: [PATCH] Patch from Michael Van Canneyt : check for error in synapse
 http requesting.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@916 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 wst/trunk/base_service_intf.pas     | 4 ++--
 wst/trunk/synapse_http_protocol.pas | 5 ++++-
 wst/trunk/wst_consts.pas            | 3 +++
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas
index 6a5cbda68..a8b4ca818 100644
--- a/wst/trunk/base_service_intf.pas
+++ b/wst/trunk/base_service_intf.pas
@@ -62,8 +62,8 @@ const
 
 type
 
-  EServiceException = class(Exception)
-  End;
+  EServiceException = class(Exception) end;
+  ETransportExecption = class(EServiceException) end;
 
   EBaseRemoteException = class(EServiceException)
   private
diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas
index 38366a7d7..5c7c45be8 100644
--- a/wst/trunk/synapse_http_protocol.pas
+++ b/wst/trunk/synapse_http_protocol.pas
@@ -69,6 +69,8 @@ Type
   procedure SYNAPSE_RegisterHTTP_Transport();
 
 implementation
+uses
+  wst_consts;
 
 { THTTPTransport }
 
@@ -169,7 +171,8 @@ begin
   FConnection.Document.Size := 0;
   FConnection.Headers.Add('soapAction:' + SoapAction);
   FConnection.Document.CopyFrom(ARequest,0);
-  FConnection.HTTPMethod('POST',FAddress);
+  if not FConnection.HTTPMethod('POST',FAddress) then
+    raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
   AResponse.CopyFrom(FConnection.Document,0);
   FConnection.Clear();
 {$IFDEF WST_DBG}
diff --git a/wst/trunk/wst_consts.pas b/wst/trunk/wst_consts.pas
index b2b790f44..f50fdbb95 100644
--- a/wst/trunk/wst_consts.pas
+++ b/wst/trunk/wst_consts.pas
@@ -21,6 +21,7 @@ resourcestring
   SERR_CannotResolveNamespace        = 'Unable to resolve this namespace : "%s".';
   SERR_DuplicateBindingName          = 'Duplicated binding : "%s".';
   SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".';
+  SERR_FailedTransportRequest        = '%s Request to %s failed.';
   SERR_HeaderNotUnderstood         = 'Header "%s" not Understood.';
   SERR_IllegalChar                 = 'Illegal character for that encoding : "%s".';
   SERR_IndexOutOfBound             = 'Index out of bound : %d.';
@@ -36,6 +37,7 @@ resourcestring
   SERR_InvalidMinuteOffetValue     = '"%d" is not a valid minute offset value.';
   SERR_InvalidEmbeddedScopeOperation    = 'Invalid opération on scope, their are no embedded scope.';
   SERR_InvalidParameter            = 'Invalid parameter : "%s".';
+  SERR_InvalidPropertyValue        = 'Invalid property ("%s") value : "%s".';
   SERR_InvalidParameterProc        = 'Invalid parameter : "%s"; Procedure = "%s".';
   SERR_InvalidParameters           = 'Invalid parameters.';
   SERR_InvalidPoolParametersArgs   = 'Invalid pool arguments Min = %d; Max = %d .';
@@ -55,6 +57,7 @@ resourcestring
   SERR_ScopeNotFound                     = 'Scope not found : "%s".';
   SERR_TypeNotRegistered                 = 'Type not registered : "%s".';
   SERR_UnexpectedEndOfData               = 'Unexpected end of data.';
+  SERR_UnknownProperty                   = 'Unknown property : "%s".';
   
 implementation