I am writing a SOAP client in Delphi 2007 to do a simple Customs release check. I send the SOAP server some information and I am supposed to either receive details back about the Customs release or a SOAP fault if the server could not locate the information I sent it. The first part works fine but processing of the fault does not. The WSDL specifies a custom SOAP exception (this is included by the main WSDL - the whole WSDL is not shown):
<?xml version="1.0" encoding="ISO-8859-1"?>
<xsd:schema targetNamespace="http://trips.crownagents.com/wsexception/message"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns="http://trips.crownagents.com/wsexception/message">
<xsd:element name="WSException" type="WSException" nillable="true"/>
<xsd:complexType name="WSException">
<xsd:sequence>
<xsd:element name="ErrorCode" type="xsd:string" minOccurs="0" maxOccurs="1"/>
<xsd:element name="ErrorDescription" type="xsd:string" minOccurs="0" maxOccurs="1"/>
<xsd:element name="Stack" type="xsd:string" minOccurs="0" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
And the SOAP response I get back seems to reference the exception:
<?xml version="1.0" encoding="UTF-8"?>
<env:Envelope xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:ns0="http://trips.crownagents.com/wsexception/message"
xmlns:ns1="http://trips.crownagents.com/external/customs/release/message"
xmlns:ns2="http://trips.crownagents.com/external/common/message">
<env:Body>
<env:Fault xsi:type="env:Fault">
<faultcode>env:Server</faultcode>
<faultstring xsi:nil="1"/>
<detail>
<ans1:WSExceptionResponse xmlns:ans1="http://msgsvr.trips.crownagents.com/">
<ErrorCode>0002</ErrorCode>
<ErrorDescription>Invalid Declaration</ErrorDescription>
<Stack>getSingleResult() did not retrieve any entities.</Stack>
</ans1:WSExceptionResponse>
</detail>
</env:Fault>
</env:Body>
</env:Envelope>
But, my code never sees the WSExceptionResponse. Instead, I get a generic ERemotableException:
Try
Res := Rel.releaseStatus(RelInfo);
Except
On E: WSExceptionResponse Do // This never fires
Status('Release check error (' + E.ErrorCode + ' - ' +
E.ErrorDescription + ').', True);
Else
Status('Release check error (' + Exception(ExceptObject).Message +
').', True);
End;
I have read that there are a couple of issues with SOAP processing in Delphi 2007 (https://groups.google.com/forum/#!msg/borland.public.delphi.webservices.soap/71t3P-vPMbk/qw9JVTEVS3YJ) and I have changed the OPToSOAPDomConv.pas file to revert it as per the suggestion but that doesn't help. Does anyone have any ideas as to what I might be doing wrong?
For anyone else still using Delphi 2007 that comes across this question, this is how I fixed this issue.
First, copy OPToSOAPDomConv.pas and InvokeRegistry.pas from the Delphi source directory (\Program Files< (x86)>\CodeGear\RAD Studio\5.0\source\Win32\soap) to your project directory. Add these two files to your project as you will be customizing the source and you will need these to recompile with your project instead of using the precompiled DCUs that come with Delphi.
In the OPToSOAPDomConv.pas file, find the ProcessFault procedure and replace it with the following:
procedure TOPToSoapDomConvert.ProcessFault(FaultNode: IXMLNode);
var
FA, FC, FD, FS, CustNode: IXMLNode;
I, J: Integer;
AMessage: WideString;
AClass: TClass;
URI, TypeName: WideString;
Count: Integer;
PropList: PPropList;
Ex: ERemotableException;
function GetNodeURIAndName(const Node: IXMLNode; var TypeURI,
ElemName: InvString): boolean;
var
Pre: InvString;
begin
ElemName := Node.NodeName;
if IsPrefixed(ElemName) then
begin
Pre := ExtractPrefix(ElemName);
ElemName := ExtractLocalName(ElemName);
TypeURI := Node.FindNamespaceURI(Pre);
end
else
TypeURI := Node.NamespaceURI;
Result := True;
end;
begin
FA := nil;
FC := nil;
FD := nil;
FS := nil;
Ex := nil;
for I := 0 to FaultNode.ChildNodes.Count - 1 do
begin
if SameText(ExtractLocalName(FaultNode.ChildNodes[I].NodeName), SSoapFaultCode) then
FC := FaultNode.ChildNodes[I]
else if SameText(ExtractLocalName(FaultNode.ChildNodes[I].NodeName), SSoapFaultString) then
FS := FaultNode.ChildNodes[I]
else if SameText(ExtractLocalName(FaultNode.ChildNodes[I].NodeName), SSoapFaultDetails) then
FD := FaultNode.ChildNodes[I]
else if SameText(ExtractLocalName(FaultNode.ChildNodes[I].NodeName), SSoapFaultActor) then
FA := FaultNode.ChildNodes[I];
end;
{ Retrieve message from FaultString node }
if FS <> nil then
AMessage := FS.Text;
{ If there's a <detail> node, try to map it to a registered type }
if FD <> nil then
begin
{ Some SOAP stacks, including Delphi6 and others (see
http://softwaredev.earthweb.com/script/article/0,,12063_641361_2,00.html)
use the approach of putting custom fault info right at the <detail> node:
Listing 4 - Application Fault Details
<SOAP-ENV:Fault>
<faultcode>300</faultcode>
<faultstring>Invalid Request</faultstring>
<runcode>1</runcode>
<detail xmlns:e="GetTemperatureErr-URI"
xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
xsi:type="e:GetTemperatureFault">
<number>5575910</number>
<description>Sensor Failure</description>
<file>GetTemperatureClass.cpp</file>
<line>481</line>
</detail>
</SOAP-ENV:Fault>
However, much more common is the approach where the type and namespace
are on the childnode of the <detail> node. Apache, MS and the SOAP spec.
seem to lean towards that approach:
Example 10 from the SOAP 1.1 Spec:
<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<SOAP-ENV:Fault>
<faultcode>SOAP-ENV:Server</faultcode>
<faultstring>Server Error</faultstring>
<detail>
<e:myfaultdetails xmlns:e="Some-URI">
<message>My application didn't work</message>
<errorcode>1001</errorcode>
</e:myfaultdetails>
</detail>
</SOAP-ENV:Fault>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
For interop reasons we favor the later approach but we'll support both here!!
}
CustNode := nil;
if GetElementType(FD, URI, TypeName) then
CustNode := FD
else
begin
if ntElementChildCount(FD) > 0 then
begin
CustNode := ntElementChild(FD, 0);
if not GetElementType(CustNode, URI, TypeName) and
not GetNodeURIAndName(CustNode, URI, TypeName) then
CustNode := nil;
end;
end;
if (CustNode <> nil) then
begin
AClass := RemClassRegistry.URIToClass(URI, TypeName);
if AClass <> nil then
begin
if AClass.InheritsFrom(ERemotableException) then
begin
Ex := ERemotableExceptionClass(AClass).Create(AMessage);
LoadObject(Ex, FaultNode, CustNode);
end;
end;
end;
end;
{ Create default SOAP invocation exception if no suitable class was found }
if Ex = nil then
Ex := ERemotableException.Create(AMessage);
if FA <> nil then
Ex.FaultActor := FA.Text;
if FC <> nil then
Ex.FaultCode := FC.Text;
if FD <> nil then
Ex.FaultDetail := FD.XML;
raise Ex;
end;
Next, find the GetElementType function and replace it with the following:
function TSOAPDomConv.GetElementType(Node: IXMLNode; var TypeURI, TypeName: InvString): Boolean;
var
Idx: Integer;
S : InvString;
V: Variant;
Pre: InvString;
begin
TypeURI := '';
TypeName := '';
Result := False;
if (Node.NamespaceURI = SSoap11EncodingS5) and
(Node.LocalName = SSoapEncodingArray) then
begin
TypeURI := SSoap11EncodingS5;
TypeName := SSoapEncodingArray;
Result := True;
end
else
begin
V := GetTypeBySchemaNS(Node, XMLSchemaInstNameSpace);
if VarIsNull(V) then
V := Node.GetAttribute(SSoapType);
if not VarIsNull(V) then
begin
S := V;
Idx := Pos(':', S); { do not localize }
if Idx <> 0 then
begin
TypeName := Copy(S, Idx + 1, High(Integer));
Pre := Copy(S, 1, Idx - 1);
TypeURI := Node.FindNamespaceURI(Pre);
end
else
begin
TypeName := S;
TypeURI := '';
end;
Result := True;
end;
end
end;
Finally, open the InvokeRegistry.pas file and find the GetExternalPropName function. Change the line that says:
if Info.Kind = tkClass then
to this:
if (Info.Kind = tkClass) and Assigned(GetTypeData(info).ParentInfo) then
Compile and run your application and you should be good.
All credit for this goes to the users in this thread http://www.codenewsfast.com/cnf/article/859054074/permalink.art-ng1920q2368 and this one http://www.delphigroups.info/2/7/342954.html.
Related
I search to connect to a Web service but when I call the method I obtain this error "Element "OutputObj" does not contain a single text node'.
This is the Unit I create importing my WSDL file:
// ************************************************************************ //
// The types declared in this file were generated from data read from the
// WSDL File described below:
// WSDL : D:\SVN\XML IE815\WSDL\DispatcherBean.wsdl
// >Import : D:\SVN\XML IE815\WSDL\DispatcherBean.wsdl>0
// >Import : D:\SVN\XML IE815\WSDL\DispatcherBean.wsdl>1
// Encoding : UTF-8
// Version : 1.0
// (16/07/2014 9.33.06 - - $Rev: 25127 $)
// ************************************************************************ //
unit UNDispatcherBean;
interface
uses InvokeRegistry, SOAPHTTPClient, SOAPHTTPTrans, Types, XSBuiltIns;
const
IS_OPTN = $0001;
IS_UNBD = $0002;
IS_NLBL = $0004;
IS_UNQL = $0008;
IS_REF = $0080;
type
// ************************************************************************ //
// The following types, referred to in the WSDL document are not being represented
// in this file. They are either aliases[#] of other types represented or were referred
// to but never[!] declared in the document. The types from the latter category
// typically map to predefined/known XML or Embarcadero types; however, they could also
// indicate incorrect WSDL documents that failed to declare or import a schema type.
// ************************************************************************ //
// !:anyType - "http://www.w3.org/2001/XMLSchema"[Gbl]
// !:string - "http://www.w3.org/2001/XMLSchema"[Gbl]
// !:base64Binary - "http://www.w3.org/2001/XMLSchema"[Gbl]
MessageDTO = class; { "http://dto.domest.it.sogei"[GblCplx] }
XmlDTO = class; { "http://dto.domest.it.sogei"[GblCplx] }
ArrayOfXmlDTO = array of XmlDTO; { "http://dto.domest.it.sogei"[GblCplx] }
// ************************************************************************ //
// XML : MessageDTO, global, <complexType>
// Namespace : http://dto.domest.it.sogei
// ************************************************************************ //
MessageDTO = class(TRemotable)
private
FinputObj: Variant;
FoutputObj: Variant;
FserviceID: string;
FxmlList: ArrayOfXmlDTO;
public
destructor Destroy; override;
published
property inputObj: Variant Index (IS_NLBL or IS_UNQL) read FinputObj write FinputObj;
property outputObj: Variant Index (IS_NLBL or IS_UNQL) read FoutputObj write FoutputObj;
property serviceID: string Index (IS_NLBL or IS_UNQL) read FserviceID write FserviceID;
property xmlList: ArrayOfXmlDTO Index (IS_NLBL or IS_UNQL) read FxmlList write FxmlList;
end;
// ************************************************************************ //
// XML : XmlDTO, global, <complexType>
// Namespace : http://dto.domest.it.sogei
// ************************************************************************ //
XmlDTO = class(TRemotable)
private
Fxml: TByteDynArray;
published
property xml: TByteDynArray Index (IS_UNQL) read Fxml write Fxml;
end;
// ************************************************************************ //
// Namespace : http://dispatcher.domest.it.sogei
// soapAction: dispatcher
// transport : http://schemas.xmlsoap.org/soap/http
// style : document
// binding : DispatcherBeanSoapBinding
// service : DispatcherBeanService
// port : DispatcherBean
// URL : https://ws.agenziadogane.it/DomestRouter/services/DispatcherBean
// ************************************************************************ //
DispatcherBean = interface(IInvokable)
['{2D4F3F8E-969E-CF9A-EBAA-1C558EEF5A88}']
function dispatcher(const messaggio: MessageDTO): MessageDTO; stdcall;
end;
function GetDispatcherBean(UseWSDL: Boolean=System.False; Addr: string=''; HTTPRIO: THTTPRIO=nil; PmTlmAmbiente: Integer=0): DispatcherBean;
implementation
uses SysUtils;
function GetDispatcherBean(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO; PmTlmAmbiente: Integer): DispatcherBean;
{PmTlmAmbiente
0 = Ambiente di addestramento
1 = Ambiente reale}
const
defWSDL_test = 'https://wstest.agenziadogane.it/DomestRouter/services/DispatcherBean/?wsdl';
defWSDL_real = 'https://ws.agenziadogane.it/DomestRouter/services/DispatcherBean/?wsdl';
defSvc = 'DispatcherBeanService';
defPrt = 'DispatcherBean';
defURL_real = 'https://ws.agenziadogane.it/DomestRouter/services/DispatcherBean';
defURL_test = 'https://wstest.agenziadogane.it/DomestRouter/services/DispatcherBean';
var
RIO: THTTPRIO;
begin
Result := nil;
if (Addr = '') then
begin
if UseWSDL then
begin
// ambiente addestramento
if PmTlmAmbiente = 0 then
Addr := defWSDL_test;
// ambiente reale
if PmTlmAmbiente = 0 then
Addr := defWSDL_real;
end
else
begin
// ambiente addestramento
if PmTlmAmbiente = 0 then
Addr := defURL_test;
// ambiente reale
if PmTlmAmbiente = 1 then
Addr := defURL_real;
end;
end;
if HTTPRIO = nil then
RIO := THTTPRIO.Create(nil)
else
RIO := HTTPRIO;
try
Result := (RIO as DispatcherBean);
if UseWSDL then
begin
RIO.WSDLLocation := Addr;
RIO.Service := defSvc;
RIO.Port := defPrt;
end else
RIO.URL := Addr;
finally
if (Result = nil) and (HTTPRIO = nil) then
RIO.Free;
end;
end;
destructor MessageDTO.Destroy;
var
I: Integer;
begin
for I := 0 to System.Length(FxmlList)-1 do
SysUtils.FreeAndNil(FxmlList[I]);
System.SetLength(FxmlList, 0);
inherited Destroy;
end;
initialization
InvRegistry.RegisterInterface(TypeInfo(DispatcherBean), 'http://dispatcher.domest.it.sogei', 'UTF-8');
InvRegistry.RegisterDefaultSOAPAction(TypeInfo(DispatcherBean), 'dispatcher');
InvRegistry.RegisterInvokeOptions(TypeInfo(DispatcherBean), ioDocument);
RemClassRegistry.RegisterXSInfo(TypeInfo(ArrayOfXmlDTO), 'http://dto.domest.it.sogei', 'ArrayOfXmlDTO');
RemClassRegistry.RegisterXSClass(MessageDTO, 'http://dto.domest.it.sogei', 'MessageDTO');
RemClassRegistry.RegisterXSClass(XmlDTO, 'http://dto.domest.it.sogei', 'XmlDTO');
end.
This is the code to call the Web Service method:
Procedure PrcSendSOAPRequest(const ServiceID:string; InputObj: Variant; PmPathXML: string);
{ServiceId
D1 : richiesta di Invio Draft IE815
D2 : richiesta Esito Invio Draft IE815 (IE801)
D3 : richiesta di Annullamento (IE810)
D4 : richiesta di Cambio Destinazione (IE813)
D5 : rischiesta di invio Appuramento (IE818)
D6 : richiesta di Rigetto (IE819)
InputObj
se ServiceID D2 : Protocollo di cui si vuole conoscere l'esito
}
var
FMEXPTXTEAD: TFMEXPTXTEAD;
SOAP_RequestMsg : MessageDTO;
SOAP_ResponseMsg : MessageDTO;
XMLDto_Element : XmlDTO;
XMLDtoArray : ArrayOfXmlDTO;
begin
FMEXPTXTEAD := TFMEXPTXTEAD.Create(Application);
try
with FMEXPTXTEAD do
begin
// richiesta di Invio Draft IE815
if ServiceID = D1 then
begin
XMLDto_Element := XmlDTO.Create;
SOAP_RequestMsg := MessageDTO.Create;
SOAP_ResponseMsg := MessageDTO.Create;
try
XMLDto_Element.xml := StringToByteArray(PmPathXML);
SetLength(XMLDtoArray, 1);
XMLDtoArray[0] := XMLDto_Element;
// MESSAGGIO DI RICHIESTA
SOAP_RequestMsg.serviceID := ServiceID;
SOAP_RequestMsg.xmlList := XMLDtoArray;
// MESSAGGIO DI RISPOSTA
SOAP_ResponseMsg := GetDispatcherBean(False,'',HTTPRIO1,0).dispatcher(SOAP_RequestMsg);
// LETTURA DEL MESSAGGIO DI RISPOSTA
PrcReadSOAPResponse(D1,SOAP_ResponseMsg);
finally
begin
XMLDto_Element.Free;
SOAP_RequestMsg.Destroy;
SOAP_ResponseMsg.Destroy;
end;
end;
end;
end;
finally
FMEXPTXTEAD.Close;
end;
and this is the XML Response from the Web Service:
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/">
<soapenv:Body>
<ns2:dispatcherResponse xmlns:ns2="http://dispatcher.domest.it.sogei">
<dispatcherReturn>
<inputObj xsi:nil="true" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"/>
<outputObj xsi:type="ns4:XmlDTO" xmlns:ns4="http://dto.domest.it.sogei" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<xml>Nzd1L1BEOTRiV3dnZG1WeWMybHZiajBpTVM0d0lpQmxibU52WkdsdVp6MGlkWFJtTFRnaVB6NEtQ</xml>
</outputObj>
<serviceID>D1</serviceID>
<xmlList>
<XmlDTO>
<xml>Nzd1L1BEOTRiV3dnZG1WeWMybHZiajBpTVM0d0lpQmxibU52WkdsdVp6MGlkWFJtTFRnaVB6NEtQ</xml>
</XmlDTO>
</xmlList>
</dispatcherReturn>
</ns2:dispatcherResponse>
</soapenv:Body>
</soapenv:Envelope>
When I call the GetDispatcherBean(False,'',HTTPRIO1,0).dispatcher(SOAP_RequestMsg) I obtain the error.
On the BeforeExecute of the RIO I just controll that the XML Request it's fine like a XML Request with SoapUI.
On the AfterExecute of the RIO I just controll that the XML Response it's fine like a XML Response with SoapUI.
The GetDispatcherBean(False,'',HTTPRIO1,0).dispatcher(SOAP_RequestMsg) Return an MessageDTO wich Class is define in the UNDispatcherBean Unit but I think Delphi don't parse correctly the XML Response to the Object MessageDTO.
Any idea about the Error ? Where I have to search the causes ?
It's my first project with Web Service and SOAP and I hope don't write estupid thigs.
I've written a TOpenPictDialog (source code see below) component, which finally fails under certain circumstands when calling
Result := TDialogFunc(DialogFunc)(DialogData);
in Dialogs.pas. As DialogFunc correctly points to GetOpenFileName I call CommDlgExtendedError afterwards for test to find out what's wrong. It returns CDERR_FINDRESFAILURE. In this case the dialog is simply not showing. My test form only contains a button and the TOpenPictDialog component, when pressing the button, OpenPictDialog1->Execute is called - that's all.
The very strange thing is that it does work perfectly (besides of the TListView flickering on resize) under one of the following circumstands:
a) add ExtDlgs in "uses" in calling form
b) add an original TOpenPictureDialog to the form without calling it
c) adding the PAS file containing TOpenPictDialog to the project (although TOpenPictDialog has been already installed)
If I write a C++ Builder application with the one calling form I never get TOpenPictDialog working (even if I add the additional TOpenPictureDialog component).
unit PictureDlg;
{$R-,H+,X+}
{$IF CompilerVersion > 23} {$DEFINE GE_DXE2} {$IFEND}
interface
{$IFDEF GE_DXE2}
uses Winapi.Messages, Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
Vcl.Graphics, Vcl.ExtCtrls, Vcl.Buttons, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.Consts, Vcl.ComCtrls;
{$ELSE}
uses Messages, Windows, SysUtils, Classes, Controls, StdCtrls,
Graphics, ExtCtrls, Buttons, Dialogs, ExtDlgs, Consts, ComCtrls;
{$ENDIF}
(*$HPPEMIT '// Alias records for C++ code that cannot compile in STRICT mode yet.' *)
(*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *)
(*$HPPEMIT '#if !defined(STRICT)' *)
// (*$HPPEMIT ' #pragma alias "#Vcl#Extdlgs#TOpenPictDialog#Execute$qqrpv"="#Vcl#Extdlgs#TOpenPictDialog#Execute$qqrp6HWND__"' *)
(*$HPPEMIT '#endif' *)
(*$HPPEMIT '#endif' *)
type
{ TOpenPictDialog }
TOpenPictDialog = class(TOpenDialog)
private
FListView: TListView;
FTopLabel, FBottomLabel: TStaticText;
FImageCtrl: TImage;
FSavedFilename: string;
FOldDialogWndProc: Pointer;
FDialogMethodInstance: Pointer;
FDialogHandle: THandle;
function IsFilterStored: Boolean;
procedure DialogWndProc(var Msg: TMessage);
protected
procedure DoClose; override;
procedure DoSelectionChange; override;
procedure DoShow; override;
function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
published
property Filter stored IsFilterStored;
public
constructor Create(AOwner: TComponent); override;
function Execute(ParentWnd: HWND): Boolean; override;
property DialogListView: TListView read FListView;
property DialogImage: TImage read FImageCtrl;
property TopLabel: TStaticText read FTopLabel;
property BottomLabel: TStaticText read FBottomLabel;
end;
procedure Register;
implementation
uses
{$IFDEF GE_DXE2}
{$IF DEFINED(CLR)}
System.Runtime.InteropServices, System.Reflection, System.Security.Permissions, System.IO,
{$IFEND}
System.Math, Vcl.Forms, Winapi.CommDlg, Winapi.Dlgs, System.Types, Winapi.ShlObj, Winapi.ActiveX;
{$ELSE}
{$IF DEFINED(CLR)}
InteropServices, Reflection, Permissions, IO,
{$IFEND}
Math, Forms, CommDlg, Dlgs, Types, ShlObj, ActiveX;
{$ENDIF}
{ TOpenPictDialog }
constructor TOpenPictDialog.Create(AOwner: TComponent);
begin
FDialogHandle := 0;
FDialogMethodInstance := NIL;
inherited Create(AOwner);
Filter := GraphicFilter(TGraphic);
FListView := TListView.Create(Self);
FImageCtrl := TImage.Create(Self);
with FListView do
begin
Name := 'ListView';
SetBounds(204, 5, 169, 200);
BevelOuter := bvNone;
BorderWidth := 6;
TabOrder := 1;
Color := clWindow;
ParentDoubleBuffered := false;
DoubleBuffered := true;
OwnerDraw := true;
Ctl3D := true;
with FImageCtrl do
begin
Picture := nil;
Name := 'Image';
Parent := FListView;
end;
end;
FTopLabel := TStaticText.Create(Self);
with FTopLabel do
begin
Name := 'TopLabel';
SetBounds(6, 6, 157, 23);
AutoSize := False;
Caption := 'Preview:';
end;
FBottomLabel := TStaticText.Create(Self);
with FBottomLabel do
begin
Name := 'BottomLabel';
SetBounds(6, 6, 157, 23);
AutoSize := False;
Caption := 'Image size: 208 x 149 px';
Alignment := taCenter;
end;
end;
procedure TOpenPictDialog.DialogWndProc(var Msg: TMessage);
var
PreviewRect, ListViewRect, WindowRect, LabelRect: TRect;
WndControl: HWND;
begin
Msg.Result := CallWindowProc(FOldDialogWndProc, FDialogHandle, Msg.Msg, Msg.WParam, Msg.LParam);
if ((Msg.Msg = WM_WINDOWPOSCHANGED) and
((TWMWindowPosMsg(Msg).WindowPos.Flags and SWP_NOSIZE) = 0)) or
(Msg.Msg = WM_SHOWWINDOW) then begin
PreviewRect := FListView.BoundsRect;
GetWindowRect(Handle, WindowRect);
WndControl := FindWindowEx(FDialogHandle, 0, 'SHELLDLL_DefView', nil);
WndControl := FindWindowEx(WndControl, 0, 'SysListView32', nil);
if WndControl <> 0 then begin
GetWindowRect(WndControl, ListViewRect);
PreviewRect.Top := ListViewRect.Top - WindowRect.Top;
PreviewRect.Bottom := PreviewRect.Top + ListViewRect.Bottom - ListViewRect.Top;
if (not EqualRect(PreviewRect, FListView.BoundsRect)) then
FListView.BoundsRect := PreviewRect;
LabelRect := PreviewRect;
Dec(LabelRect.Top, 24);
LabelRect.Bottom := LabelRect.Top + 16;
FTopLabel.BoundsRect := LabelRect;
LabelRect := PreviewRect;
LabelRect.Top := PreviewRect.Bottom + 9;
LabelRect.Bottom := LabelRect.Top + 16;
FBottomLabel.BoundsRect := LabelRect;
end;
end;
end;
procedure TOpenPictDialog.DoSelectionChange;
var
FullName: string;
function ValidFile(const FileName: string): Boolean;
begin
Result := FileGetAttr(FileName) <> -1;
end;
begin
FullName := FileName;
if FullName <> FSavedFilename then
begin
FSavedFilename := FullName;
end;
inherited DoSelectionChange;
end;
procedure TOpenPictDialog.DoClose;
begin
if Assigned(FDialogMethodInstance) then begin
SetWindowLong(FDialogHandle, GWL_WNDPROC, Integer(FOldDialogWndProc));
FreeObjectInstance(FDialogMethodInstance);
end;
FDialogHandle := 0;
FDialogMethodInstance := NIL;
inherited DoClose;
{ Hide any hint windows left behind }
Application.HideHint;
end;
procedure TOpenPictDialog.DoShow;
var
PreviewRect, StaticRect, OldDialogRect: TRect;
DialogWidth, DialogHeight, NewLeft, NewTop: integer;
const
SizeIncrease = 25;
begin
FDialogHandle := GetParent(Handle);
GetWindowRect(FDialogHandle, OldDialogRect);
DialogWidth := OldDialogRect.Right - OldDialogRect.Left + SizeIncrease;
DialogHeight := OldDialogRect.Bottom - OldDialogRect.Top;
NewLeft := (Screen.Width - DialogWidth) div 2;
NewTop := (Screen.Height - DialogHeight) div 2;
GetWindowRect(Handle, PreviewRect);
MoveWindow(FDialogHandle, NewLeft, NewTop, DialogWidth, DialogHeight, true);
MoveWindow(Handle, 0, 0, PreviewRect.Right - PreviewRect.Left + SizeIncrease, PreviewRect.Bottom - PreviewRect.Top, false);
StaticRect := GetStaticRect;
GetClientRect(Handle, PreviewRect);
PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
Inc(PreviewRect.Top, 4);
Dec(PreviewRect.Right, 8);
Dec(PreviewRect.Bottom, 20);
FListView.BoundsRect := PreviewRect;
FDialogMethodInstance := MakeObjectInstance(DialogWndProc);
FOldDialogWndProc := Pointer(SetWindowLong(FDialogHandle, GWL_WNDPROC, Integer(FDialogMethodInstance)));
FSavedFilename := '';
FListView.ParentWindow := Handle;
FTopLabel.ParentWindow := Handle;
FBottomLabel.ParentWindow := Handle;
inherited DoShow;
end;
[UIPermission(SecurityAction.LinkDemand, Window=UIPermissionWindow.SafeSubWindows)]
function TOpenPictDialog.Execute(ParentWnd: HWND): Boolean;
begin
if NewStyleControls and not (ofOldStyleDialog in Options) and not
((Win32MajorVersion >= 6) and UseLatestCommonDialogs) then
Template := 'DLGTEMPLATE'
else
{$IF DEFINED(CLR)}
Template := '';
{$ELSE}
Template := nil;
{$IFEND}
Result := inherited Execute(ParentWnd);
end;
function TOpenPictDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
// This makes sense ONLY if you are compiling with a run-time packages
// Thanks to Peter Below (www.delphifaq.com)
TOpenfilename(Dialogdata).hInstance := FindClassHInstance(Classtype);
Result := inherited TaskModalDialog(DialogFunc, DialogData);
end;
function TOpenPictDialog.IsFilterStored: Boolean;
begin
Result := not (Filter = GraphicFilter(TGraphic));
end;
procedure Register;
begin
RegisterComponents('Dialogs', [TOpenPictDialog]);
end;
end.
When you copied the code from ExtDlgs.pas to begin writing yours, you didn't copy enough. In particular, you didn't copy the $R directive that links the associated ExtDlgs.rc file, which contains the dialog resource describing the additional layout of the custom dialog box.
Your code tells the API to use a dialog resource named DLGTEMPLATE, but you haven't included that resource in your program. That explains why the error code you get is about a failure to find a resource. Using the ExtDlgs unit has the side effect of linking that unit's associated resources.
Go copy the dialog template from ExtDlgs.rc into your own RC file and link it as ExtDlgs.pas does. Use a different name for the resource, though, to avoid a name clash with the existing DLGTEMPLATE resource. Adjust your code accordingly.
How can I release a Variable that is being used by the WebService.
I'm using this form:
HttpPrincipal.WSDLLocation: = FrmPrincipal.edtWS.Text;
HttpPrincipal.Service: = 'CADServicesService';
HttpPrincipal.Port := 'CADServices';
Trinity: = HttpPrincipal as CADServices;
At the moment when I will close the Form appears an error, and discovered that when I declare this part:
Trinity: = HttpPrincipal as CADServices;
I think it is getting stuck in memory.
The error is the following:
"Invalid Pointer"
The error happens when you close the form, does not have any event in the OnClose or OnDestroy form.
Descriptions:
Trinity : CADServices,
HttpPrincipal is a THTTPRIO,
CADServices is my Unit containing all procedures / functions from WebService.
Instead of using the designtime component try to create HTTPRIO at runtime:
function GetCadServices(Addr : String): CadServices;
const
defSvc = 'CADServicesService';
defPrt = 'CADServices';
var
RIO: THTTPRIO;
begin
Result := nil;
RIO := THTTPRIO.Create(nil)
try
Result := (RIO as CadServices);
RIO.WSDLLocation := Addr;
RIO.Service := defSvc;
RIO.Port := defPrt;
finally
if (Result = nil) then
RIO.Free;
end;
end;
Usage:
Trinity := GetCadServices(FrmPrincipal.edtWS.Text);
If you imported the WSDL with the WSDL importer this code is automatically generated for you (look in the CadServices1 unit)
I need to send something like this:
<soapenv:Header>
<ser:userName>admin</ser:userName>
<ser:userPassword>secret</ser:userPassword>
</soapenv:Header>
Delphi WSDL importer, generated this:
userName2 = class(TSOAPHeader)
private
FValue: string;
published
property Value: string read FValue write FValue;
end;
userName = type string;
WsService = interface(IInvokable)
function call(const userName: userName; const userPassword: userPassword);
and registered the type as:
InvRegistry.RegisterHeaderClass(TypeInfo(WsService), userName2, 'userName', 'http://localhost/path/to/services');
The problem is that when I call it using the delphi generated code it puts the userName and password in the Body section of the SOAP message, not in the Header.
So I tried sending the Headers myself, like this:
Changed the type definition to inherit from the userName2 class because I can't send a string using the ISOAPHeaders.Send() method.
userName = class(userName2);
Then sent the headers:
user := userName.Create;
user.Value := 'admin';
WS := GetWsService;
(WS as ISOAPHeaders).Send(user);
Now the headers are in the correct place, but they are being sent like this:
<SOAP-ENV:Header>
<NS1:userName xmlns:NS1="http://localhost/path/to/services">
<Value xmlns="http://localhost/path/to/services">admin</Value>
</NS1:userName>
</SOAP-ENV:Header>
Almost there, but I don't want the "Value" property, I just want a plain simple tag in the header.
How can I do it?
Thanks.
== EDIT ==
As requested, the WSDL is here: http://desenvolvimento.lemontech.com.br:8081/wsselfbooking/WsSelfBookingService?wsdl
SOAP UI imported it and generated this sample request:
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:ser="http://lemontech.com.br/selfbooking/wsselfbooking/services">
<soapenv:Header>
<ser:userPassword></ser:userPassword>
<ser:userName></ser:userName>
<ser:keyClient></ser:keyClient>
</soapenv:Header>
<soapenv:Body>
<ser:pesquisarSolicitacao>
<!--You have a CHOICE of the next 2 items at this level-->
<idSolicitacaoRef></idSolicitacaoRef>
<dataInicial></dataInicial>
<dataFinal></dataFinal>
<registroInicial>1</registroInicial>
<!--Optional:-->
<quantidadeRegistros>50</quantidadeRegistros>
</ser:pesquisarSolicitacao>
</soapenv:Body>
</soapenv:Envelope>
This sample request works just fine, but I can't figure out how to make this call in Delphi.
You can override the serialization for any TSOAPHeader class.
Just override its ObjectToSOAP function.
I came up with this:
unit Unit16;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, WsSelfBookingService, StdCtrls,
InvokeRegistry, SOAPHTTPClient, opCOnvertOptions, XMLIntf, XSBuiltIns;
type
TForm1 = class(TForm)
Memo2: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TSOAPCredentials = class(TSoapHeader)
private
FPassword: string;
FUsername: string;
FKeyClient: string;
public
function ObjectToSOAP(RootNode, ParentNode: IXMLNode;
const ObjConverter: IObjConverter;
const NodeName, NodeNamespace, ChildNamespace: InvString; ObjConvOpts: TObjectConvertOptions;
out RefID: InvString): IXMLNode; override;
published
property userName : string read FUsername write Fusername;
property userPassword : string read FPassword write FPassword;
property keyClient : string read FKeyClient write FKeyClient;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TSOAPCredentials }
function TSOAPCredentials.ObjectToSOAP(RootNode, ParentNode: IXMLNode; const ObjConverter: IObjConverter; const NodeName,
NodeNamespace, ChildNamespace: InvString; ObjConvOpts: TObjectConvertOptions; out RefID: InvString): IXMLNode;
begin
Result := ParentNode.AddChild('userName');
Result.Text := FUsername;
Result := ParentNode.AddChild('userPassword');
Result.Text := FPassword;
Result := ParentNode.AddChild('keyClient');
Result.Text := FKeyClient;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ws : WsSelfBooking;
Req : pesquisarSolicitacao;
Resp : pesquisarSolicitacaoResponse;
Rio : THTTPRIO;
Cred : TSOAPCredentials;
begin
Rio := THttpRIO.Create(nil);
ws := GetWsSelfBooking(false, '', Rio);
Cred := TSOAPCredentials.Create;
Cred.userName := 'admin';
Cred.userPassword := 'secret';
Cred.keyClient := 'key';
Rio.SOAPHeaders.Send(cred);
Req := pesquisarSolicitacao.Create;
Req.registroInicial := 1;
Req.quantidadeRegistros := 50;
Resp := ws.pesquisarSolicitacao(Req);
end;
end.
results in this request header:
<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<SOAP-ENV:Header>
<SOAP-ENV:userName>admin</SOAP-ENV:userName>
<SOAP-ENV:userPassword>secret</SOAP-ENV:userPassword>
<SOAP-ENV:keyClient>key</SOAP-ENV:keyClient>
</SOAP-ENV:Header>
Solution:
It wasn't much obvious, but I just had to add the IS_TEXT value to the Index and declare a new TSOAPHeader descendant, the solution was like this:
const
IS_TEXT = $0020;
type
TSimpleHeader = class(TSOAPHeader)
private
FValue: string;
published
property Value: string Index (IS_TEXT) read FValue write FValue;
end;
userName = class(TSimpleHeader);
Then register this header:
InvRegistry.RegisterHeaderClass(TypeInfo(WsService), userName, 'userName', 'http://localhost/path/to/services');
And send the Header manually:
User := userName.Create;
User.Value := 'username';
(WS as ISOAPHeaders).Send(User);
Basically, the IS_TEXT value in the Index prevents Delphi from creating a userName tag and a Value tag inside it. It just places the string of the Value property inside the userName tag.
It's sad that the Index keywork is used for something so not obvious, also the documentation about it is difficult to find and hard to understand:
The AS_ATTRIBUTE feature has been deprecated. It still works for legacy code, but the preferred approach is to use the index value of a property. The index property allows you to specify whether a property is an attribute, an unbounded element, an optional element, a text value, or can have a value of NULL.
Source: http://docwiki.embarcadero.com/RADStudio/XE3/en/Using_Remotable_Objects
You can inject the tags by using a stringreplace on the XML string right before it goes out the door "onto the wire". You need a RIO_BeforeExecute handler, and you can then deal with the SOAPRequest directly.
I'm trying to write some Pascal script for a installer I'm making with Inno Setup Compiler 5.5.1. I'm currently trying to add a custom wizard page that executes a command, taking user input from text fields (TEdit components). I defined the NextButtonClick function, and it checks that the Page ID is the custom page I defined and attempts to retrieve the user input from the field. When I get it from the components of the Page's Surface property, it gets returned as a TComponent. To get the next I need to cast it to a TEdit, so I tried casting it and it seems to be returning nil. Besides the scripting for Inno I've been doing for the past few days, I don't have much experience with Pascal, so I could possibly be doing something wrong. But I'd appreciate the help!
Here's the chunk of code giving me an issue for reference (with debugging lines left in):
function NextButtonClick(CurPageID: Integer): Boolean;
var
ResultCode: Integer;
CurrPage: TWizardPage;
Server : TComponent;
Server2: TEdit;
SurfacePage : TNewNotebookPage;
ServerStr : String;
begin
if CurPageID = 100 then
begin
CurrPage := PageFromID(100);
SurfacePage := CurrPage.Surface;
Server := SurfacePage.Controls[0];
Server2 := TEdit(Server); // RETURNS NIL HERE
if Server2 = nil then
MsgBox('', mbInformation, MB_OK);
ServerStr := Server2.Text;
MsgBox(ServerStr, mbInformation, MB_OK);
//ShellExec('', 'sqlcmd', '-S ' + ServerStr + ' -Q ":r setMemUsage.sql"', ExpandConstant('{app}') + '\sql', SW_SHOW, ewWaitUntilTerminated, ResultCode);
end;
Result := True;
end;
I can't simulate your problem. I've used this minimalistic code:
[Code]
var
CustomPageID: Integer;
procedure InitializeWizard;
var
EditBox: TEdit;
CustomPage: TWizardPage;
begin
CustomPage := CreateCustomPage(wpWelcome, '', '');
CustomPageID := CustomPage.ID;
EditBox := TEdit.Create(WizardForm);
EditBox.Parent := CustomPage.Surface;
end;
procedure CurPageChanged(CurPageID: Integer);
var
EditBox: TEdit;
Component: TComponent;
CustomPage: TWizardPage;
begin
if (CurPageID = CustomPageID) then
begin
CustomPage := PageFromID(CustomPageID);
Component := CustomPage.Surface.Controls[0];
if (Component is TEdit) then
begin
MsgBox('Controls[0] is assigned and is TEdit', mbInformation, MB_OK);
EditBox := TEdit(Component);
EditBox.Text := 'Hi, I''m just a modified edit text!';
end;
end;
end;