From 65dab20c6f97c9af639656296e5cc64c6fdcbcab Mon Sep 17 00:00:00 2001 From: inoussa Date: Mon, 13 Aug 2007 18:12:23 +0000 Subject: [PATCH] Delphi compatibility fix ( node filtering ) Add Delphi amazon sample git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@239 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_soap_formatter.pas | 7 +- .../samples/delphi/amazon/amazon_sample.cfg | 43 +++++ .../samples/delphi/amazon/amazon_sample.dof | 159 ++++++++++++++++++ .../samples/delphi/amazon/amazon_sample.dpr | 97 +++++++++++ wst/trunk/tests/ebay/test_ebay_gui.lpi | 132 ++------------- wst/trunk/tests/test_suite/wst_test_suite.lpi | 48 +++--- wst/trunk/wst_delphi_xml.pas | 80 +++++++++ 7 files changed, 417 insertions(+), 149 deletions(-) create mode 100644 wst/trunk/samples/delphi/amazon/amazon_sample.cfg create mode 100644 wst/trunk/samples/delphi/amazon/amazon_sample.dof create mode 100644 wst/trunk/samples/delphi/amazon/amazon_sample.dpr diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index b1fa1b6c6..0bf8ab51d 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -1764,15 +1764,10 @@ end; { TEmbeddedArrayStackItem } function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList; -{$IFNDEF FPC} -var - slct : IDOMNodeSelect; -{$ENDIF} begin if ScopeObject.HasChildNodes() then begin {$IFNDEF FPC} - slct := ScopeObject as IDOMNodeSelect; - Result := slct.selectNodes(ANodeName); //ScopeObject.childNodes; + Result := FilterList(ScopeObject.childNodes,ANodeName); {$ELSE} Result := {$IFNDEF FPC_211}TDOMNodeList{$ELSE}TDOMElementList{$ENDIF}.Create(ScopeObject,ANodeName); {$ENDIF} diff --git a/wst/trunk/samples/delphi/amazon/amazon_sample.cfg b/wst/trunk/samples/delphi/amazon/amazon_sample.cfg new file mode 100644 index 000000000..63eebd5c8 --- /dev/null +++ b/wst/trunk/samples/delphi/amazon/amazon_sample.cfg @@ -0,0 +1,43 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-N"obj" +-LE"c:\program files\borland\delphi7\Projects\Bpl" +-LN"c:\program files\borland\delphi7\Projects\Bpl" +-U"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse" +-O"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse" +-I"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse" +-R"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/wst/trunk/samples/delphi/amazon/amazon_sample.dof b/wst/trunk/samples/delphi/amazon/amazon_sample.dof new file mode 100644 index 000000000..4ba076a49 --- /dev/null +++ b/wst/trunk/samples/delphi/amazon/amazon_sample.dof @@ -0,0 +1,159 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir=obj +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse +Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir=C:\Program Files\Borland\Delphi7\Bin\ +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc. +C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc. +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=7 +Item0=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse +Item1=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\ +Item2=..\..\;..\..\..\ +Item3=..\..\ +Item4=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\ +Item5=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\ +Item6=..\ +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=obj diff --git a/wst/trunk/samples/delphi/amazon/amazon_sample.dpr b/wst/trunk/samples/delphi/amazon/amazon_sample.dpr new file mode 100644 index 000000000..4e414427c --- /dev/null +++ b/wst/trunk/samples/delphi/amazon/amazon_sample.dpr @@ -0,0 +1,97 @@ +program amazon_sample; + +{$APPTYPE CONSOLE} + +uses + delphi_init_com, + Classes, SysUtils, + soap_formatter, + synapse_http_protocol, + metadata_repository, + AWSECommerceService, AWSECommerceService_proxy; + +const sACCES_ID = ; + +function ReadEntry(const APromp : string):string ; +begin + Result := ''; + Write(APromp); + while True do begin + ReadLn(Result); + Result := Trim(Result); + if ( Length(Result) > 0 ) then + Break; + end; +end; + +var + locService : AWSECommerceServicePortType; + rqst : ItemSearch_Type; + rsps : ItemSearchResponse_Type; + rspsItem : Items_Type; + i, j, k : Integer; + itm : Item_Type; +begin + SYNAPSE_RegisterHTTP_Transport(); + WriteLn('Web Services Toolkit Amazon sample'); + WriteLn('This sample demonstrates the "ItemSearch" method of the Amazon web service'); + WriteLn; + rqst := ItemSearch_Type.Create(); + try + locService := wst_CreateInstance_AWSECommerceServicePortType(); + rqst.AWSAccessKeyId := sACCES_ID; + while True do begin + rqst.Request.SetLength(1); + rqst.Request[0].SearchIndex := ReadEntry('Enter the Search Index : '); + rqst.Request[0].Availability := Available; + rqst.Request[0].Count := 10; + rqst.Request[0].MerchantId := 'Amazon'; + rqst.Request[0].ItemPage := 1; + rqst.Request[0].Keywords := ReadEntry('Enter the Keywords : '); + rsps := locService.ItemSearch(rqst); + if ( rsps.OperationRequest.Errors.Length > 0 ) then begin + WriteLn(Format('Errors ( %d ) : ',[rsps.OperationRequest.Errors.Length])); + for i := 0 to Pred(rsps.OperationRequest.Errors.Length) do begin + WriteLn(Format(' Error[%d] :',[i])); + WriteLn(' ' + rsps.OperationRequest.Errors[i].Code); + WriteLn(' ' + rsps.OperationRequest.Errors[i].Message); + end; + end else begin + WriteLn(Format('Response ( %d ) : ',[rsps.Items.Length])); + if Assigned(rsps) then begin + for i := 0 to Pred(rsps.Items.Length) do begin + rspsItem := rsps.Items[i]; + WriteLn(' TotalPages :' + IntToStr(rspsItem.TotalPages)); + WriteLn(' TotalResults :' + IntToStr(rspsItem.TotalResults)); + WriteLn(' Items :' + IntToStr(rspsItem._Item.Length)); + WriteLn(''); + for j := 0 to Pred(rspsItem._Item.Length) do begin + itm := rspsItem._Item[j];; + WriteLn(' ASIN :' + itm.ASIN); + WriteLn(' DetailPageURL :' + itm.DetailPageURL); + if Assigned(itm.ItemAttributes) then begin + WriteLn(' Title :' + itm.ItemAttributes.Title); + for k := 0 to Pred(itm.ItemAttributes.Author.Length) do begin + WriteLn(' Author[ ' + IntToStr(k) + ' ] ' + itm.ItemAttributes.Author.Item[k]); + end; + WriteLn(' Manufacturer :' + itm.ItemAttributes.Manufacturer); + WriteLn(' ProductGroup :' + itm.ItemAttributes.ProductGroup); + end; + WriteLn(''); + end; + end; + end else begin + WriteLn('Unexpected service response : Invalid response'); + end; + end; + WriteLn; + WriteLn; + if ( UpperCase(ReadEntry('Continue ( Y/N ) :'))[1] <> 'Y' ) then + Break; + end; + finally + FreeAndNil(rqst); + FreeAndNil(rsps); + end; + ReadLn; +end. diff --git a/wst/trunk/tests/ebay/test_ebay_gui.lpi b/wst/trunk/tests/ebay/test_ebay_gui.lpi index 92e5c1c1e..40f6048da 100644 --- a/wst/trunk/tests/ebay/test_ebay_gui.lpi +++ b/wst/trunk/tests/ebay/test_ebay_gui.lpi @@ -7,7 +7,7 @@ - + @@ -43,8 +43,8 @@ - - + + @@ -54,7 +54,7 @@ - + @@ -266,8 +266,8 @@ - - + + @@ -363,127 +363,23 @@ - + - - + + - - + + - - + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 9f3add83d..df7afd6a4 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -7,7 +7,7 @@ - + @@ -42,8 +42,8 @@ - - + + @@ -73,7 +73,7 @@ - + @@ -82,7 +82,7 @@ - + @@ -95,8 +95,8 @@ - - + + @@ -115,7 +115,7 @@ - + @@ -144,7 +144,7 @@ - + @@ -174,7 +174,7 @@ - + @@ -288,7 +288,7 @@ - + @@ -329,7 +329,7 @@ - + @@ -452,7 +452,7 @@ - + @@ -473,8 +473,8 @@ - - + + @@ -489,8 +489,8 @@ - - + + @@ -531,7 +531,7 @@ - + @@ -539,9 +539,7 @@ - - @@ -552,7 +550,7 @@ - + @@ -564,7 +562,7 @@ - + @@ -576,7 +574,7 @@ - + @@ -588,7 +586,7 @@ - + @@ -600,7 +598,7 @@ - + diff --git a/wst/trunk/wst_delphi_xml.pas b/wst/trunk/wst_delphi_xml.pas index ba79bd523..2e580eb6d 100644 --- a/wst/trunk/wst_delphi_xml.pas +++ b/wst/trunk/wst_delphi_xml.pas @@ -26,6 +26,8 @@ type procedure WriteXMLFile(ADoc : TXMLDocument; AStream : TStream); procedure ReadXMLFile(ADoc : TXMLDocument; AStream : TStream); function NodeToBuffer(ANode : TDOMNode):string ; + + function FilterList(const ALIst : IDOMNodeList; const ANodeName : widestring):IDOMNodeList ; implementation uses XmlDoc; @@ -106,4 +108,82 @@ begin end; end; +type + TDOMNodeSelectListImp = class(TInterfacedObject,IDOMNodeList) + private + FItemName : widestring; + FInnerList : IDOMNodeList; + FCount : Integer; + private + function internal_get_item(index: Integer): IDOMNode; + protected + function get_item(index: Integer): IDOMNode; safecall; + function get_length: Integer; safecall; + public + constructor Create( + const AInnerList : IDOMNodeList; + const AItemName : widestring + ); + end; + +function FilterList(const ALIst : IDOMNodeList; const ANodeName : widestring):IDOMNodeList ; +begin + Result := TDOMNodeSelectListImp.Create(ALIst,ANodeName); +end; + +{ TDOMNodeSelectListImp } + +constructor TDOMNodeSelectListImp.Create( + const AInnerList: IDOMNodeList; + const AItemName: widestring +); +begin + Assert(AInnerList <> nil); + FInnerList := AInnerList; + FItemName := AItemName; + FCount := -1; +end; + +function TDOMNodeSelectListImp.get_item(index: Integer): IDOMNode; +begin + Result := internal_get_item(index); + if ( Result = nil ) then + raise Exception.CreateFmt('Invalid item at %d.',[index]); +end; + +function TDOMNodeSelectListImp.get_length() : Integer; +begin + if ( FCount >= 0 ) then begin + Result := FCount; + end else begin + FCount := 0; + while Assigned(internal_get_item(FCount)) do begin + Inc(FCount); + end; + Result := FCount; + end; +end; + +function TDOMNodeSelectListImp.internal_get_item(index: Integer): IDOMNode; +var + i : Integer; + crt : IDOMNode; +begin + Result := nil; + if ( FInnerList.length > 0 ) then begin + i := -1; + crt := FInnerList.item[0]; + while ( crt <> nil ) do begin + if ( FItemName = crt.nodeName ) then begin + Inc(i); + if ( i = index ) then begin + Result := crt; + Break; + end; + end; + crt := crt.nextSibling; + end; + end; +end; + end.