Unofficial SOAP Bug Fixes

Abstract: WebServices/SOAP updates by Bruneau Babet, one of the WebServices R&D developers

Unofficial SOAP Bug Fixes

By Bruneau Babet bbabet@nospam.borland.com
Remove the nospam. from email address when mailing me

In general, applying these fixes require you to rebuild some of the VCL. The easiest way to do this, is to go to Tools | Environment Options and from the Library tab add $(DELPHI)\Source\Internet;$(DELPHI)\Source\SOAP to your Library Path.

These fixes are unofficial, are not supported by Borland, and are to be used at your own risk.

Quick Jumps:

The case of serialized Boolean members of a complex type is incorrect (i.e. 'True'/'False' instead of 'true'/'false')
Description:
When serializing Boolean members of a TRemotable-descendant class, the value of the latter are sent as 'True' or 'False'. Some SOAP implementations, including Delphi's, will accept these values. However, many will complain, and for good reason, since the legal literal representations of a boolean are '1', '0', 'true' or 'false'.

Fix:
The fix for this problem is to modify the following function in OPToSOAPDomConv.pas as follows:

function TSOAPDomConv.GetObjectPropAsText(Instance: TObject;
  PropInfo: PPropInfo): WideString;
var
 I: LongInt;
 E: Extended;
 I64: Int64;
begin
  case (PropInfo.PropType)^.Kind of
    tkInteger:
      begin
        I := GetOrdProp(Instance, PropInfo);
        Result := IntToStr(I);
      end;
    tkFloat:
      begin
        E := GetFloatProp(Instance, PropInfo);
        Result := FloatToStrEx(E);
      end;
    tkWString:
      Result := GetWideStrProp(Instance, PropInfo);
    tkString,
    tkLString:
      Result := GetStrProp(Instance, PropInfo);
    tkInt64:
      begin
        I64 := GetInt64Prop(Instance, PropInfo);
        Result := IntToStr(I64);
      end;
    tkEnumeration:
Result := GetEnumProp(Instance, PropInfo);
begin Result := GetEnumProp(Instance, PropInfo); if PropInfo.PropType^ = TypeInfo(System.Boolean) then Result := Lowercase(Result); end;
tkChar: begin I := GetOrdProp(Instance, PropInfo); Result := InvString(Char(I)); end; tkWChar: begin I := GetOrdProp(Instance, PropInfo); Result := InvString(WideChar(I)); end; tkClass: ; tkSet, tkMethod, tkArray, tkRecord, tkInterface, tkDynArray, tkVariant: raise ESOAPDomConvertError.CreateFmt(SUnexpectedDataType, [KindNameArray[(PropInfo.PropType)^.Kind]]); end; end;

Memory leak in Servers that expose WideString parameters
Description:
Delphi SOAP fails to delete WideStrings allocated by the framework on behalf of Servers that expose WideString parameters.

Fix:
The fix for this problem is to modify InvokeRegistry.pas as follows:

type
	
  {...}	
	
  TDataContext = class
  protected
    FObjsToDestroy: array of TObject;
    DataOffset: Integer;
    Data: array of Byte;
    DataP: array of Pointer;
    VarToClear: array of Pointer;
    DynArrayToClear: array of TDynToClear;
    StrToClear: array of Pointer;
