Comments for Unofficial SOAP Bug Fixes

Unofficial SOAP Bug Fixes

2005-01-21T08:52:50-08:00

Hi,thank you for these great fixes. All fixes are working perfectly for mine. I have a further bug. If you generate the wrapper unit for a webservice, which is use overloaded functions, then delphi creates in the interface funcname(...) funcname1(..)(in this sample two overloaded funtions with the name "funcname")In the initialization-section the wsdl-importer inserts a entry for the mapping from funcname to funcname1. InvRegistry.RegisterExternalMethName(TypeInfo(WSTest), 'funcname', 'funcname1');But the right mapping should be from funcname1 to funcname InvRegistry.RegisterExternalMethName(TypeInfo(WSTest), 'funcname1', 'funcname');Best regards,Falko

re: Unofficial SOAP Bug Fixes

2003-10-23T10:02:56-07:00

Oops!! Good point. Below is Invoker.pas.Regards,Bruneau.{*******************************************************}{ }{ Borland Delphi Visual Component Library }{ Pascal Invoker Support }{ }{ Copyright (c) 2001 Borland Software Corporation }{ }{*******************************************************}unit Invoker;interfaceuses SysUtils, Classes, Typinfo, IntfInfo, InvokeRegistry;type TInterfaceInvoker = class public procedure Invoke(const Obj: TObject; IntfMD: TIntfMetaData; const MethNum: Integer; const Context: TInvContext); constructor Create; end;implementationuses InvConst, InvRules, SOAPConst, Variants;constructor TInterfaceInvoker.Create;begin inherited Create;end;{ PushStackParm Copies an aligned number of bytes specified by ByteCount from the Parm to the current stack. N.B. We leave the bytes on the stack when we exit! Stack parameters come in many different sizes, ranging from 4 bytes to 16 bytes. This function copies a parameter of arbitrary size from a prior stack location (assumed the stack), onto the current stack. On exit, we leave the additional bytes on the stack. We use this to build the parameter list to the server side functions. We don't have to worry about copying bytes at the end of a page, because we assume that Parm is pointing to something higher up on the stack, and aligned on a proper stack boundary.}procedure PushStackParm(Parm: Pointer; ByteCount: Integer);asm { EAX -> Parm (the parameter to be copied) EDX -> ByteCount (the number of bytes of data in Parm) } { We just use a jump table to copy the bits } LEA ECX, @JT{$IFDEF PIC} ADD ECX, EBX ADD ECX, EDX // Assume that ByteCount is a DWORD multiple POP EDX // Remove and save the return address MOV ECX, [ECX] ADD ECX, EBX JMP ECX{$ELSE} ADD ECX, EDX // Assume that ByteCount is a DWORD multiple POP EDX // Remove and save the return address JMP [ECX]{$ENDIF}@L4: PUSH [EAX+12]@L3: PUSH [EAX+8]@L2: PUSH [EAX+4]@L1: PUSH [EAX] PUSH EDX // Push back the saved ret addr RET // All done@JT: DD 0 // 0 bytes (never happens) DD @L1 // 4 bytes DD @L2 // 8 bytes DD @L3 // 12 bytes DD @L4 // 16 bytesend;{ GetFloatReturn Handles the nuances of retrieving the various different sized floating point values from the FPU and storing them in a buffer.}procedure GetFloatReturn(RetP: Pointer; FloatType: TFloatType);asm CMP EDX, ftSingle JE @@Single CMP EDX, ftDouble JE @@Double CMP EDX, ftExtended JE @@Extended CMP EDX, ftCurr JE @@Curr CMP EDX, ftComp JE @@Curr { Same as Curr } { Should never get here :) }@@Single: FSTP DWORD PTR [EAX] WAIT RET@@Double: FSTP QWORD PTR [EAX] WAIT RET@@Extended: FSTP TBYTE PTR [EAX] WAIT RET@@Curr: FISTP QWORD PTR [EAX] WAITend;procedure TInterfaceInvoker.Invoke(const Obj: TObject; IntfMD: TIntfMetaData; const MethNum: Integer; const Context: TInvContext);var MethPos: Integer; Unk: IUnknown; IntfEntry: PInterfaceEntry; IntfVTable: Pointer; RetIsOnStack, RetIsInFPU, RetInAXDX: Boolean; I: Integer; RetP : Pointer; MD : TIntfMethEntry; DataP: Pointer; Temp, Temp1: Integer; RetEAX: Integer; RetEDX: Integer; TotalParamBytes: Integer; ParamBytes: Integer;begin{$IFDEF LINUX} try{$ENDIF} TotalParamBytes := 0; MD := IntfMD.MDA[MethNUm]; if not Obj.GetInterface(IntfMD.IID, Unk) then raise Exception.CreateFmt(SNoInterfaceGUID, [Obj.ClassName, GUIDToString(IntfMD.IID)]); IntfEntry := Obj.GetInterfaceEntry(IntfMD.IID); IntfVTable := IntfEntry.VTable; MethPos := MD.Pos * 4; { Pos is absolute to whole VMT } if MD.ResultInfo <> nil then begin RetIsInFPU := RetInFPU(MD.ResultInfo); RetIsOnStack := RetOnStack(MD.ResultInfo); RetInAXDX := IsRetInAXDX(MD.ResultInfo); RetP := Context.GetResultPointer; end else begin RetIsOnStack := False; RetIsInFPU := False; RetInAXDX := False; end; if MD.CC in [ccCDecl, ccStdCall, ccSafeCall] then begin if (MD.ResultInfo <> nil) and (MD.CC = ccSafeCall) then asm PUSH DWORD PTR [RetP] end; for I := MD.ParamCount - 1 downto 0 do begin DataP := Context.GetParamPointer(I); if IsParamByRef(MD.Params[I].Flags,MD.Params[I].Info, MD.CC) then asm PUSH DWORD PTR [DataP] end else begin ParamBytes := GetStackTypeSize(MD.Params[I].Info, MD.CC); PushStackParm(DataP, ParamBytes); Inc(TotalParamBytes, ParamBytes); end; end; asm PUSH DWORD PTR [Unk] end; if RetIsOnStack and (MD.CC <> ccSafeCall) then asm PUSH DWORD PTR [RetP] end; end else if MD.CC = ccPascal then begin for I := 0 to MD.ParamCount - 1 do begin DataP := Context.GetParamPointer(I); if IsParamByRef(MD.Params[I].Flags,MD.Params[I].Info, MD.CC) then asm PUSH DWORD PTR [DataP] end else begin// PushStackParm(DataP, GetStackTypeSize(MD.Params[I].Info, MD.CC)); ParamBytes := GetStackTypeSize(MD.Params[I].Info, MD.CC); PushStackParm(DataP, ParamBytes); Inc(TotalParamBytes, ParamBytes); end; end; if RetIsOnStack then asm PUSH DWORD PTR [RetP] end; asm PUSH DWORD PTR [Unk] end; end else raise Exception.CreateFmt(SUnsupportedCC, [CallingConventionName[MD.CC]]); if MD.CC <> ccSafeCall then begin asm MOV DWORD PTR [Temp], EAX MOV DWORD PTR [Temp1], ECX MOV EAX, MethPos MOV ECX, [IntfVtable] MOV ECX, [ECX + EAX] CALL ECX MOV DWORD PTR [RetEAX], EAX MOV DWORD PTR [RetEDX], EDX MOV EAX, DWORD PTR [Temp] MOV ECX, DWORD PTR [Temp1] end; end else begin asm MOV DWORD PTR [Temp], EAX MOV DWORD PTR [Temp1], ECX MOV EAX, MethPos MOV ECX, [IntfVtable] MOV ECX, [ECX + EAX] CALL ECX CALL System.@CheckAutoResult MOV DWORD PTR [RetEAX], EAX MOV DWORD PTR [RetEDX], EDX MOV EAX, DWORD PTR [Temp] MOV ECX, DWORD PTR [Temp1] end; end; // If we're cdecl, we're responsible for cleanup up the stack. if MD.CC = ccCDecl then asm MOV EAX, DWORD PTR [TotalParamBytes] ADD ESP, EAX end; if MD.ResultInfo <> nil then begin if MD.CC <> ccSafeCall then begin if RetIsInFPU then begin GetFloatReturn(RetP, GetTypeData(MD.ResultInfo).FloatType); end else if not RetIsOnStack then begin if RetInAXDX then asm PUSH EAX PUSH ECX MOV EAX, DWORD PTR [RetP] MOV ECX, DWORD PTR [RetEAX] MOV [EAX], ECX MOV ECX, DWORD PTR [RetEDX] MOV [EAX + 4], ECX POP ECX POP EAX end else asm PUSH EAX PUSH ECX MOV EAX, DWORD PTR [RetP] MOV ECX, DWORD PTR [RetEAX] MOV [EAX], ECX POP ECX POP EAX end; end; end; end;{$IFDEF LINUX} except // This little bit of code is required to reset the stack back to a more // resonable state since the exception unwinder is completely unaware of // the stack pointer adjustments made in this function. asm MOV EAX, DWORD PTR [TotalParamBytes] ADD ESP, EAX end; raise; end;{$ENDIF}end;end.

re: Unofficial SOAP Bug Fixes

2003-10-07T05:10:35-07:00

Hi,I'm facing the same problem on C++Builder, did you find out how to handle this?Thanks in advanceG. Ehrlich (gal@tti-telecom.com)

Unofficial SOAP Bug Fixes

2003-09-16T17:35:26-07:00

Hi,I use Borland C++ Builder 6 and have made the change to fix the single param problem (in OPToSOAPDomConv.pas).How do I now apply these changes??Thanks.

Unofficial SOAP Bug Fixes

2003-08-14T08:46:53-07:00

Unfortunately, the unit Invoker.pas does not included in Delphi 6 sources, so it is not possible to recompile InvokeRegistry, and fix to WideString memory leaks cannot be applied :-((

Unofficial SOAP Bug Fixes

2003-02-18T07:03:38-08:00

Dear Sirs,I have some trouble with a Client DataSet, with 2 params. Like so:CommandText='select * from retourcube(:pFROM,:pUNTIL)'. Fetchparams and Active=true work fine AT DESIGN TIME. At RUNTIME however, I get the error 'Variant Or Safe Array index out of bounds'.I've noticed that AT DESIGN TIME, the SOAP request contains NO CR/LF characters.At RUNTIME however, each element is separated by a #$A+spaces.This messes up the Node.Childcount in the code beneath, resulting in a Result[I] being invalid....I thinkIf my diagnose is wrong, please inform me of a workaround.function TSOAPDomConv.ReadVarArrayDim(Node: IXMLNode; IsVarVArray: Boolean; VT: TVarType): Variant;var Count, I: Integer; SoapTypeInfo: PTypeInfo; ChildNode: IXMLNode; TypeURI, TypeName: InvString;begin { Get count of ntElement children node } Count := ntElementChildCount(Node); if Count = 0 then begin Result := NULL; Exit; end; { Also, we could use the TVarType to (re)create a Variant of the original array type; Using VarVariant, however, is more resilient; and as long as no one cracks the Variant open - i.e. casts to TVarData and starts accessing members directly - we're safe. Sure hopes no one does that!! }--->>> Result := VarArrayCreate([0, Count -1], VarVariant); <<<<---- for I := 0 to Node.ChildNodes.Count -1 do begin ChildNode := Node.ChildNodes[I]; { Skip non-valid nodes } if ChildNode.NodeType <> ntElement then continue; IsVarVArray := IsNodeAVarArray(ChildNode, VT); if IsVarVarray or (ntElementChildCount(ChildNode) > 1) then begin Result[I] := ReadVarArrayDim(ChildNode, IsVarVArray, VT); end else begin if not NodeIsNULL(ChildNode) then begin GetElementType(ChildNode, TypeURI, TypeName); SoapTypeInfo := RemTypeRegistry.XSDToTypeInfo(TypeURI, TypeName); if SoapTypeInfo = nil then SoapTypeInfo := TypeInfo(System.WideString); { Handle 'dateTime' } if IsXMLDateTimeTypeInfo(SoapTypeInfo) {(SoapTypeInfo.Kind = tkClass) and (GetTypeData(SoapTypeInfo).ClassType = TXSDateTime)} then begin Result[I] := XMLTimeToDateTime(ChildNode.Text); end else Result[I] := TypeTranslator.CastSoapToVariant(SoapTypeInfo, ChildNode.Text); end else Result[I] := NULL; end; end;end;