WStrToClear: array of Pointer;
public constructor Create; destructor Destroy; override; function AllocData(Size: Integer): Pointer; procedure SetDataPointer(Index: Integer; P: Pointer); function GetDataPointer(Index: Integer): Pointer; procedure AddObjectToDestroy(Obj: TObject); procedure RemoveObjectToDestroy(Obj: TObject); procedure AddDynArrayToClear(P: Pointer; Info: PTypeInfo); procedure AddVariantToClear(P: PVarData); procedure AddStrToClear(P: Pointer);
procedure AddWStrToClear(P: Pointer);
end; implementation {...} procedure TDataContext.AddStrToClear(P: Pointer); var I: Integer; begin { If this string is in the list already, we're set } for I := 0 to Length(StrToClear) -1 do if StrToClear[I] = P then Exit; I := Length(StrToClear); SetLength(StrToClear, I + 1); StrToClear[I] := P; end;
procedure TDataContext.AddWStrToClear(P: Pointer); var I: Integer; begin { If this WideString is in the list already, we're set } for I := 0 to Length(WStrToClear) -1 do if WStrToClear[I] = P then Exit; I := Length(WStrToClear); SetLength(WStrToClear, I + 1); WStrToClear[I] := P; end;
constructor TDataContext.Create; begin inherited; end; destructor TDataContext.Destroy; var I: Integer; P: Pointer; begin { Clean up objects we've allocated } for I := 0 to Length(FObjsToDestroy) - 1 do begin if (FObjsToDestroy[I] <> nil) and (FObjsToDestroy[I].InheritsFrom(TRemotable)) then begin TRemotable(FObjsToDestroy[I]).Free; end; end; SetLength(FObjsToDestroy, 0); { Clean Variants we allocated } for I := 0 to Length(VarToClear) - 1 do begin if Assigned(VarToClear[I]) then Variant( PVarData(VarToClear[I])^) := NULL; end; SetLength(VarToClear, 0); { Clean up dynamic arrays we allocated } for I := 0 to Length(DynArrayToClear) - 1 do begin if Assigned(DynArrayToClear[I].P) then begin P := Pointer( PInteger(DynArrayToClear[I].P)^); DynArrayClear(P, DynArrayToClear[I].Info) end; end; SetLength(DynArrayToClear, 0); { Clean up strings we allocated } for I := 0 to Length(StrToClear) - 1 do begin if Assigned(StrToClear[I]) then PString(StrToClear[I])^ := ''; end; SetLength(StrToClear, 0);
{ Clean up WideStrings we allocated } for I := 0 to Length(WStrToClear) - 1 do begin if Assigned(WStrToClear[I]) then PWideString(WStrToClear[I])^ := ''; end; SetLength(WStrToClear, 0);
inherited; end; {...} procedure TInvContext.AllocServerData(const MD: TIntfMethEntry); var I: Integer; Info: PTypeInfo; P: Pointer; begin for I := 0 to MD.ParamCount - 1 do begin P := AllocData(GetTypeSize(MD.Params[I].Info)); SetParamPointer(I, P); if MD.Params[I].Info.Kind = tkVariant then begin Variant(PVarData(P)^) := NULL; AddVariantToClear(PVarData(P)); end else if MD.Params[I].Info.Kind = tkDynArray then begin AddDynArrayToClear(P, MD.Params[I].Info); end else if MD.Params[I].Info.Kind = tkLString then begin PString(P)^ := ''; AddStrToClear(P);
end else if MD.Params[I].Info.kind = tkWString then begin PWideString(P)^ := ''; AddWStrToClear(P);
end; end; if MD.ResultInfo <> nil then begin Info := MD.ResultInfo; case Info^.Kind of tkLString: begin P := AllocData(sizeof(PString)); PString(P)^ := ''; AddStrToClear(P); end;
tkWString: begin P := AllocData(sizeof(PWideString)); PWideString(P)^ := ''; AddWStrToClear(P); end;
tkInt64: P := AllocData(sizeof(Int64)); tkVariant: begin P := AllocData(sizeof(TVarData)); Variant( PVarData(P)^ ) := NULL; AddVariantToClear(PVarData(P)); end; tkDynArray: begin P := AllocData(GetTypeSize(Info)); AddDynArrayToClear(P, MD.ResultInfo); end; else P := AllocData(GetTypeSize(Info)); end; SetResultPointer(P); end; end;

Error publishing WebService's WSDL when MSXML4 is installed
Description:
As of SP#2, Delphi's msxmldom unit will attempt to use MSXMLDOM v4.0 if the latter is present. However, this may cause the creation and Publishing of a WSDL document by a Delphi WebService to fail. The typical symptom of this failure is that the client requesting the WSDL gets back an HTML document instead; and the document contains the following error message:

        Error: This name may not contain the ':' character

Fix:
The fix to this problem is to modify XMLDoc.pas as follows: (Note that this file is in the Source/Internet directory)

	
function TXMLNode.FindNamespaceDecl(const NamespaceURI: DOMString): IXMLNode;
var
  I: Integer;
Attr: IXMLNode;
begin Result := nil; for I := 0 to AttributeNodes.Count - 1 do
if SameNamespace(VarToStr(AttributeNodes[I].NodeValue), NamespaceURI) and (AttributeNodes[I].Prefix = SXMLNS) then
begin Attr := AttributeNodes[I]; if SameNamespace(VarToStr(Attr.NodeValue), NamespaceURI) and ((Attr.Prefix = SXMLNS) or (Attr.NodeName = SXMLNS)) then
begin Result := AttributeNodes[I]; Break; end;
end;
if (Result = nil) and Assigned(FParentNode) then Result := FParentNode.FindNamespaceDecl(NamespaceURI); end; procedure TXMLNode.DeclareNamespace(const Prefix, URI: DOMString); begin if Prefix <> '' then SetAttributeNS(SXMLNS+NSDelim+Prefix, SXMLNamespaceURI, URI) else SetAttributeNS(SXMLNS, SXMLNamespaceURI, URI); end; function TXMLNode.GetPrefixedName(const Name, NamespaceURI: DOMString): DOMString; var NSDecl: IXMLNode; begin { The method adds a prefix to a localname based on the specified URI. If there is no corresponding namespace already declared or if the name is already prefixed, then nothing is done. } if (doAutoPrefix in OwnerDocument.Options) and not IsPrefixed(Name) then begin NSDecl := FindNamespaceDecl(NamespaceURI);
if Assigned(NSDecl) and (NSDecl.LocalName <> '') then
if Assigned(NSDecl) and (NSDecl.NodeName <> SXMLNS) then
Result := MakeNodeName(NSDecl.LocalName, Name) else Result := Name; end else Result := Name; end;

HTTPRIO component reloads a Service's WSDL for each WebService call
Description:
When using the WSDLLocation property of a THTTPRIO to invoke a Web Service, each invokation results in a 'GET' of the WSDL document. NOTE: This bug was introduced when proxy support was added for the retrieval of the WSDL.

Fix:
The fix to this problem is to modify WSDLNode.pas as follows:


{ ActivateWSDL }
function ActivateWSDL(WSDL: TWSDLItems; const Name: string; const Password: string; const Proxy: string): Boolean;
begin
  Result := True;
  try
{ if not WSDL.Active then begin }
if not WSDL.Active then begin
WSDL.StreamLoader.UserName := Name; WSDL.StreamLoader.Password := Password; WSDL.StreamLoader.Proxy := Proxy; WSDL.Load(WSDL.FileName);
{ end }
end;
except on E: EDOMParseError
begin Result := False;
raise EWSDLLoadException.CreateFmt(SWSDLError, [WSDL.Filename, E.Message]);
end; on Ex: Exception do begin Result := False; raise Ex; end;
end; end;

(Ole)Variant array of one element are incorrectly deserialized
Description:
When a WebService Server or Client receives data that's deserialized into an OleVariant or Variant type, if the XML data sent is an array of a single element, the deserialization logic fails to see the data as an array; This causes a problem if the consumer of the (Ole)Variant expects an array. This problem may cause a MIDAS FetchParams of one parameter to fail, for example (while the call with two or more parameters succeed).

Fix:
The fix to this problem is to modify OPToSOAPDomConv.pas as follows:


procedure TSOAPDomConv.WriteVarArray(RootNode, Node: IXMLNode; Name: InvString; V: Variant);
var
  I, DimCount: Integer;
  LoDim, HiDim, Indices: array of integer;
  V1: Variant;
  ElemNode: IXMLNode;
  VAPropSet: Boolean;
begin
  if  not VarIsArray(V) then
  begin
    WriteVariant(RootNode, Node, Name, V);
  end
  else
  begin
    ElemNode := Node.AddChild(Name);
    DimCount := VarArrayDimCount(V);
    SetLength(LoDim, DimCount);
    SetLength(HiDim, DimCount);
    for I := 1 to DimCount do
    begin
      LoDim[I - 1] := VarArrayLowBound(V, I);
      HiDim[I - 1] := VarArrayHighBound(V, I);
    end;
    SetLength(Indices, DimCount);
    for I := 0 to DimCount - 1 do
      Indices[I] := LoDim[I];
    VAPropSet := False;
    while True do
    begin
      V1 := VarArrayGet(V, Indices);
      if VarIsArray(V1) and not VarIsType(V1, varArray or varByte) then
WriteVarArray(RootNode, ElemNode, SDefVariantElemName, V1); else
begin WriteVarArray(RootNode, ElemNode, SDefVariantElemName, V1); ElemNode.SetAttributeNS(SVarArrayType, SBorlandTypeNamespace, VarType(V)); end else
begin WriteVariant(RootNode, ElemNode, SDefVariantElemName, V1); if not VAPropSet then begin
SetAttributeNS(RootNode, ElemNode, SVarArrayType, SBorlandTypeNamespace, IntToStr(VarType(V)));
ElemNode.SetAttributeNS(SVarArrayType, SBorlandTypeNamespace, VarType(V)); VAPropSet := True; end; end; Inc(Indices[DimCount - 1]); if Indices[DimCount - 1] > HiDim[DimCount - 1] then for i := DimCount - 1 downto 0 do if Indices[i] > HiDim[i] then begin if i = 0 then Exit; Inc(Indices[i - 1]); Indices[i] := LoDim[i]; end; end; end; end;

Bad XML Namespaces for 'dateTime' and other XSBuiltIn types when members of Complex Type
Description:
dateTime, decimal and other types implemented as a TXSxxxx class (in XSBuiltIn.pas) have incorrect namespaces when they are members of a complex (i.e. TRemotable-descendant) type.

Fix:
The fix to this problem is to modify OPToSOAPDomConv.pas as follows:


function TSOAPDomConv.CreateObjectNode(Instance: TObject; RootNode, Node: IXMLNode;
                                       Name,  URI: InvString; UsePrefix: Boolean): InvString;

var

	{...}

          end
          else
          begin
            ClsType := GetTypeData((PropList[I].PropType)^).ClassType;
            RemClassRegistry.ClassToURI(ClsType, ElemURI, TypeName, IsScalar);
            MultiRef := MultiRefObject(ClsType);

            if IsScalar then
            begin
ElemNode := InstNode.AddChild(ExtPropName); if not RemTypeRegistry.TypeInfoToXSD((PropList[I].PropType)^, ElemURI, TypeName) then raise ESOAPDomConvertError.CreateFmt(SRemTypeNotRegistered,[GetTypeData((PropList[I].PropType)^).ClassType.ClassName]); if not GetTypeData((PropList[I].PropType)^).ClassType.InheritsFrom(TRemotable) then raise ESOAPDomConvertError.CreateFmt(SScalarFromTRemotableS, [GetTypeData((PropList[I].PropType)^).ClassType.ClassName]); {$IFDEF OPENDOM} ElemNode.SetAttributeNS(SSoapType, XMLSchemaInstNameSpace, TypeName); {$ELSE} AttrNodePre := FindPrefixForURI(RootNode, Node, XMLSchemaInstNamespace); ElemNode.Attributes[MakeNodeName(AttrNodePre, SSoapType)] := TypeName; {$ENDIF} ElemNode.Text := TRemotableXS(Obj).NativeToXS;
{ Create node } ElemNode := CreateScalarNodeXS(RootNode, InstNode, ExtPropName, ElemURI, TypeName, TRemotableXS(Obj).NativeToXS, True);
end else begin if not MultiRef then begin if IsObjectWriting(Obj) then raise ESOAPDomConvertError.Create(SNoSerializeGraphs); {...} finally FreeMem(PropList, Count * SizeOf(Pointer)); end; end; end;

 

Links:



Server Response from: ETNASC03