From 1c633e091d2c05a2886f675e3d8420d2e53e7e98 Mon Sep 17 00:00:00 2001 From: inoussa Date: Sun, 9 Sep 2007 22:30:50 +0000 Subject: [PATCH] wsdl2pas_imp.pas has been reorganized : - xsd_parser.pas XML schema parser - wsdl_parser.pas WSDL parser ( uses xsd_parser to parse type definitions ) ws_helper now supports XML Schema ( .XSD files ) parsing. test cases for XSD and WSDL parsers git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@264 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../test_suite/delphi/wst_test_suite.cfg | 8 +- .../test_suite/delphi/wst_test_suite.dof | 27 +- .../test_suite/delphi/wst_test_suite.dpr | 6 +- .../tests/test_suite/files/complex_class.WSDL | 48 + .../tests/test_suite/files/complex_class.xsd | 34 + .../files/complex_class_embedded.WSDL | 61 + .../files/complex_class_embedded.xsd | 47 + wst/trunk/tests/test_suite/files/empty.WSDL | 15 + wst/trunk/tests/test_suite/files/empty.xsd | 5 + .../tests/test_suite/files/simpletype.WSDL | 32 + .../tests/test_suite/files/simpletype.xsd | 20 + .../test_suite/files/simpletype_embedded.WSDL | 32 + .../test_suite/files/simpletype_embedded.xsd | 20 + wst/trunk/tests/test_suite/test_parsers.pas | 543 +++++++ wst/trunk/tests/test_suite/wst_test_suite.lpi | 606 ++++---- wst/trunk/tests/test_suite/wst_test_suite.lpr | 2 +- wst/trunk/type_lib_edtr/typ_lib_edtr.lpi | 143 +- .../type_lib_edtr/uwsttypelibraryedit.lfm | 15 +- .../type_lib_edtr/uwsttypelibraryedit.lrs | 578 ++++---- .../type_lib_edtr/uwsttypelibraryedit.pas | 18 +- wst/trunk/ws_helper/delphi/ws_helper.dof | 17 +- wst/trunk/ws_helper/delphi/ws_helper.dpr | 6 +- wst/trunk/ws_helper/generator.pas | 75 +- wst/trunk/ws_helper/logger_intf.pas | 10 +- wst/trunk/ws_helper/parserutils.pas | 353 ++++- wst/trunk/ws_helper/pascal_parser_intf.pas | 54 +- wst/trunk/ws_helper/ws_helper.lpi | 308 +++- wst/trunk/ws_helper/ws_helper.pas | 7 +- wst/trunk/ws_helper/ws_helper_prog.inc | 50 +- wst/trunk/ws_helper/ws_parser_imp.pas | 1272 +++++++++++++++++ wst/trunk/ws_helper/wsdl2pas_imp.pas | 3 +- wst/trunk/ws_helper/wsdl_generator.pas | 26 +- wst/trunk/ws_helper/wsdl_parser.pas | 1237 ++++++++++++++++ wst/trunk/ws_helper/xsd_parser.pas | 590 ++++++++ 34 files changed, 5477 insertions(+), 791 deletions(-) create mode 100644 wst/trunk/tests/test_suite/files/complex_class.WSDL create mode 100644 wst/trunk/tests/test_suite/files/complex_class.xsd create mode 100644 wst/trunk/tests/test_suite/files/complex_class_embedded.WSDL create mode 100644 wst/trunk/tests/test_suite/files/complex_class_embedded.xsd create mode 100644 wst/trunk/tests/test_suite/files/empty.WSDL create mode 100644 wst/trunk/tests/test_suite/files/empty.xsd create mode 100644 wst/trunk/tests/test_suite/files/simpletype.WSDL create mode 100644 wst/trunk/tests/test_suite/files/simpletype.xsd create mode 100644 wst/trunk/tests/test_suite/files/simpletype_embedded.WSDL create mode 100644 wst/trunk/tests/test_suite/files/simpletype_embedded.xsd create mode 100644 wst/trunk/tests/test_suite/test_parsers.pas create mode 100644 wst/trunk/ws_helper/ws_parser_imp.pas create mode 100644 wst/trunk/ws_helper/wsdl_parser.pas create mode 100644 wst/trunk/ws_helper/xsd_parser.pas diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.cfg b/wst/trunk/tests/test_suite/delphi/wst_test_suite.cfg index 838505cf5..4a45e7018 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.cfg +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.cfg @@ -34,10 +34,10 @@ -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\dunit\dunit-9.3.0\src" --O"..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" --I"..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" --R"..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-U"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-O"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-I"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-R"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" -DDUnit -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof index 5987f7b5f..769818b54 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof @@ -94,7 +94,7 @@ OutputDir= UnitOutputDir=obj PackageDLLOutputDir= PackageDCPOutputDir= -SearchPath=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +SearchPath=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src 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=DUnit DebugSourceDirs= @@ -149,17 +149,20 @@ Item0=DUnit Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; [HistoryLists\hlSearchPath] -Count=10 -Item0=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item1=..\;..\..\;..\..\..\;C:\Programmes\lazarus\wst\trunk\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item2=..\;..\..\;..\..\..\;..\..\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item3=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item4=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;C:\Programmes\lazarus\wst\trunk\ws_helper -Item5=..\;..\..\;..\..\..\;..\..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item6=..\;..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item7=..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item8=C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item9=..\ +Count=13 +Item0=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item1=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\ws_helper +Item2=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\fcl-units\fcl-passrc\src +Item3=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item4=..\;..\..\;..\..\..\;C:\Programmes\lazarus\wst\trunk\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item5=..\;..\..\;..\..\..\;..\..\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item6=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item7=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;C:\Programmes\lazarus\wst\trunk\ws_helper +Item8=..\;..\..\;..\..\..\;..\..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item9=..\;..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item10=..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item11=C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item12=..\ [HistoryLists\hlUnitOutputDirectory] Count=1 Item0=obj diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr index a4ceb2a11..3854fc038 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr @@ -1,11 +1,13 @@ {$APPTYPE CONSOLE} program wst_test_suite; uses - SysUtils, ActiveX, + SysUtils, + ActiveX, TestFrameWork, TextTestRunner, test_utilities in '..\test_utilities.pas', - testformatter_unit in '..\testformatter_unit.pas'; + testformatter_unit in '..\testformatter_unit.pas', + test_parsers in '..\test_parsers.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/files/complex_class.WSDL b/wst/trunk/tests/test_suite/files/complex_class.WSDL new file mode 100644 index 000000000..0833c8f6d --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class.WSDL @@ -0,0 +1,48 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class.xsd b/wst/trunk/tests/test_suite/files/complex_class.xsd new file mode 100644 index 000000000..bc5c59f61 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class.xsd @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_embedded.WSDL b/wst/trunk/tests/test_suite/files/complex_class_embedded.WSDL new file mode 100644 index 000000000..4e00c14b5 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_embedded.WSDL @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_embedded.xsd b/wst/trunk/tests/test_suite/files/complex_class_embedded.xsd new file mode 100644 index 000000000..a0f7831b8 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_embedded.xsd @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/empty.WSDL b/wst/trunk/tests/test_suite/files/empty.WSDL new file mode 100644 index 000000000..6ad1e35b9 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/empty.WSDL @@ -0,0 +1,15 @@ + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/empty.xsd b/wst/trunk/tests/test_suite/files/empty.xsd new file mode 100644 index 000000000..14e53c339 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/empty.xsd @@ -0,0 +1,5 @@ + + + diff --git a/wst/trunk/tests/test_suite/files/simpletype.WSDL b/wst/trunk/tests/test_suite/files/simpletype.WSDL new file mode 100644 index 000000000..74e1fbcec --- /dev/null +++ b/wst/trunk/tests/test_suite/files/simpletype.WSDL @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/simpletype.xsd b/wst/trunk/tests/test_suite/files/simpletype.xsd new file mode 100644 index 000000000..04810c92f --- /dev/null +++ b/wst/trunk/tests/test_suite/files/simpletype.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/simpletype_embedded.WSDL b/wst/trunk/tests/test_suite/files/simpletype_embedded.WSDL new file mode 100644 index 000000000..2e450ccbc --- /dev/null +++ b/wst/trunk/tests/test_suite/files/simpletype_embedded.WSDL @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/simpletype_embedded.xsd b/wst/trunk/tests/test_suite/files/simpletype_embedded.xsd new file mode 100644 index 000000000..1cf16c270 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/simpletype_embedded.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas new file mode 100644 index 000000000..891609fba --- /dev/null +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -0,0 +1,543 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit test_parsers; + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testutils, testregistry, DOM, XmlRead, wst_fpc_xml, +{$ELSE} + TestFrameWork, xmldom, wst_delphi_xml, +{$ENDIF} + pastree, pascal_parser_intf, xsd_parser, wsdl_parser; + +type + + { TTest_CustomXsdParser } + + TTest_CustomXsdParser = class(TTestCase) + protected + function LoadEmptySchema() : TwstPasTreeContainer;virtual;abstract; + function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; + + function LoadComplexType_Class_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; + published + procedure EmptySchema(); + + procedure SimpleType_Enum(); + procedure SimpleType_Enum_Embedded(); + + procedure ComplexType_Class(); + procedure ComplexType_Class_Embedded(); + end; + + { TTest_XsdParser } + + TTest_XsdParser = class(TTest_CustomXsdParser) + private + function ParseDoc(const ADoc : string) : TwstPasTreeContainer; + protected + function LoadEmptySchema() : TwstPasTreeContainer;override; + function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;override; + function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override; + end; + + { TTest_WsdlParser } + + TTest_WsdlParser = class(TTest_CustomXsdParser) + private + function ParseDoc(const ADoc : string) : TwstPasTreeContainer; + protected + function LoadEmptySchema() : TwstPasTreeContainer;override; + function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;override; + function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override; + end; + +implementation +uses parserutils; + +const + x_complexType_SampleClassType = 'TClassSampleType'; + x_complexType_SampleClassTypeAll = 'TClassSampleTypeAll'; + x_complexType_SampleClass = 'TClassSample'; + x_complexType_class = 'complex_class'; + x_complexType_class_embedded = 'complex_class_embedded'; + + x_empty = 'empty'; + + x_enumSample = 'EnumSample'; + x_enumSampleType = 'EnumSampleType'; + x_enumSampleLIST_COUNT = 7; + x_enumSampleLIST : array[0..( x_enumSampleLIST_COUNT - 1 )] of string = ( 'esOne', 'esTwo', 'esThree', 'begin', 'finally', 'True', 'False' ); + x_simpleType = 'simpletype'; + x_simpleTypeEmbedded = 'simpletype_embedded'; + + x_targetNamespace = 'urn:wst-test'; + + + x_byteField = 'byteField'; + x_charField = 'charField'; + x_classField = 'classField'; + x_enumField = 'enumField'; + x_floatField = 'floatField'; + x_intField = 'intField'; + x_longField = 'longField'; + x_strField = 'strField'; + + x_intAtt = 'intAtt'; + x_strAtt = 'strAtt'; + + +function LoadXmlFile(const AFileName : string) : TXMLDocument; +begin + Result := nil; + ReadXMLFile(Result,AFileName); +end; + +{ TTest_CustomXsdParser } + +procedure TTest_CustomXsdParser.EmptySchema(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; +begin + tr := LoadEmptySchema(); + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_empty,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + CheckEquals(0,mdl.InterfaceSection.Declarations.Count); +end; + +procedure TTest_CustomXsdParser.SimpleType_Enum(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt : TPasElement; + enumType : TPasEnumType; + enumVal : TPasEnumValue; + aliasType : TPasAliasType; + i : Integer; +begin + tr := LoadSimpleType_Enum_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_simpleType,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count); + elt := tr.FindElement(x_enumSampleType); + CheckNotNull(elt,x_enumSampleType); + CheckEquals(x_enumSampleType,elt.Name); + CheckEquals(x_enumSampleType,tr.GetExternalName(elt)); + CheckIs(elt,TPasEnumType); + enumType := elt as TPasEnumType; + CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count); + for i := 0 to Pred(x_enumSampleLIST_COUNT) do begin + enumVal := TPasEnumValue(enumType.Values[i]); + CheckNotNull(enumVal); + if IsReservedKeyWord(x_enumSampleLIST[i]) then begin + CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[i]]),enumVal.Name); + end else begin + CheckEquals(x_enumSampleLIST[i],enumVal.Name); + end; + CheckEquals(x_enumSampleLIST[i],tr.GetExternalName(enumVal)); + end; + + elt := tr.FindElement(x_enumSample); + CheckNotNull(elt,x_enumSample); + CheckEquals(x_enumSample,elt.Name); + CheckEquals(x_enumSample,tr.GetExternalName(elt)); + CheckIs(elt,TPasAliasType); + aliasType := elt as TPasAliasType; + CheckNotNull(aliasType.DestType); + CheckEquals(x_enumSampleType, tr.GetExternalName(aliasType.DestType)); +end; + +procedure TTest_CustomXsdParser.SimpleType_Enum_Embedded(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt : TPasElement; + enumType : TPasEnumType; + enumVal : TPasEnumValue; + aliasType : TPasAliasType; + i : Integer; +begin + tr := LoadSimpleType_Enum_Embedded_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_simpleTypeEmbedded,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement(x_enumSampleType); + CheckNotNull(elt,x_enumSampleType); + CheckEquals(x_enumSampleType,elt.Name); + CheckEquals(x_enumSampleType,tr.GetExternalName(elt)); + CheckIs(elt,TPasEnumType); + enumType := elt as TPasEnumType; + CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count); + for i := 0 to Pred(x_enumSampleLIST_COUNT) do begin + enumVal := TPasEnumValue(enumType.Values[i]); + CheckNotNull(enumVal); + if IsReservedKeyWord(x_enumSampleLIST[i]) then begin + CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[i]]),enumVal.Name); + end else begin + CheckEquals(x_enumSampleLIST[i],enumVal.Name); + end; + CheckEquals(x_enumSampleLIST[i],tr.GetExternalName(enumVal)); + end; +end; + +type + TPropertyType = ( ptField, ptAttribute ); +const + PropertyType_Att : array[TPropertyType] of Boolean = ( False, True ); +procedure TTest_CustomXsdParser.ComplexType_Class(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_class,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count); + elt := tr.FindElement(x_complexType_SampleClassType); + CheckNotNull(elt,x_complexType_SampleClassType); + CheckEquals(x_complexType_SampleClassType,elt.Name); + CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(8,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + CheckProperty(x_floatField,'float',ptField); + CheckProperty(x_byteField,'byte',ptField); + CheckProperty(x_charField,'char',ptField); + CheckProperty(x_longField,'long',ptField); + CheckProperty(x_strAtt,'string',ptAttribute); + CheckProperty(x_intAtt,'int',ptAttribute); + + + elt := tr.FindElement(x_complexType_SampleClass); + CheckNotNull(elt,x_complexType_SampleClass); + CheckEquals(x_complexType_SampleClass,elt.Name); + CheckEquals(x_complexType_SampleClass,tr.GetExternalName(elt)); + CheckIs(elt,TPasAliasType); + aliasType := elt as TPasAliasType; + CheckNotNull(aliasType.DestType); + CheckEquals(x_complexType_SampleClassType, tr.GetExternalName(aliasType.DestType)); + + elt := tr.FindElement(x_complexType_SampleClassTypeAll); + CheckNotNull(elt,x_complexType_SampleClassTypeAll); + CheckEquals(x_complexType_SampleClassTypeAll,elt.Name); + CheckEquals(x_complexType_SampleClassTypeAll,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(8,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + CheckProperty(x_floatField,'float',ptField); + CheckProperty(x_byteField,'byte',ptField); + CheckProperty(x_charField,'char',ptField); + CheckProperty(x_longField,'long',ptField); + CheckProperty(x_strAtt,'string',ptAttribute); + CheckProperty(x_intAtt,'int',ptAttribute); + + finally + FreeAndNil(prpLs); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Embedded(); +var + tr : TwstPasTreeContainer; + nestedClassName, nestedEnumName : string; + + procedure CheckProperty( + const AName,ATypeName : string; + const AFieldType : TPropertyType; + const AClsType : TPasClassType + ); + var + prp : TPasProperty; + begin + prp := FindMember(AClsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + + procedure CheckEmbeddedClassType(); + var + mdl : TPasModule; + e : TPasElement; + k : Integer; + prpLst : TList; + nestedClsType : TPasClassType; + begin + prpLst := TList.Create(); + try + nestedClassName := Format('%s_%s_Type',[x_complexType_SampleClassType,x_classField]); + e := tr.FindElement(nestedClassName); + CheckNotNull(e,nestedClassName); + CheckEquals(nestedClassName,e.Name); + CheckEquals(nestedClassName,tr.GetExternalName(e)); + CheckIs(e,TPasClassType); + nestedClsType := e as TPasClassType; + for k := 0 to Pred(nestedClsType.Members.Count) do begin + if TPasElement(nestedClsType.Members[k]).InheritsFrom(TPasProperty) then + prpLst.Add(nestedClsType.Members[k]); + end; + CheckEquals(4,prpLst.Count,nestedClassName + ' properties count.'); + CheckProperty(x_intField + 'E','int',ptField,nestedClsType); + CheckProperty(x_strField + 'E','string',ptField,nestedClsType); + CheckProperty(x_strAtt + 'E','string',ptAttribute,nestedClsType); + CheckProperty(x_intAtt + 'E','int',ptAttribute,nestedClsType); + finally + FreeAndNil(prpLst); + end; + end; + + procedure CheckEmbeddedEnum(); + var + e : TPasElement; + enumType : TPasEnumType; + enumVal : TPasEnumValue; + k : Integer; + begin + nestedEnumName := Format('%s_%s_Type',[x_complexType_SampleClassType,x_enumField]); + e := tr.FindElement(nestedEnumName); + CheckNotNull(e,nestedEnumName); + CheckEquals(nestedEnumName,e.Name); + CheckEquals(nestedEnumName,tr.GetExternalName(e)); + CheckIs(e,TPasEnumType); + enumType := e as TPasEnumType; + CheckEquals(x_enumSampleLIST_COUNT,enumType.Values.Count); + for k := 0 to Pred(x_enumSampleLIST_COUNT) do begin + enumVal := TPasEnumValue(enumType.Values[k]); + CheckNotNull(enumVal,'Enum value'); + if IsReservedKeyWord(x_enumSampleLIST[k]) then begin + CheckEquals(Format('%s_%s',[enumType.Name,x_enumSampleLIST[k]]),enumVal.Name); + end else begin + CheckEquals(x_enumSampleLIST[k],enumVal.Name); + end; + CheckEquals(x_enumSampleLIST[k],tr.GetExternalName(enumVal)); + end; + end; + +var + mdl : TPasModule; + clsType : TPasClassType; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Embedded_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_class_embedded,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count); + + CheckEmbeddedClassType(); + CheckEmbeddedEnum(); + + elt := tr.FindElement(x_complexType_SampleClassType); + CheckNotNull(elt,x_complexType_SampleClassType); + CheckEquals(x_complexType_SampleClassType,elt.Name); + CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(10,prpLs.Count); + CheckProperty(x_intField,'int',ptField,clsType); + CheckProperty(x_strField,'string',ptField,clsType); + CheckProperty(x_floatField,'float',ptField,clsType); + CheckProperty(x_byteField,'byte',ptField,clsType); + CheckProperty(x_charField,'char',ptField,clsType); + CheckProperty(x_longField,'long',ptField,clsType); + CheckProperty(x_strAtt,'string',ptAttribute,clsType); + CheckProperty(x_intAtt,'int',ptAttribute,clsType); + CheckProperty(x_classField,nestedClassName,ptField,clsType); + CheckProperty(x_enumField,nestedEnumName,ptField,clsType); + + finally + FreeAndNil(prpLs); + end; +end; + +{ TTest_XsdParser } + +function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; +var + locDoc : TXMLDocument; + prs : IXsdPaser; + fileName : string; +begin + fileName := Format('.%sfiles%s%s.xsd',[PathDelim,PathDelim,ADoc]); +{$IFNDEF FPC} + fileName := Format('..%s%s',[PathDelim,fileName]); +{$ENDIF} + locDoc := LoadXmlFile(fileName); + try + Result := TwstPasTreeContainer.Create(); + CreateWstInterfaceSymbolTable(Result); + prs := TXsdParser.Create(locDoc,Result,ADoc); + prs.ParseTypes(); + finally + ReleaseDomNode(locDoc); + end; +end; + +function TTest_XsdParser.LoadEmptySchema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_empty); +end; + +function TTest_XsdParser.LoadSimpleType_Enum_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_simpleType); +end; + +function TTest_XsdParser.LoadSimpleType_Enum_Embedded_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_simpleTypeEmbedded); +end; + +function TTest_XsdParser.LoadComplexType_Class_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class); +end; + +function TTest_XsdParser.LoadComplexType_Class_Embedded_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_embedded); +end; + +{ TTest_WsdlParser } + +function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; +var + locDoc : TXMLDocument; + prs : IParser; + fileName : string; +begin + fileName := Format('.%sfiles%s%s.wsdl',[PathDelim,PathDelim,ADoc]); +{$IFNDEF FPC} + fileName := Format('..%s%s',[PathDelim,fileName]); +{$ENDIF} + locDoc := LoadXmlFile(fileName); + try + Result := TwstPasTreeContainer.Create(); + CreateWstInterfaceSymbolTable(Result); + prs := TWsdlParser.Create(locDoc,Result); + prs.Execute(pmAllTypes,ADoc); + finally + ReleaseDomNode(locDoc); + end; +end; + +function TTest_WsdlParser.LoadEmptySchema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_empty); +end; + +function TTest_WsdlParser.LoadSimpleType_Enum_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_simpleType); +end; + +function TTest_WsdlParser.LoadSimpleType_Enum_Embedded_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_simpleTypeEmbedded); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Embedded_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_embedded); +end; + +initialization + RegisterTest('XSD parser',TTest_XsdParser.Suite); + RegisterTest('WSDL parser',TTest_WsdlParser.Suite); + +end. diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 1e7dd526b..ca849d78c 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -27,7 +27,7 @@ - + @@ -40,9 +40,9 @@ - - - + + + @@ -61,33 +61,29 @@ - - + + - + - - - - - + + - @@ -101,8 +97,8 @@ - - + + @@ -122,9 +118,7 @@ - - @@ -138,8 +132,8 @@ - - + + @@ -154,8 +148,8 @@ - - + + @@ -165,24 +159,22 @@ - - - + + - - + - + @@ -190,49 +182,45 @@ - - - - - + - + - + - + - + - + @@ -241,30 +229,28 @@ - + - + - - - - - + + + - + @@ -278,241 +264,237 @@ - + - + - - - - - - - - - + + + - - - - - + + + + + - - - + + + - - - - - + + + + + + + - - - - - + + + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - - + + + + - - + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + - - - + + + @@ -520,9 +502,9 @@ - - - + + + @@ -530,9 +512,9 @@ - - - + + + @@ -540,9 +522,9 @@ - - - + + + @@ -550,9 +532,9 @@ - - - + + + @@ -560,174 +542,238 @@ - - - + + + - - - + + + - - - - - - - + + + + + - - - + + + - - - - - + + + + + - + - - - - - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -739,7 +785,7 @@ - + @@ -767,48 +813,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index 21cd81ce8..bb7ec9b3e 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -16,7 +16,7 @@ uses server_binary_formatter, metadata_repository, metadata_generator, parserdefs, server_service_intf, metadata_wsdl, test_parserdef, base_xmlrpc_formatter, wst_fpc_xml, test_utilities, - server_service_xmlrpc; + server_service_xmlrpc, test_parsers; Const ShortOpts = 'alh'; diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi index 788e90f1c..c8ecea460 100644 --- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi @@ -7,7 +7,7 @@ - + @@ -32,13 +32,13 @@ - + - + - + @@ -49,8 +49,8 @@ - - + + @@ -67,12 +67,10 @@ - - @@ -107,9 +105,9 @@ - - - + + + @@ -117,9 +115,9 @@ - - - + + + @@ -129,7 +127,7 @@ - + @@ -142,7 +140,7 @@ - + @@ -154,7 +152,7 @@ - + @@ -170,7 +168,7 @@ - + @@ -286,10 +284,10 @@ - - - - + + + + @@ -298,7 +296,7 @@ - + @@ -313,7 +311,7 @@ - + @@ -344,10 +342,10 @@ - - - - + + + + @@ -440,7 +438,7 @@ - + @@ -455,8 +453,8 @@ - - + + @@ -474,7 +472,7 @@ - + @@ -498,7 +496,7 @@ - + @@ -515,7 +513,7 @@ - + @@ -556,7 +554,7 @@ - + @@ -599,7 +597,7 @@ - + @@ -609,7 +607,7 @@ - + @@ -682,20 +680,75 @@ - - + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -721,8 +774,10 @@ - + + + diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm index 0dde68c23..5ece4319b 100644 --- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm +++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm @@ -78,11 +78,9 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit PopupMenu = PopupMenu2 TabOrder = 0 BookMarkOptions.Xoffset = 81 - BookMarkOptions.OnChange = nil Gutter.DigitCount = 5 Gutter.ShowLineNumbers = True Gutter.ShowCodeFolding = True - Gutter.OnChange = nil Gutter.CodeFoldingWidth = 14 Highlighter = SynPasSyn1 Keystrokes = < @@ -407,7 +405,6 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit ShortCut = 24642 end> ReadOnly = True - SelectedColor.OnChange = nil end end object tsWSDL: TTabSheet @@ -427,9 +424,7 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit PopupMenu = PopupMenu2 TabOrder = 0 BookMarkOptions.Xoffset = 54 - BookMarkOptions.OnChange = nil Gutter.ShowLineNumbers = True - Gutter.OnChange = nil Gutter.CodeFoldingWidth = 14 Highlighter = SynXMLSyn1 Keystrokes = < @@ -754,7 +749,6 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit ShortCut = 24642 end> ReadOnly = True - SelectedColor.OnChange = nil end end object tsProxy: TTabSheet @@ -774,9 +768,11 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit PopupMenu = PopupMenu2 TabOrder = 0 BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil Gutter.DigitCount = 5 Gutter.ShowLineNumbers = True Gutter.ShowCodeFolding = True + Gutter.OnChange = nil Gutter.CodeFoldingWidth = 14 Highlighter = SynPasSyn1 Keystrokes = < @@ -1101,6 +1097,7 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit ShortCut = 24642 end> ReadOnly = True + SelectedColor.OnChange = nil end end object tsImp: TTabSheet @@ -1120,9 +1117,11 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit PopupMenu = PopupMenu2 TabOrder = 0 BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil Gutter.DigitCount = 5 Gutter.ShowLineNumbers = True Gutter.ShowCodeFolding = True + Gutter.OnChange = nil Gutter.CodeFoldingWidth = 14 Highlighter = SynPasSyn1 Keystrokes = < @@ -1447,6 +1446,7 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit ShortCut = 24642 end> ReadOnly = True + SelectedColor.OnChange = nil end end object tsBinder: TTabSheet @@ -1466,10 +1466,12 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit PopupMenu = PopupMenu2 TabOrder = 0 BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil Gutter.AutoSize = True Gutter.DigitCount = 5 Gutter.ShowLineNumbers = True Gutter.ShowCodeFolding = True + Gutter.OnChange = nil Gutter.CodeFoldingWidth = 14 Highlighter = SynPasSyn1 Keystrokes = < @@ -1794,6 +1796,7 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit ShortCut = 24642 end> ReadOnly = True + SelectedColor.OnChange = nil end end object tsLog: TTabSheet diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs index ec4054c52..2611f08f5 100644 --- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs +++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs @@ -22,63 +22,61 @@ LazarusResources.Add('TfWstTypeLibraryEdit','FORMDATA',[ +'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHA' +'RSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Co' +'urier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'Popu' - +'pMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOptions' - +'.OnChange'#13#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gut' - +'ter.ShowCodeFolding'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFoldingWidth'#2 - +#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command'#2#3#8'Sh' - +'ortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3#211#0#8 - +'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2'h'#8'S' - +'hortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command'#2#1#8 - +'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2#5#8'S' - +'hortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2#8'S' - +'hortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6#8 - +'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2#10 - +#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2#14#8 - +'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2#9#8 - +'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13#8 - +'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8 - +'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8 - +'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8 - +'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8 - +'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0 - +#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3 - +'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Comman' - +'d'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Co' - +'mmand'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@' - +#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'Short' - +'Cut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3 - +#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Comm' - +'and'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7 - +'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@' - +#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3 - +'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortC' - +'ut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8 - +'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-' - +#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3 - +'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Comman' - +'d'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'C' - +'ommand'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1 - +#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@' - +#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3 - +'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCu' - +'t'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'Sh' - +'ortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1 - +#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3 - +'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Comma' - ,'nd'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7 - +'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1 - +#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'SelectedColor.OnC' - +'hange'#13#0#0#0#9'TTabSheet'#6'tsWSDL'#7'Caption'#6#5'&WSDL'#12'ClientHeigh' - +'t'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#7'srcWSDL'#6'Height'#3'='#2 - +#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET' - +#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#233#9'Font.Name'#6#7'Courier' - +#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2' - +#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'6'#24'BookMarkOptions.OnChang' - +'e'#13#22'Gutter.ShowLineNumbers'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFol' - +'dingWidth'#2#14#11'Highlighter'#7#10'SynXMLSyn1'#10'Keystrokes'#14#1#7'Comm' - +'and'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Comma' - +'nd'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Com' - +'mand'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7 + +'pMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#17'Gutter.DigitCou' + +'nt'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#23'Gutter' + +'.CodeFoldingWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1 + +#7'Command'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7 + +'Command'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7 + +'Command'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1 + +#7'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7 + +'Command'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7 + +'Command'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7 + +'Command'#2#6#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7 + +'Command'#2#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7 + +'Command'#2#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7 + +'Command'#2#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'C' + +'ommand'#2#13#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7 + +'Command'#2#7#8'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'C' + +'ommand'#2#15#8'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7 + +'Command'#2#8#8'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'C' + +'ommand'#2#16#8'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7 + +'Command'#3#223#0#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0 + +#1#7'Command'#3'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2 + +'.'#0#1#7'Command'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCu' + +'t'#2#8#0#1#7'Command'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'S' + +'hortCut'#3#8'@'#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command' + +#3'Z'#2#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7 + +'Command'#3#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@' + +#0#1#7'Command'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3 + +'M@'#0#1#7'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'Short' + +'Cut'#3'T@'#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8 + +'ShortCut'#3'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251 + +#1#8'ShortCut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command' + +#3'Y'#2#8'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Comm' + +'and'#3'-'#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7 + +'Command'#3'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0 + +#1#7'Command'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5' + +'@'#0#1#7'Command'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut' + +#3'7@'#0#1#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'Short' + +'Cut'#3'9@'#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8 + +'ShortCut'#3'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b' + +#1#8'ShortCut'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3 + +'d'#1#8'ShortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Comman' + +'d'#3'f'#1#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'C' + +'ommand'#3'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0 + +#1#7'Command'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3 + ,'L`'#0#1#7'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut' + +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#0#0#0#9'T' + +'TabSheet'#6'tsWSDL'#7'Caption'#6#5'&WSDL'#12'ClientHeight'#3'='#2#11'Client' + +'Width'#3#245#1#0#8'TSynEdit'#7'srcWSDL'#6'Height'#3'='#2#5'Width'#3#245#1#5 + +'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7 + +'clBlack'#11'Font.Height'#2#233#9'Font.Name'#6#7'Courier'#10'Font.Pitch'#7#7 + +'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8'TabOrder'#2#0#23 + +'BookMarkOptions.Xoffset'#2'6'#22'Gutter.ShowLineNumbers'#9#23'Gutter.CodeFo' + +'ldingWidth'#2#14#11'Highlighter'#7#10'SynXMLSyn1'#10'Keystrokes'#14#1#7'Com' + +'mand'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Comm' + +'and'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Co' + +'mmand'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7 +'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'C' +'ommand'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'C' +'ommand'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7 @@ -117,23 +115,126 @@ LazarusResources.Add('TfWstTypeLibraryEdit','FORMDATA',[ +'ommand'#3'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0 +#1#7'Command'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3 +'L`'#0#1#7'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut' - +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'Select' - +'edColor.OnChange'#13#0#0#0#9'TTabSheet'#7'tsProxy'#7'Caption'#6#6'&Proxy'#12 - +'ClientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#8'srcProxy'#6'He' - +'ight'#3'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12 - +'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name' - +#6#7'Courier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10 - +'PopupMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#17'Gutter.Digi' - +'tCount'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#23'Gu' - +'tter.CodeFoldingWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes' - +#14#1#7'Command'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0 - +#1#7'Command'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0 - +#1#7'Command'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@' - ,#0#1#7'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0 - +#1#7'Command'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1 - +#7'Command'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1 - +#7'Command'#2#6#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1 - +#7'Command'#2#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7 + +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#0#0#0#9'T' + +'TabSheet'#7'tsProxy'#7'Caption'#6#6'&Proxy'#12'ClientHeight'#3'='#2#11'Clie' + +'ntWidth'#3#245#1#0#8'TSynEdit'#8'srcProxy'#6'Height'#3'='#2#5'Width'#3#245#1 + +#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7 + +#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Courier'#10'Font.Pitch'#7 + +#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8'TabOrder'#2#0 + +#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOptions.OnChange'#13#17'Gutter.' + +'DigitCount'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#15 + +'Gutter.OnChange'#13#23'Gutter.CodeFoldingWidth'#2#14#11'Highlighter'#7#10'S' + +'ynPasSyn1'#10'Keystrokes'#14#1#7'Command'#2#3#8'ShortCut'#2'&'#0#1#7'Comman' + +'d'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Co' + +'mmand'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2'h'#8'ShortCut'#3'( '#0#1#7'Com' + +'mand'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command'#2#1#8'ShortCut'#2'%'#0#1#7'C' + +'ommand'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2#5#8'ShortCut'#3'%@'#0#1#7'C' + ,'ommand'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2#8'ShortCut'#2''''#0#1#7'C' + +'ommand'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6#8'ShortCut'#3'''@'#0#1#7 + +'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2#10#8'ShortCut'#2'"'#0#1#7 + +'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2#14#8'ShortCut'#3'"@'#0#1#7 + +'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2#9#8'ShortCut'#2'!'#0#1#7'C' + +'ommand'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13#8'ShortCut'#3'!@'#0#1#7 + +'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8'ShortCut'#2'$'#0#1#7'C' + +'ommand'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8'ShortCut'#3'$@'#0#1#7 + +'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8'ShortCut'#2'#'#0#1#7'C' + +'ommand'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8'ShortCut'#3'#@'#0#1#7 + +'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0#8'ShortCut'#2'-'#0#1 + +#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3'\'#2#8'ShortCut'#3'- ' + +#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Command'#3'['#2#8'ShortCut'#3 + +'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Command'#3#245#1#8'ShortCu' + +'t'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@'#0#1#7'Command'#3'Y'#2#8 + +'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'ShortCut'#4#8#160#0#0#0#1#7'C' + +'ommand'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3#199#0#8'ShortCut'#3'A@'#0 + +#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Command'#3'b'#2#8'ShortCut'#3 + +'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7'Command'#3#254#1#8'Short' + +'Cut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@'#0#1#7'Command'#3'c'#2#8 + +'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3'V@'#0#1#7'Command'#3'[' + +#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortCut'#3'Y@'#0#1#7'Command' + +#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8'ShortCut'#3'Z@'#0#1#7'Com' + +'mand'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-'#1#8'ShortCut'#3'0@'#0#1#7 + +'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3'/'#1#8'ShortCut'#3'2@'#0 + +#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Command'#3'1'#1#8'ShortCut'#3'4' + +'@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'Command'#3'3'#1#8'ShortCut' + +#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1#7'Command'#3'5'#1#8'Short' + +'Cut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@'#0#1#7'Command'#3'_'#1#8 + +'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3'1`'#0#1#7'Command'#3'a' + +#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCut'#3'3`'#0#1#7'Command'#3 + +'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'ShortCut'#3'5`'#0#1#7'Comman' + +'d'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1#8'ShortCut'#3'7`'#0#1#7'C' + +'ommand'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3'h'#1#8'ShortCut'#3'9`'#0#1 + +#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Command'#3#232#0#8'ShortCut'#3'C' + +'`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7'Command'#3'd'#2#8'ShortCu' + +'t'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1#7'Command'#3#250#0#8'Sh' + +'ortCut'#3'B`'#0#0#8'ReadOnly'#9#22'SelectedColor.OnChange'#13#0#0#0#9'TTabS' + +'heet'#5'tsImp'#7'Caption'#6#24'Im&plementation Skeleton'#12'ClientHeight'#3 + +'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#6'srcImp'#6'Height'#3'='#2#5'Wid' + +'th'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'F' + +'ont.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Courier'#10 + +'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8 + +'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOptions.OnChange' + +#13#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCod' + +'eFolding'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFoldingWidth'#2#14#11'High' + +'lighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command'#2#3#8'ShortCut'#2 + +'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3#211#0#8'ShortCut' + +#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2'h'#8'ShortCut'#3 + +'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command'#2#1#8'ShortCut' + +#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2#5#8'ShortCut'#3 + +'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2#8'ShortCut'#2 + +''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6#8'ShortCut'#3 + +'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2#10#8'ShortCut' + +#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2#14#8'ShortCut'#3 + +'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2#9#8'ShortCut'#2 + +'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13#8'ShortCut'#3 + +'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8'ShortCut'#2 + +'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8'ShortCut'#3 + +'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8'ShortCut'#2 + +'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8'ShortCut'#3 + +'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0#8'ShortCut' + +#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3'\'#2#8'Short' + +'Cut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Command'#3'['#2#8 + ,'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Command'#3#245 + +#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@'#0#1#7'Comman' + +'d'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'ShortCut'#4#8#160 + +#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3#199#0#8'ShortC' + +'ut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Command'#3'b'#2#8 + +'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7'Command'#3 + +#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@'#0#1#7'Comm' + +'and'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3'V@'#0#1#7 + +'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortCut'#3'Y@'#0 + +#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8'ShortCut'#3 + +'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-'#1#8'ShortCu' + +'t'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3'/'#1#8'Sh' + +'ortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Command'#3'1'#1 + +#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'Command'#3 + +'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1#7'Comman' + +'d'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@'#0#1#7'C' + +'ommand'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3'1`'#0#1 + +#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCut'#3'3`' + +#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'ShortCut'#3 + +'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1#8'ShortCu' + +'t'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3'h'#1#8'Sh' + +'ortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Command'#3#232 + +#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7'Command' + +#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1#7'Comma' + +'nd'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'SelectedColor.OnChange' + +#13#0#0#0#9'TTabSheet'#8'tsBinder'#7'Caption'#6#7'&Binder'#12'ClientHeight'#3 + +'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#9'srcBinder'#6'Height'#3'='#2#5 + +'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10 + +'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Courier'#10 + +'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8 + +'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOptions.OnChange' + +#13#15'Gutter.AutoSize'#9#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumber' + +'s'#9#22'Gutter.ShowCodeFolding'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFold' + +'ingWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Comma' + +'nd'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Comman' + +'d'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Comm' + +'and'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7 + +'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'C' + +'ommand'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'C' + +'ommand'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7 + +'Command'#2#6#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7 + +'Command'#2#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7 +'Command'#2#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7 +'Command'#2#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'C' +'ommand'#2#13#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7 @@ -156,7 +257,7 @@ LazarusResources.Add('TfWstTypeLibraryEdit','FORMDATA',[ +#3'Y'#2#8'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Comm' +'and'#3'-'#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7 +'Command'#3'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0 - +#1#7'Command'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5' + ,#1#7'Command'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5' +'@'#0#1#7'Command'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut' +#3'7@'#0#1#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'Short' +'Cut'#3'9@'#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8 @@ -167,217 +268,118 @@ LazarusResources.Add('TfWstTypeLibraryEdit','FORMDATA',[ +'ommand'#3'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0 +#1#7'Command'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3 +'L`'#0#1#7'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut' - +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#0#0#0#9'T' - +'TabSheet'#5'tsImp'#7'Caption'#6#24'Im&plementation Skeleton'#12'ClientHeigh' - +'t'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#6'srcImp'#6'Height'#3'='#2#5 - +'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10 - +'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Courier'#10 - +'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8 - +'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#17'Gutter.DigitCount'#2#5#22 - +'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#23'Gutter.CodeFoldin' - +'gWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command' - +#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3 - +#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2 - +'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command' - +#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2 - +#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2 - +#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6 - +#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2 - +#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2 - +#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2 - +#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13 - +#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8 - +'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8 - +'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8 - +'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8 - +'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0 - +#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3 - +'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Comman' - ,'d'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Co' - +'mmand'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@' - +#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'Short' - +'Cut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3 - +#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Comm' - +'and'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7 - +'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@' - +#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3 - +'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortC' - +'ut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8 - +'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-' - +#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3 - +'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Comman' - +'d'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'C' - +'ommand'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1 - +#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@' - +#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3 - +'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCu' - +'t'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'Sh' - +'ortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1 - +#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3 - +'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Comma' - +'nd'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7 - +'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1 - +#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#0#0#0#9'TTabSheet'#8 - +'tsBinder'#7'Caption'#6#7'&Binder'#12'ClientHeight'#3'='#2#11'ClientWidth'#3 - +#245#1#0#8'TSynEdit'#9'srcBinder'#6'Height'#3'='#2#5'Width'#3#245#1#5'Align' - +#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlac' - +'k'#11'Font.Height'#2#236#9'Font.Name'#6#7'Courier'#10'Font.Pitch'#7#7'fpFix' - +'ed'#11'ParentColor'#8#9'PopupMenu'#7#10'PopupMenu2'#8'TabOrder'#2#0#23'Book' - +'MarkOptions.Xoffset'#2'Q'#15'Gutter.AutoSize'#9#17'Gutter.DigitCount'#2#5#22 - +'Gutter.ShowLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#23'Gutter.CodeFoldin' - +'gWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command' - +#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3 - +#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2 - +'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command' - +#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2 - +#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2 - +#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6 - +#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2 - +#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2 - +#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2 - +#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13 - +#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8 - +'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8 - +'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8 - +'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8 - +'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0 - +#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3 - +'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Comman' - +'d'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Co' - +'mmand'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@' - +#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'Short' - +'Cut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3 - +#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Comm' - +'and'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7 - +'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@' - +#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3 - +'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortC' - +'ut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8 - +'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-' - +#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3 - +'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Comman' - +'d'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'C' - ,'ommand'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1 - +#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@' - +#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3 - +'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCu' - +'t'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'Sh' - +'ortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1 - +#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3 - +'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Comma' - +'nd'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7 - +'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1 - +#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#0#0#0#9'TTabSheet'#5 - +'tsLog'#7'Caption'#6#4'&Log'#12'ClientHeight'#3'='#2#11'ClientWidth'#3#245#1 - +#0#5'TMemo'#6'mmoLog'#6'Height'#3'='#2#5'Width'#3#245#1#5'Align'#7#8'alClien' - +'t'#13'Lines.Strings'#1#6#0#0#10'ScrollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0 - +#0#0#0#9'TSplitter'#9'Splitter1'#4'Left'#3':'#1#6'Height'#3'Y'#2#5'Width'#2#8 - +#5'Color'#7#7'clBlack'#11'ParentColor'#8#0#0#9'TMainMenu'#9'MainMenu1'#4'lef' - +'t'#3'`'#1#3'top'#2'p'#0#9'TMenuItem'#9'MenuItem1'#7'Caption'#6#6'&Files'#0#9 - +'TMenuItem'#10'MenuItem16'#6'Action'#7#10'actNewFile'#7'OnClick'#7#17'actNew' - +'FileExecute'#0#0#9'TMenuItem'#9'MenuItem2'#7'Caption'#6#1'-'#0#0#9'TMenuIte' - +'m'#9'MenuItem5'#6'Action'#7#11'actOpenFile'#7'OnClick'#7#18'actOpenFileExec' - +'ute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#9'actExport'#7'OnClick'#7#16 - +'actExportExecute'#0#0#9'TMenuItem'#9'MenuItem7'#6'Action'#7#7'actSave'#7'On' - +'Click'#7#14'actSaveExecute'#0#0#9'TMenuItem'#10'MenuItem32'#6'Action'#7#9'a' - +'ctSaveAs'#7'OnClick'#7#16'actSaveAsExecute'#0#0#9'TMenuItem'#10'MenuItem17' - +#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem4'#6'Action'#7#7'actExit'#7'On' - +'Click'#7#14'actExitExecute'#0#0#0#9'TMenuItem'#10'MenuItem14'#7'Caption'#6#5 - +'&View'#0#9'TMenuItem'#10'MenuItem15'#6'Action'#7#14'actRefreshView'#7'OnCli' - +'ck'#7#21'actRefreshViewExecute'#0#0#9'TMenuItem'#10'MenuItem29'#7'Caption'#6 - +#1'-'#0#0#9'TMenuItem'#10'MenuItem30'#6'Action'#7#13'actFullExpand'#7'OnClic' - +'k'#7#20'actFullExpandExecute'#0#0#9'TMenuItem'#10'MenuItem31'#6'Action'#7#15 - +'actFullCollapse'#7'OnClick'#7#22'actFullCollapseExecute'#0#0#0#9'TMenuItem' - +#10'MenuItem10'#7'Caption'#6#8'&Edition'#0#9'TMenuItem'#10'MenuItem11'#6'Act' - +'ion'#7#13'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExecute'#0#0#9'TMenuI' - +'tem'#10'MenuItem23'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24'actCo' - +'mpoundCreateExecute'#0#0#9'TMenuItem'#10'MenuItem48'#6'Action'#7#15'actReco' - +'rdCreate'#7'OnClick'#7#22'actRecordCreateExecute'#0#0#9'TMenuItem'#10'MenuI' - +'tem25'#6'Action'#7#13'actIntfCreate'#7'OnClick'#7#20'actIntfCreateExecute'#0 - +#0#9'TMenuItem'#10'MenuItem35'#6'Action'#7#14'actArrayCreate'#7'OnClick'#7#21 - +'actArrayCreateExecute'#0#0#9'TMenuItem'#10'MenuItem36'#6'Action'#7#18'actTy' - +'peALiasCreate'#7'OnClick'#7#25'actTypeALiasCreateExecute'#0#0#9'TMenuItem' - +#10'MenuItem12'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem13'#6'Action'#7 - +#15'actUpdateObject'#7'Caption'#6#13'Update Object'#7'OnClick'#7#22'actUpdat' - +'eObjectExecute'#0#0#9'TMenuItem'#10'MenuItem34'#6'Action'#7#9'actDelete'#7 - +'OnClick'#7#16'actDeleteExecute'#0#0#0#9'TMenuItem'#9'MenuItem6'#6'Action'#7 - +#8'actAbout'#7'Caption'#6#6'&About'#7'OnClick'#7#15'actAboutExecute'#0#0#0#11 - +'TActionList'#2'AL'#4'left'#3'X'#1#3'top'#2'8'#0#7'TAction'#11'actOpenFile'#7 - +'Caption'#6#9'Open File'#18'DisableIfNoHandler'#9#9'OnExecute'#7#18'actOpenF' - +'ileExecute'#0#0#7'TAction'#7'actExit'#7'Caption'#6#4'Exit'#18'DisableIfNoHa' - +'ndler'#9#9'OnExecute'#7#14'actExitExecute'#0#0#7'TAction'#9'actExport'#7'Ca' - +'ption'#6#24'Save generated files ...'#18'DisableIfNoHandler'#9#9'OnExecute' - +#7#16'actExportExecute'#8'OnUpdate'#7#15'actExportUpdate'#0#0#7'TAction'#8'a' - +'ctAbout'#7'Caption'#6#5'About'#18'DisableIfNoHandler'#9#9'OnExecute'#7#15'a' - +'ctAboutExecute'#0#0#7'TAction'#9'actSaveAs'#7'Caption'#6#11'Save As ...'#18 - +'DisableIfNoHandler'#9#9'OnExecute'#7#16'actSaveAsExecute'#8'OnUpdate'#7#15 - +'actExportUpdate'#0#0#7'TAction'#13'actEnumCreate'#7'Caption'#6#18'Create En' - +'umeration'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actEnumCreateExecute' - +#0#0#7'TAction'#15'actUpdateObject'#7'Caption'#6#6'Update'#18'DisableIfNoHan' - +'dler'#9#9'OnExecute'#7#22'actUpdateObjectExecute'#8'OnUpdate'#7#21'actUpdat' - +'eObjectUpdate'#0#0#7'TAction'#14'actRefreshView'#7'Caption'#6#14'&Refresh V' - +'iews'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'actRefreshViewExecute'#0#0 - +#7'TAction'#10'actNewFile'#7'Caption'#6#8'New File'#18'DisableIfNoHandler'#9 - +#9'OnExecute'#7#17'actNewFileExecute'#0#0#7'TAction'#17'actCompoundCreate'#7 - +'Caption'#6#17'Create Class Type'#18'DisableIfNoHandler'#9#9'OnExecute'#7#24 - +'actCompoundCreateExecute'#0#0#7'TAction'#13'actIntfCreate'#7'Caption'#6#16 - ,'Create Interface'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actIntfCreateE' - +'xecute'#0#0#7'TAction'#13'actFullExpand'#7'Caption'#6#11'Full expand'#18'Di' - +'sableIfNoHandler'#9#9'OnExecute'#7#20'actFullExpandExecute'#0#0#7'TAction' - +#15'actFullCollapse'#7'Caption'#6#13'Full Collapse'#18'DisableIfNoHandler'#9 - +#9'OnExecute'#7#22'actFullCollapseExecute'#0#0#7'TAction'#7'actSave'#7'Capti' - +'on'#6#4'Save'#18'DisableIfNoHandler'#9#9'OnExecute'#7#14'actSaveExecute'#0#0 - +#7'TAction'#9'actDelete'#7'Caption'#6#6'Delete'#18'DisableIfNoHandler'#9#9'O' - +'nExecute'#7#16'actDeleteExecute'#8'OnUpdate'#7#21'actUpdateObjectUpdate'#0#0 - +#7'TAction'#14'actArrayCreate'#7'Caption'#6#12'Create Array'#18'DisableIfNoH' - +'andler'#9#9'OnExecute'#7#21'actArrayCreateExecute'#0#0#7'TAction'#18'actTyp' - +'eALiasCreate'#7'Caption'#6#17'Create Type ALias'#18'DisableIfNoHandler'#9#9 - +'OnExecute'#7#25'actTypeALiasCreateExecute'#0#0#7'TAction'#15'actRecordCreat' - +'e'#7'Caption'#6#13'Create Record'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22 - +'actRecordCreateExecute'#0#0#0#11'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un' - +' fichier existant'#6'Filter'#6'3WDSL files(*.WSDL)|*.WSDL|Pascal file (*.pa' - +'s)|*.pas'#11'FilterIndex'#2#0#10'InitialDir'#6#2'.\'#7'Options'#11#15'ofPat' - +'hMustExist'#15'ofFileMustExist'#14'ofEnableSizing'#12'ofViewDetail'#0#4'lef' - +'t'#3#153#1#3'top'#2'X'#0#0#10'TSynPasSyn'#10'SynPasSyn1'#7'Enabled'#8#23'Co' - +'mmentAttri.Foreground'#7#6'clBlue'#18'CommentAttri.Style'#11#6'fsBold'#0#22 - +'StringAttri.Foreground'#7#8'clMaroon'#17'SymbolAttri.Style'#11#6'fsBold'#0 - +#25'DirectiveAttri.Foreground'#7#7'clGreen'#20'DirectiveAttri.Style'#11#6'fs' - +'Bold'#0#14'NestedComments'#9#4'left'#3#183#1#3'top'#2'h'#0#0#11'TSaveDialog' - +#2'SD'#5'Title'#6#27'Enregistrer le fichier sous'#10'DefaultExt'#6#5'.WSDL'#6 - +'Filter'#6#25'WDSL files(*.WSDL)|*.WSDL'#11'FilterIndex'#2#0#7'Options'#11#15 - +'ofPathMustExist'#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#242#1#3'to' - +'p'#3#176#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#3#152#0#3'top'#3#152#0 - +#0#9'TMenuItem'#10'MenuItem28'#6'Action'#7#13'actFullExpand'#7'OnClick'#7#20 - +'actFullExpandExecute'#0#0#9'TMenuItem'#10'MenuItem27'#6'Action'#7#15'actFul' - +'lCollapse'#7'OnClick'#7#22'actFullCollapseExecute'#0#0#9'TMenuItem'#10'Menu' - +'Item39'#6'Action'#7#14'actRefreshView'#7'OnClick'#7#21'actRefreshViewExecut' - +'e'#0#0#9'TMenuItem'#10'MenuItem26'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'Men' - +'uItem8'#6'Action'#7#13'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExecute' - +#0#0#9'TMenuItem'#10'MenuItem21'#6'Action'#7#17'actCompoundCreate'#7'OnClick' - +#7#24'actCompoundCreateExecute'#0#0#9'TMenuItem'#10'MenuItem46'#6'Action'#7 - +#15'actRecordCreate'#7'OnClick'#7#22'actRecordCreateExecute'#0#0#9'TMenuItem' - +#10'MenuItem24'#6'Action'#7#13'actIntfCreate'#7'OnClick'#7#20'actIntfCreateE' - +'xecute'#0#0#9'TMenuItem'#10'MenuItem37'#6'Action'#7#14'actArrayCreate'#7'On' - +'Click'#7#21'actArrayCreateExecute'#0#0#9'TMenuItem'#10'MenuItem38'#6'Action' - +#7#18'actTypeALiasCreate'#7'OnClick'#7#25'actTypeALiasCreateExecute'#0#0#9'T' - +'MenuItem'#10'MenuItem22'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem9'#6 - +'Action'#7#15'actUpdateObject'#7'OnClick'#7#22'actUpdateObjectExecute'#0#0#9 - +'TMenuItem'#10'MenuItem33'#6'Action'#7#9'actDelete'#7'OnClick'#7#16'actDelet' - +'eExecute'#0#0#0#10'TPopupMenu'#10'PopupMenu2'#4'left'#3#16#2#3'top'#3#235#0 - +#0#9'TMenuItem'#10'MenuItem18'#6'Action'#7#14'actRefreshView'#7'OnClick'#7#21 - +'actRefreshViewExecute'#0#0#9'TMenuItem'#10'MenuItem19'#7'Caption'#6#1'-'#0#0 - +#9'TMenuItem'#10'MenuItem20'#6'Action'#7#9'actExport'#7'OnClick'#7#16'actExp' - +'ortExecute'#0#0#9'TMenuItem'#10'MenuItem40'#7'Caption'#6#1'-'#0#0#9'TMenuIt' - +'em'#10'MenuItem41'#6'Action'#7#14'actArrayCreate'#7'OnClick'#7#21'actArrayC' - +'reateExecute'#0#0#9'TMenuItem'#10'MenuItem45'#6'Action'#7#17'actCompoundCre' - +'ate'#7'OnClick'#7#24'actCompoundCreateExecute'#0#0#9'TMenuItem'#10'MenuItem' - +'47'#6'Action'#7#15'actRecordCreate'#7'OnClick'#7#22'actRecordCreateExecute' - +#0#0#9'TMenuItem'#10'MenuItem44'#6'Action'#7#13'actEnumCreate'#7'OnClick'#7 - +#20'actEnumCreateExecute'#0#0#9'TMenuItem'#10'MenuItem43'#6'Action'#7#13'act' - +'IntfCreate'#7'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuI' - +'tem42'#6'Action'#7#18'actTypeALiasCreate'#7'OnClick'#7#25'actTypeALiasCreat' - +'eExecute'#0#0#0#10'TSynXMLSyn'#10'SynXMLSyn1'#13'DefaultFilter'#6#30'Docume' - +'nts WSDL (*.wsdl)|*.wsdl'#7'Enabled'#8#23'ElementAttri.Foreground'#7#6'clNa' - +'vy'#30'AttributeValueAttri.Foreground'#7#8'clPurple'#16'WantBracesParsed'#8 - +#4'left'#3#210#1#3'top'#3#252#0#0#0#0 + +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'Select' + +'edColor.OnChange'#13#0#0#0#9'TTabSheet'#5'tsLog'#7'Caption'#6#4'&Log'#12'Cl' + +'ientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#5'TMemo'#6'mmoLog'#6'Height'#3 + +'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#0#0#10'S' + +'crollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#0#0#9'TSplitter'#9'Splitter1'#4 + +'Left'#3':'#1#6'Height'#3'Y'#2#5'Width'#2#8#5'Color'#7#7'clBlack'#11'ParentC' + +'olor'#8#0#0#9'TMainMenu'#9'MainMenu1'#4'left'#3'`'#1#3'top'#2'p'#0#9'TMenuI' + +'tem'#9'MenuItem1'#7'Caption'#6#6'&Files'#0#9'TMenuItem'#10'MenuItem16'#6'Ac' + +'tion'#7#10'actNewFile'#7'OnClick'#7#17'actNewFileExecute'#0#0#9'TMenuItem'#9 + +'MenuItem2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem5'#6'Action'#7#11'a' + +'ctOpenFile'#7'OnClick'#7#18'actOpenFileExecute'#0#0#9'TMenuItem'#9'MenuItem' + +'3'#6'Action'#7#9'actExport'#7'OnClick'#7#16'actExportExecute'#0#0#9'TMenuIt' + +'em'#9'MenuItem7'#6'Action'#7#7'actSave'#7'OnClick'#7#14'actSaveExecute'#0#0 + +#9'TMenuItem'#10'MenuItem32'#6'Action'#7#9'actSaveAs'#7'OnClick'#7#16'actSav' + +'eAsExecute'#0#0#9'TMenuItem'#10'MenuItem17'#7'Caption'#6#1'-'#0#0#9'TMenuIt' + +'em'#9'MenuItem4'#6'Action'#7#7'actExit'#7'OnClick'#7#14'actExitExecute'#0#0 + +#0#9'TMenuItem'#10'MenuItem14'#7'Caption'#6#5'&View'#0#9'TMenuItem'#10'MenuI' + +'tem15'#6'Action'#7#14'actRefreshView'#7'OnClick'#7#21'actRefreshViewExecute' + +#0#0#9'TMenuItem'#10'MenuItem29'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuI' + +'tem30'#6'Action'#7#13'actFullExpand'#7'OnClick'#7#20'actFullExpandExecute'#0 + +#0#9'TMenuItem'#10'MenuItem31'#6'Action'#7#15'actFullCollapse'#7'OnClick'#7 + +#22'actFullCollapseExecute'#0#0#0#9'TMenuItem'#10'MenuItem10'#7'Caption'#6#8 + +'&Edition'#0#9'TMenuItem'#10'MenuItem11'#6'Action'#7#13'actEnumCreate'#7'OnC' + +'lick'#7#20'actEnumCreateExecute'#0#0#9'TMenuItem'#10'MenuItem23'#6'Action'#7 + +#17'actCompoundCreate'#7'OnClick'#7#24'actCompoundCreateExecute'#0#0#9'TMenu' + +'Item'#10'MenuItem48'#6'Action'#7#15'actRecordCreate'#7'OnClick'#7#22'actRec' + +'ordCreateExecute'#0#0#9'TMenuItem'#10'MenuItem25'#6'Action'#7#13'actIntfCre' + +'ate'#7'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem35'#6 + +'Action'#7#14'actArrayCreate'#7'OnClick'#7#21'actArrayCreateExecute'#0#0#9'T' + +'MenuItem'#10'MenuItem36'#6'Action'#7#18'actTypeALiasCreate'#7'OnClick'#7#25 + +'actTypeALiasCreateExecute'#0#0#9'TMenuItem'#10'MenuItem12'#7'Caption'#6#1'-' + +#0#0#9'TMenuItem'#10'MenuItem13'#6'Action'#7#15'actUpdateObject'#7'Caption'#6 + +#13'Update Object'#7'OnClick'#7#22'actUpdateObjectExecute'#0#0#9'TMenuItem' + +#10'MenuItem34'#6'Action'#7#9'actDelete'#7'OnClick'#7#16'actDeleteExecute'#0 + +#0#0#9'TMenuItem'#9'MenuItem6'#6'Action'#7#8'actAbout'#7'Caption'#6#6'&About' + +#7'OnClick'#7#15'actAboutExecute'#0#0#0#11'TActionList'#2'AL'#4'left'#3'X'#1 + +#3'top'#2'8'#0#7'TAction'#11'actOpenFile'#7'Caption'#6#9'Open File'#18'Disab' + +'leIfNoHandler'#9#9'OnExecute'#7#18'actOpenFileExecute'#0#0#7'TAction'#7'act' + +'Exit'#7'Caption'#6#4'Exit'#18'DisableIfNoHandler'#9#9'OnExecute'#7#14'actEx' + +'itExecute'#0#0#7'TAction'#9'actExport'#7'Caption'#6#24'Save generated files' + +' ...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actExportExecute'#8'OnUpda' + +'te'#7#15'actExportUpdate'#0#0#7'TAction'#8'actAbout'#7'Caption'#6#5'About' + +#18'DisableIfNoHandler'#9#9'OnExecute'#7#15'actAboutExecute'#0#0#7'TAction'#9 + +'actSaveAs'#7'Caption'#6#11'Save As ...'#18'DisableIfNoHandler'#9#9'OnExecut' + +'e'#7#16'actSaveAsExecute'#8'OnUpdate'#7#15'actExportUpdate'#0#0#7'TAction' + +#13'actEnumCreate'#7'Caption'#6#18'Create Enumeration'#18'DisableIfNoHandler' + +#9#9'OnExecute'#7#20'actEnumCreateExecute'#0#0#7'TAction'#15'actUpdateObject' + +#7'Caption'#6#6'Update'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22'actUpdate' + +'ObjectExecute'#8'OnUpdate'#7#21'actUpdateObjectUpdate'#0#0#7'TAction'#14'ac' + +'tRefreshView'#7'Caption'#6#14'&Refresh Views'#18'DisableIfNoHandler'#9#9'On' + +'Execute'#7#21'actRefreshViewExecute'#0#0#7'TAction'#10'actNewFile'#7'Captio' + +'n'#6#8'New File'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actNewFileExecu' + +'te'#0#0#7'TAction'#17'actCompoundCreate'#7'Caption'#6#17'Create Class Type' + ,#18'DisableIfNoHandler'#9#9'OnExecute'#7#24'actCompoundCreateExecute'#0#0#7 + +'TAction'#13'actIntfCreate'#7'Caption'#6#16'Create Interface'#18'DisableIfNo' + +'Handler'#9#9'OnExecute'#7#20'actIntfCreateExecute'#0#0#7'TAction'#13'actFul' + +'lExpand'#7'Caption'#6#11'Full expand'#18'DisableIfNoHandler'#9#9'OnExecute' + +#7#20'actFullExpandExecute'#0#0#7'TAction'#15'actFullCollapse'#7'Caption'#6 + +#13'Full Collapse'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22'actFullCollaps' + +'eExecute'#0#0#7'TAction'#7'actSave'#7'Caption'#6#4'Save'#18'DisableIfNoHand' + +'ler'#9#9'OnExecute'#7#14'actSaveExecute'#0#0#7'TAction'#9'actDelete'#7'Capt' + +'ion'#6#6'Delete'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actDeleteExecut' + +'e'#8'OnUpdate'#7#21'actUpdateObjectUpdate'#0#0#7'TAction'#14'actArrayCreate' + +#7'Caption'#6#12'Create Array'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'ac' + +'tArrayCreateExecute'#0#0#7'TAction'#18'actTypeALiasCreate'#7'Caption'#6#17 + +'Create Type ALias'#18'DisableIfNoHandler'#9#9'OnExecute'#7#25'actTypeALiasC' + +'reateExecute'#0#0#7'TAction'#15'actRecordCreate'#7'Caption'#6#13'Create Rec' + +'ord'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22'actRecordCreateExecute'#0#0 + +#0#11'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un fichier existant'#6'Filter' + +#6'3WDSL files(*.WSDL)|*.WSDL|Pascal file (*.pas)|*.pas'#11'FilterIndex'#2#0 + +#10'InitialDir'#6#2'.\'#7'Options'#11#15'ofPathMustExist'#15'ofFileMustExist' + +#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#153#1#3'top'#2'X'#0#0#10'TS' + +'ynPasSyn'#10'SynPasSyn1'#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlu' + +'e'#18'CommentAttri.Style'#11#6'fsBold'#0#22'StringAttri.Foreground'#7#8'clM' + +'aroon'#17'SymbolAttri.Style'#11#6'fsBold'#0#25'DirectiveAttri.Foreground'#7 + +#7'clGreen'#20'DirectiveAttri.Style'#11#6'fsBold'#0#14'NestedComments'#9#4'l' + +'eft'#3#183#1#3'top'#2'h'#0#0#11'TSaveDialog'#2'SD'#5'Title'#6#27'Enregistre' + +'r le fichier sous'#10'DefaultExt'#6#5'.WSDL'#6'Filter'#6#25'WDSL files(*.WS' + +'DL)|*.WSDL'#11'FilterIndex'#2#0#7'Options'#11#15'ofPathMustExist'#14'ofEnab' + +'leSizing'#12'ofViewDetail'#0#4'left'#3#242#1#3'top'#3#176#0#0#0#10'TPopupMe' + +'nu'#10'PopupMenu1'#4'left'#3#152#0#3'top'#3#152#0#0#9'TMenuItem'#10'MenuIte' + +'m28'#6'Action'#7#13'actFullExpand'#7'OnClick'#7#20'actFullExpandExecute'#0#0 + +#9'TMenuItem'#10'MenuItem27'#6'Action'#7#15'actFullCollapse'#7'OnClick'#7#22 + +'actFullCollapseExecute'#0#0#9'TMenuItem'#10'MenuItem39'#6'Action'#7#14'actR' + +'efreshView'#7'OnClick'#7#21'actRefreshViewExecute'#0#0#9'TMenuItem'#10'Menu' + +'Item26'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem8'#6'Action'#7#13'actE' + +'numCreate'#7'OnClick'#7#20'actEnumCreateExecute'#0#0#9'TMenuItem'#10'MenuIt' + +'em21'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24'actCompoundCreateEx' + +'ecute'#0#0#9'TMenuItem'#10'MenuItem46'#6'Action'#7#15'actRecordCreate'#7'On' + +'Click'#7#22'actRecordCreateExecute'#0#0#9'TMenuItem'#10'MenuItem24'#6'Actio' + +'n'#7#13'actIntfCreate'#7'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuIte' + +'m'#10'MenuItem37'#6'Action'#7#14'actArrayCreate'#7'OnClick'#7#21'actArrayCr' + +'eateExecute'#0#0#9'TMenuItem'#10'MenuItem38'#6'Action'#7#18'actTypeALiasCre' + +'ate'#7'OnClick'#7#25'actTypeALiasCreateExecute'#0#0#9'TMenuItem'#10'MenuIte' + +'m22'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem9'#6'Action'#7#15'actUpda' + +'teObject'#7'OnClick'#7#22'actUpdateObjectExecute'#0#0#9'TMenuItem'#10'MenuI' + +'tem33'#6'Action'#7#9'actDelete'#7'OnClick'#7#16'actDeleteExecute'#0#0#0#10 + +'TPopupMenu'#10'PopupMenu2'#4'left'#3#16#2#3'top'#3#235#0#0#9'TMenuItem'#10 + +'MenuItem18'#6'Action'#7#14'actRefreshView'#7'OnClick'#7#21'actRefreshViewEx' + +'ecute'#0#0#9'TMenuItem'#10'MenuItem19'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10 + +'MenuItem20'#6'Action'#7#9'actExport'#7'OnClick'#7#16'actExportExecute'#0#0#9 + +'TMenuItem'#10'MenuItem40'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem41' + +#6'Action'#7#14'actArrayCreate'#7'OnClick'#7#21'actArrayCreateExecute'#0#0#9 + +'TMenuItem'#10'MenuItem45'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24 + +'actCompoundCreateExecute'#0#0#9'TMenuItem'#10'MenuItem47'#6'Action'#7#15'ac' + +'tRecordCreate'#7'OnClick'#7#22'actRecordCreateExecute'#0#0#9'TMenuItem'#10 + +'MenuItem44'#6'Action'#7#13'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExec' + +'ute'#0#0#9'TMenuItem'#10'MenuItem43'#6'Action'#7#13'actIntfCreate'#7'OnClic' + +'k'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem42'#6'Action'#7#18 + +'actTypeALiasCreate'#7'OnClick'#7#25'actTypeALiasCreateExecute'#0#0#0#10'TSy' + +'nXMLSyn'#10'SynXMLSyn1'#13'DefaultFilter'#6#30'Documents WSDL (*.wsdl)|*.ws' + +'dl'#7'Enabled'#8#23'ElementAttri.Foreground'#7#6'clNavy'#30'AttributeValueA' + +'ttri.Foreground'#7#8'clPurple'#16'WantBracesParsed'#8#4'left'#3#210#1#3'top' + +#3#252#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas index 4a92b1bd3..1af5302cf 100644 --- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas +++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas @@ -168,7 +168,7 @@ var implementation uses view_helper, DOM, XMLRead, XMLWrite, //HeapTrc, - wsdl2pas_imp, source_utils, command_line_parser, generator, metadata_generator, + xsd_parser, wsdl_parser, source_utils, command_line_parser, generator, metadata_generator, binary_streamer, wst_resources_utils, wsdl_generator, uabout, edit_helper, udm, ufrmsaveoption, pparser {$IFDEF WST_IDE},LazIDEIntf,IDEMsgIntf{$ENDIF}; @@ -249,7 +249,7 @@ function ParseWsdlFile( ):TwstPasTreeContainer;overload; var locDoc : TXMLDocument; - prsr : TWsdlParser; + prsr : IParser; symName : string; begin Result := nil; @@ -262,15 +262,13 @@ begin try Result := TwstPasTreeContainer.Create(); try - prsr := TWsdlParser.Create(locDoc,Result); - prsr.OnMessage := ANotifier; - prsr.Parse(pmAllTypes,symName); + prsr := TWsdlParser.Create(locDoc,Result,ANotifier); + prsr.Execute(pmAllTypes,symName); except FreeAndNil(Result); raise; end; finally - FreeAndNil(prsr); FreeAndNil(locDoc); end; end; @@ -389,12 +387,15 @@ begin end; function CreateSymbolTable(const AName : string):TwstPasTreeContainer ; +var + mdl : TPasModule; begin Result := TwstPasTreeContainer.Create(); try CreateWstInterfaceSymbolTable(Result); - Result.CreateElement(TPasModule,AName,Result.Package,visDefault,'',0); - Result.CurrentModule.InterfaceSection := TPasSection(Result.CreateElement(TPasSection,'',Result.CurrentModule,visDefault,'',0)); + mdl := TPasModule(Result.CreateElement(TPasModule,AName,Result.Package,visDefault,'',0)); + mdl.InterfaceSection := TPasSection(Result.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + Result.Package.Modules.Add(mdl); except FreeAndNil(Result); raise; @@ -708,6 +709,7 @@ var objPtr : ISymbolPainter; nd : TTreeNode; begin + mmoLog.Clear(); trvSchema.BeginUpdate(); try trvSchema.Items.Clear(); diff --git a/wst/trunk/ws_helper/delphi/ws_helper.dof b/wst/trunk/ws_helper/delphi/ws_helper.dof index b8be73107..2b1d9c816 100644 --- a/wst/trunk/ws_helper/delphi/ws_helper.dof +++ b/wst/trunk/ws_helper/delphi/ws_helper.dof @@ -100,7 +100,7 @@ Conditionals= DebugSourceDirs=C:\Programmes\lazarus\wst\trunk\fcl-units\rtl\;C:\Programmes\lazarus\wst\trunk\;C:\Programmes\lazarus\wst\trunk\fcl-units\fcl-passrc\src\ UsePackages=0 [Parameters] -RunParams=-u -i -p -b -a"C:\Programmes\lazarus\wst\trunk\tests\files" "C:\Programmes\lazarus\utils\googleapi\GoogleSearch.wsdl" +RunParams=-uA -i -p -b -a"C:\Programmes\lazarus\wst\trunk\tests\files" "C:\Programmes\lazarus\wst\trunk\type_lib_edtr\files\company.xsd" HostApplication= Launcher= UseLauncher=0 @@ -149,14 +149,15 @@ Item0=C:\Programmes\lazarus\wst\trunk\fcl-units\rtl\;C:\Programmes\lazarus\wst\t Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; [HistoryLists\hlSearchPath] -Count=7 +Count=8 Item0=..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl\inc;..\..\wst_rtti_filter -Item1=..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl;..\..\wst_rtti_filter -Item2=..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl -Item3=..\;..\..\;..\..\fcl-units\fcl-passrc\src -Item4=..\;..\..\;..\..\fcl-passrc\src -Item5=..\;..\..\ -Item6=..\ +Item1=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl\inc;..\..\wst_rtti_filter +Item2=..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl;..\..\wst_rtti_filter +Item3=..\;..\..\;..\..\fcl-units\fcl-passrc\src;..\..\fcl-units\rtl +Item4=..\;..\..\;..\..\fcl-units\fcl-passrc\src +Item5=..\;..\..\;..\..\fcl-passrc\src +Item6=..\;..\..\ +Item7=..\ [HistoryLists\hlUnitOutputDirectory] Count=1 Item0=obj diff --git a/wst/trunk/ws_helper/delphi/ws_helper.dpr b/wst/trunk/ws_helper/delphi/ws_helper.dpr index f51ff7698..8bee48eb8 100644 --- a/wst/trunk/ws_helper/delphi/ws_helper.dpr +++ b/wst/trunk/ws_helper/delphi/ws_helper.dpr @@ -35,11 +35,13 @@ uses XMLDoc, XMLIntf, wst_delphi_xml, - wsdl2pas_imp, pastree, pparser, pascal_parser_intf, - logger_intf; + logger_intf, + xsd_parser, + ws_parser_imp, + wsdl_parser; {$INCLUDE ws_helper_prog.inc} diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index 3ff123303..7ddec925a 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -164,11 +164,10 @@ type procedure GenerateCustomMetadatas(); function GetDestUnitName():string; + + procedure PrepareModule(); + procedure InternalExecute(); public - constructor Create( - ASymTable : TwstPasTreeContainer; - ASrcMngr : ISourceManager - ); procedure Execute();override; end; @@ -2272,22 +2271,7 @@ begin Result := SymbolTable.CurrentModule.Name; end; -constructor TInftGenerator.Create( - ASymTable : TwstPasTreeContainer; - ASrcMngr : ISourceManager -); -begin - inherited Create(ASymTable,ASrcMngr); - FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); - FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp'); - FImpTempStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp'); - FImpLastStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp_last'); - FRttiFunc := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_rtti_func'); - FImpTempStream.IncIndent(); - FImpLastStream.IncIndent(); -end; - -procedure TInftGenerator.Execute(); +procedure TInftGenerator.InternalExecute(); procedure SortRecords(AList : TList); var @@ -2361,7 +2345,9 @@ var elt : TPasElement; classAncestor : TPasElement; tmpList : TList; + intfCount : PtrInt; begin + intfCount := 0; objLst := nil; tmpList := nil; gnrClssLst := TObjectList.Create(False); @@ -2470,15 +2456,19 @@ begin elt := TPasElement(typeList[i]); if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin GenerateIntf(TPasClassType(elt)); + Inc(intfCount); end; end; - NewLine(); - IncIndent(); - Indent(); WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.CurrentModule.Name]); - DecIndent(); - GenerateCustomMetadatas(); - + if ( intfCount > 0 ) then begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + Indent(); WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.CurrentModule.Name]); + DecIndent(); + GenerateCustomMetadatas(); + end; + FImpLastStream.NewLine(); GenerateUnitImplementationFooter(); FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream,FRttiFunc,FImpTempStream,FImpLastStream]); @@ -2492,4 +2482,37 @@ begin end; end; +procedure TInftGenerator.PrepareModule(); +begin + FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); + FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp'); + FImpTempStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp'); + FImpLastStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp_last'); + FRttiFunc := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_rtti_func'); + FImpTempStream.IncIndent(); + FImpLastStream.IncIndent(); +end; + +procedure TInftGenerator.Execute(); +var + oldCurrent, mdl : TPasModule; + i : PtrInt; + mdlList : TList; +begin + oldCurrent := SymbolTable.CurrentModule; + try + mdlList := SymbolTable.Package.Modules; + for i := 0 to Pred(mdlList.Count) do begin + mdl := TPasModule(mdlList[i]); + if not mdl.InheritsFrom(TPasNativeModule) then begin + SymbolTable.SetCurrentModule(mdl); + PrepareModule(); + InternalExecute(); + end; + end; + finally + SymbolTable.SetCurrentModule(oldCurrent); + end; +end; + end. diff --git a/wst/trunk/ws_helper/logger_intf.pas b/wst/trunk/ws_helper/logger_intf.pas index b0605fc64..bef69f6f4 100644 --- a/wst/trunk/ws_helper/logger_intf.pas +++ b/wst/trunk/ws_helper/logger_intf.pas @@ -46,8 +46,9 @@ type end; - function SetLogger(ALogger : ILogger) : ILogger; - function GetLogger() : ILogger; + function HasLogger() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function SetLogger(ALogger : ILogger) : ILogger;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetLogger() : ILogger;{$IFDEF USE_INLINE}inline;{$ENDIF} implementation @@ -63,6 +64,11 @@ begin Result := FLogger; end; +function HasLogger() : Boolean; +begin + Result := Assigned(FLogger); +end; + { TSimpleConsoleLogger } procedure TSimpleConsoleLogger.Log(const AMsgType: TMessageType; const AMsg: string); diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index c028e8e3f..b90d01123 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -22,18 +22,121 @@ unit parserutils; interface uses - SysUtils; + SysUtils, Classes + {$IFNDEF FPC}, xmldom, wst_delphi_xml{$ELSE},DOM{$ENDIF} + , cursor_intf, dom_cursors + ; const - sNEW_LINE = {$ifndef Unix}#13#10{$else}#10{$endif}; + s_address : WideString = 'address'; + s_all : WideString = 'all'; + //s_any : WideString = 'any'; + s_annotation : WideString = 'annotation'; + s_appinfo : WideString = 'appinfo'; + s_array : WideString = 'array'; + s_arrayType : WideString = 'arrayType'; + s_attribute : WideString = 'attribute'; + s_base : WideString = 'base'; + s_binding : WideString = 'binding'; + s_body : WideString = 'body'; + s_complexContent : WideString = 'complexContent'; + s_complexType : WideString = 'complexType'; + s_customAttributes : WideString = 'customAttributes'; + s_document : WideString = 'document'; + s_element : WideString = 'element'; + s_enumeration : WideString = 'enumeration'; + s_extension : WideString = 'extension'; + s_guid : WideString = 'GUID'; + s_headerBlock : WideString = 'headerBlock'; + s_input : WideString = 'input'; + s_item : WideString = 'item'; + s_location : WideString = 'location'; + s_message : WideString = 'message'; + s_maxOccurs : WideString = 'maxOccurs'; + s_minOccurs : WideString = 'minOccurs'; + s_name : WideString = 'name'; + s_operation : WideString = 'operation'; + s_optional : WideString = 'optional'; + s_output : WideString = 'output'; + s_part : WideString = 'part'; + s_port : WideString = 'port'; + s_portType : WideString = 'portType'; + s_prohibited : WideString = 'prohibited'; + s_record : WideString = 'record'; + s_ref : WideString = 'ref'; + s_required : WideString = 'required'; + s_restriction : WideString = 'restriction'; + //s_return : WideString = 'return'; + s_rpc : WideString = 'rpc'; + s_schema : WideString = 'schema'; + s_xs : WideString = 'http://www.w3.org/2001/XMLSchema'; + s_sequence : WideString = 'sequence'; + s_service : WideString = 'service'; + s_simpleContent : WideString = 'simpleContent'; + s_simpleType : WideString = 'simpleType'; + s_soap : WideString = 'http://schemas.xmlsoap.org/wsdl/soap/'; + s_soapAction : WideString = 'soapAction'; + s_soapInputEncoding : WideString = 'Input_EncodingStyle'; + s_soapOutputEncoding : WideString = 'OutputEncodingStyle'; + s_soapStyle : WideString = 'style'; + s_style : WideString = 'style'; + s_targetNamespace : WideString = 'targetNamespace'; + s_type : WideString = 'type'; + s_types : WideString = 'types'; + s_unbounded : WideString = 'unbounded'; + s_use : WideString = 'use'; + s_value : WideString = 'value'; + s_wsdl : WideString = 'http://schemas.xmlsoap.org/wsdl/'; + s_xmlns : WideString = 'xmlns'; + +type + TNotFoundAction = ( nfaNone, nfaRaiseException ); + +const + sNEW_LINE = sLineBreak; function IsStrEmpty(Const AStr : String):Boolean; function ExtractIdentifier(const AValue : string) : string ; - + function IsReservedKeyWord(const AValue : string):Boolean ; + + procedure ExtractNameSpaceShortNamesNested( + ANode : TDOMNode; + AResList : TStrings; + const ANameSpace : WideString + ); + function CreateQualifiedNameFilterStr( + const AName : WideString; + APrefixList : TStrings + ) : string; + function ExtractNameFromQName(const AQName : string):string ; + procedure ExtractNameSpaceShortNames( + AAttribCursor : IObjectCursor; + AResList : TStrings; + const ANameSpace : WideString; + const ANotFoundAction : TNotFoundAction; + const AClearBefore : Boolean; + const AExceptionClass : ExceptClass + ); + function AddNameSpace(const AValue: string; ANameSpaceList : TStrings): TStrings; + procedure BuildNameSpaceList(AAttCursor : IObjectCursor; ANameSpaceList : TStrings); + procedure ExplodeQName(const AQName : string; out ALocalName, ANameSpace : string) ; + function wst_findCustomAttribute( + AWsdlShortNames : TStrings; + ANode : TDOMNode; + const AAttribute : string; + out AValue : string + ) : Boolean; + function wst_findCustomAttributeXsd( + AXsdShortNames : TStrings; + ANode : TDOMNode; + const AAttribute : string; + out AValue : string + ) : Boolean; + implementation -uses StrUtils; +uses StrUtils, rtti_filters; const LANGAGE_TOKEN : array[0..107] of string = ( 'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM', @@ -90,6 +193,246 @@ begin end; end; +function ExtractNameFromQName(const AQName : string):string ; +var + i : Integer; +begin + Result := Trim(AQName); + i := Pos(':',Result); + if ( i > 0 ) then + Result := Copy(Result,( i + 1 ), MaxInt); +end; + +function CreateQualifiedNameFilterStr( + const AName : WideString; + APrefixList : TStrings +) : string; +var + k : Integer; + locStr : string; + locWStr : WideString; +begin + Result := ''; + if ( APrefixList.Count > 0 ) then begin + for k := 0 to Pred(APrefixList.Count) do begin + if IsStrEmpty(APrefixList[k]) then begin + locWStr := '' + end else begin + locWStr := APrefixList[k] + ':'; + end; + locWStr := locWStr + AName; + locStr := s_NODE_NAME; + Result := Result + ' or ' + locStr + ' = ' + QuotedStr(locWStr); + end; + if ( Length(Result) > 0 ) then begin + Delete(Result,1,Length(' or')); + end; + end else begin + Result := Format('%s = %s',[s_NODE_NAME,QuotedStr(AName)]); + end; +end; + +procedure ExtractNameSpaceShortNamesNested( + ANode : TDOMNode; + AResList : TStrings; + const ANameSpace : WideString +); +var + nd : TDOMNode; +begin + AResList.Clear(); + nd := ANode; + while Assigned(nd) do begin + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + ExtractNameSpaceShortNames(CreateAttributesCursor(nd,cetRttiNode),AResList,ANameSpace,nfaNone,False,nil); + end; + nd := nd.ParentNode; + end; +end; + +procedure ExtractNameSpaceShortNames( + AAttribCursor : IObjectCursor; + AResList : TStrings; + const ANameSpace : WideString; + const ANotFoundAction : TNotFoundAction; + const AClearBefore : Boolean; + const AExceptionClass : ExceptClass +); +var + crs : IObjectCursor; + locObj : TDOMNodeRttiExposer; + wStr : WideString; + i : Integer; + ec : ExceptClass; +begin + if AClearBefore then begin + AResList.Clear(); + end; + AAttribCursor.Reset(); + crs := CreateCursorOn(AAttribCursor,ParseFilter(Format('%s=%s',[s_NODE_VALUE,QuotedStr(ANameSpace)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + repeat + locObj := crs.GetCurrent() as TDOMNodeRttiExposer; + wStr := Trim(locObj.NodeName); + i := AnsiPos(s_xmlns + ':',wStr); + if ( i > 0 ) then begin + i := AnsiPos(':',wStr); + AResList.Add(Copy(wStr,( i + 1 ), MaxInt)); + end else begin + if ( AResList.IndexOf('') = -1 ) then + AResList.Add(''); + end; + until not crs.MoveNext(); + end else begin + if ( ANotFoundAction = nfaRaiseException ) then begin + if Assigned(AExceptionClass) then + ec := AExceptionClass + else + ec := Exception; + raise ec.CreateFmt('Namespace not found : "%s"',[ANameSpace]); + end; + end; +end; + +function wst_findCustomAttribute( + AWsdlShortNames : TStrings; + ANode : TDOMNode; + const AAttribute : string; + out AValue : string +) : Boolean; +var + nd : TDOMNode; + tmpCrs : IObjectCursor; +begin + Result := False; + tmpCrs := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_document,AWsdlShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_customAttributes)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if ( nd.Attributes <> nil ) then begin + nd := nd.Attributes.GetNamedItem(AAttribute); + if Assigned(nd) then begin + Result := True; + AValue := nd.NodeValue; + end; + end; + end; + end; + end; +end; + +function wst_findCustomAttributeXsd( + AXsdShortNames : TStrings; + ANode : TDOMNode; + const AAttribute : string; + out AValue : string +) : Boolean; +var + nd : TDOMNode; + tmpCrs : IObjectCursor; +begin + Result := False; + tmpCrs := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_annotation,AXsdShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_appinfo)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if ( nd.Attributes <> nil ) then begin + nd := nd.Attributes.GetNamedItem(AAttribute); + if Assigned(nd) then begin + Result := True; + AValue := nd.NodeValue; + end; + end; + end; + end; + end; +end; + +procedure ExplodeQName(const AQName : string; out ALocalName, ANameSpace : string) ; +var + i : PtrInt; +begin + i := Pos(':',AQName); + if ( i > 0 ) then begin + ANameSpace := Copy(AQName,1,Pred(i)); + ALocalName := Copy(AQName,Succ(i),Length(AQName)); + end else begin + ANameSpace := ''; + ALocalName := AQName; + end; +end; + +function AddNameSpace(const AValue: string; ANameSpaceList : TStrings): TStrings; +var + i : PtrInt; + s : string; + ls : TStringList; +begin + s := Trim(AValue); + i := ANameSpaceList.IndexOf(s); + if ( i < 0 ) then begin + i := ANameSpaceList.Add(s); + ls := TStringList.Create(); + ANameSpaceList.Objects[i] := ls; + ls.Duplicates := dupIgnore; + ls.Sorted := True; + Result := ls; + end else begin + Result := ANameSpaceList.Objects[i] as TStrings; + end; +end; + +procedure BuildNameSpaceList(AAttCursor : IObjectCursor; ANameSpaceList : TStrings); +var + locObj : TDOMNodeRttiExposer; + locNameSpace, locNameSpaceShort : string; + tmpXmlNs : string; + found : Boolean; +begin + if Assigned(AAttCursor) then begin + tmpXmlNs := s_xmlns + ':'; + AAttCursor.Reset(); + while AAttCursor.MoveNext() do begin + found := False; + locObj := AAttCursor.GetCurrent() as TDOMNodeRttiExposer; + if AnsiSameText(s_xmlns,locObj.NodeName) then begin + found := True; + locNameSpace := locObj.NodeValue; + locNameSpaceShort := ''; + end else if AnsiStartsText(tmpXmlNs,locObj.NodeName) then begin + found := True; + locNameSpace := locObj.NodeValue; + locNameSpaceShort := locObj.NodeName; + locNameSpaceShort := Copy(locNameSpaceShort,Pos(':',locNameSpaceShort) + 1, Length(locNameSpaceShort)); + end; + if found then + AddNameSpace(locNameSpace,ANameSpaceList).Add(locNameSpaceShort); + end; + end; +end; + end. - diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 63bb42966..6df826561 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -111,9 +111,11 @@ type procedure SetArrayStyle(AArray : TPasArrayType; const AStyle : TArrayStyle); procedure SetArrayItemExternalName(AArray : TPasArrayType; const AExternalName : string); function FindElement(const AName: String): TPasElement; override; + function FindElementNS(const AName, ANameSpace : string): TPasElement; function FindElementInModule(const AName: String; AModule: TPasModule): TPasElement; function FindModule(const AName: String): TPasModule;override; - function IsEnumItemNameUsed(const AName : string) : Boolean; + function IsEnumItemNameUsed(const AName : string; AModule : TPasModule) : Boolean;overload; + function IsEnumItemNameUsed(const AName : string) : Boolean;overload; procedure SetCurrentModule(AModule : TPasModule); property CurrentModule : TPasModule read FCurrentModule; @@ -134,6 +136,9 @@ type function IsInitNeed(AType: TPasType): Boolean; function IsOfType(AType: TPasType; AClass: TClass): Boolean; end; + + TPasNativeModule = class(TPasModule) + end; TPasClassTypeClass = class of TPasClassType; TPasNativeClassType = class(TPasClassType) end; @@ -173,7 +178,9 @@ type implementation uses parserutils; -const SIMPLE_TYPES : Array[0..14] Of array[0..2] of string = ( +const + SIMPLE_TYPES_COUNT = 15; + SIMPLE_TYPES : Array[0..Pred(SIMPLE_TYPES_COUNT)] Of array[0..2] of string = ( ('string', 'TComplexStringContentRemotable', 'string'), ('integer', 'TComplexInt32SContentRemotable', 'int'), ('LongWord', 'TComplexInt32UContentRemotable', 'unsignedInt' ), @@ -200,11 +207,13 @@ var splTyp : TPasNativeSimpleType; syb : TPasNativeSimpleContentClassType; s : string; + typlst : array[0..Pred(SIMPLE_TYPES_COUNT)] of TPasNativeSimpleType; begin for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin splTyp := TPasNativeSimpleType(AContainer.CreateElement(TPasNativeSimpleType,SIMPLE_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0)); ADest.InterfaceSection.Declarations.Add(splTyp); ADest.InterfaceSection.Types.Add(splTyp); + typlst[i] := splTyp; s := SIMPLE_TYPES[i][1]; if not IsStrEmpty(s) then begin syb := AContainer.FindElementInModule(SIMPLE_TYPES[i][1],ADest) as TPasNativeSimpleContentClassType; @@ -217,7 +226,8 @@ begin end; end; for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin - splTyp := AContainer.FindElementInModule(SIMPLE_TYPES[i][0],ADest) as TPasNativeSimpleType; + //splTyp := AContainer.FindElementInModule(SIMPLE_TYPES[i][0],ADest) as TPasNativeSimpleType; + splTyp := typlst[i]; if not IsStrEmpty(SIMPLE_TYPES[i][2]) then begin AContainer.RegisterExternalAlias(splTyp,SIMPLE_TYPES[i][2]); if ( splTyp.BoxedType <> nil ) then begin @@ -267,7 +277,7 @@ function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPas var loc_TBaseComplexSimpleContentRemotable : TPasClassType; begin - Result := TPasModule(AContainer.CreateElement(TPasModule,'base_service_intf',AContainer.Package,visPublic,'',0)); + Result := TPasNativeModule(AContainer.CreateElement(TPasNativeModule,'base_service_intf',AContainer.Package,visPublic,'',0)); try AContainer.Package.Modules.Add(Result); AContainer.RegisterExternalAlias(Result,sXSD_NS); @@ -540,11 +550,23 @@ begin if Assigned(AModule) and Assigned(AModule.InterfaceSection.Declarations) then begin decs := AModule.InterfaceSection.Declarations; c := decs.Count; - for i := 0 to Pred(c) do begin + {for i := 0 to Pred(c) do begin if SameName(TPasElement(decs[i]),AName) then begin Result := TPasElement(decs[i]); Exit; end; + end;} + for i := 0 to Pred(c) do begin + if AnsiSameText(AName, GetExternalName(TPasElement(decs[i]))) then begin + Result := TPasElement(decs[i]); + Exit; + end; + end; + for i := 0 to Pred(c) do begin + if AnsiSameText(AName, TPasElement(decs[i]).Name) then begin + Result := TPasElement(decs[i]); + Exit; + end; end; end; end; @@ -579,13 +601,13 @@ begin mdl := Package.Modules; c := mdl.Count; for i := 0 to Pred(c) do begin - if AnsiSameText(AName,TPasModule(mdl[i]).Name) then begin + if SameName(TPasModule(mdl[i]),AName) then begin Result := TPasModule(mdl[i]); end; end; end; -function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string): Boolean; +function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string;AModule: TPasModule): Boolean; var i, c, j : Integer; elt : TPasElement; @@ -593,7 +615,7 @@ var typeList : TList; begin Result := False; - typeList := CurrentModule.InterfaceSection.Declarations; + typeList := AModule.InterfaceSection.Declarations; c := typeList.Count; for i := 0 to Pred(c) do begin elt := TPasElement(typeList[i]); @@ -609,6 +631,11 @@ begin end; end; +function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string): Boolean; +begin + Result := IsEnumItemNameUsed(AName,CurrentModule); +end; + function TwstPasTreeContainer.IsOfType(AType : TPasType; AClass : TClass) : Boolean; var ut : TPasType; @@ -728,6 +755,17 @@ begin Properties.SetValue(AObject,sATTRIBUTE,s); end; +function TwstPasTreeContainer.FindElementNS(const AName, ANameSpace: string): TPasElement; +var + mdl : TPasModule; +begin + Result := nil; + mdl := FindModule(ANameSpace); + if Assigned(mdl) then begin + Result := FindElementInModule(AName,mdl); + end; +end; + { TwstBinding } constructor TwstBinding.Create( diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi index 9541fb9dc..fbc3b00f6 100644 --- a/wst/trunk/ws_helper/ws_helper.lpi +++ b/wst/trunk/ws_helper/ws_helper.lpi @@ -12,7 +12,7 @@ - + @@ -24,7 +24,7 @@ - + @@ -33,13 +33,13 @@ - + - - + + @@ -50,7 +50,7 @@ - + @@ -58,9 +58,9 @@ - - - + + + @@ -84,9 +84,9 @@ - - - + + + @@ -94,9 +94,9 @@ - + - + @@ -125,17 +125,15 @@ - - - - + + @@ -153,9 +151,7 @@ - - @@ -177,16 +173,18 @@ - + - - + + + + @@ -205,13 +203,11 @@ - - @@ -292,10 +288,10 @@ - - - - + + + + @@ -435,8 +431,8 @@ - - + + @@ -503,18 +499,18 @@ - + - + - - - - + + + + @@ -576,18 +572,19 @@ - - - - + + + + - - - - + + + + + @@ -597,12 +594,224 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -630,8 +839,7 @@ - - + diff --git a/wst/trunk/ws_helper/ws_helper.pas b/wst/trunk/ws_helper/ws_helper.pas index 6074de308..504a2c6e2 100644 --- a/wst/trunk/ws_helper/ws_helper.pas +++ b/wst/trunk/ws_helper/ws_helper.pas @@ -37,10 +37,13 @@ uses XMLWrite, XMLRead, wst_fpc_xml, - wsdl2pas_imp, pastree, pparser, pascal_parser_intf, - logger_intf; + logger_intf, + xsd_parser, + ws_parser_imp, + wsdl_parser; + {$INCLUDE ws_helper_prog.inc} diff --git a/wst/trunk/ws_helper/ws_helper_prog.inc b/wst/trunk/ws_helper/ws_helper_prog.inc index 218a30f86..b3db37d3b 100644 --- a/wst/trunk/ws_helper/ws_helper_prog.inc +++ b/wst/trunk/ws_helper/ws_helper_prog.inc @@ -15,7 +15,7 @@ const sWST_META = 'wst_meta'; type - TSourceFileType = ( sftPascal, sftWSDL ); + TSourceFileType = ( sftPascal, sftWSDL, sftXsd ); var inFileName,outPath,errStr : string; @@ -41,6 +41,8 @@ var sourceType := sftPascal; end else if AnsiSameText(ExtractFileExt(inFileName),'.WSDL') then begin sourceType := sftWSDL; + end else if AnsiSameText(ExtractFileExt(inFileName),'.XSD') then begin + sourceType := sftXsd; end; if Result then begin if ( AppOptions = [] ) then begin @@ -62,6 +64,10 @@ var if AnsiSameText('A',Trim(GetOptionArg(cloInterface))) then begin parserMode := pmAllTypes; end; + + if ( sourceType = sftXsd ) then begin + AppOptions := AppOptions - [ cloProxy, cloImp, cloBinder, cloWsdl ]; + end; end; function GenerateSymbolTable() : Boolean ; @@ -74,25 +80,48 @@ var procedure ParseWsdlFile(); var locDoc : TXMLDocument; - prsr : TWsdlParser; + prsrW : IParser; + begin + ReadXMLFile(locDoc,inFileName); +{$IFNDEF WST_INTF_DOM} + try +{$ENDIF} + prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser; + prsrW.Execute(parserMode,ChangeFileExt(ExtractFileName(inFileName),'')); +{$IFNDEF WST_INTF_DOM} + finally + prsrW := nil; + ReleaseDomNode(locDoc); + end; +{$ENDIF} + end; + + procedure ParseXsdFile(); + var + locDoc : TXMLDocument; + prsr : IXsdPaser; begin prsr := nil; ReadXMLFile(locDoc,inFileName); +{$IFNDEF WST_INTF_DOM} try - prsr := TWsdlParser.Create(locDoc,symtable); - prsr.Parse(parserMode,ChangeFileExt(ExtractFileName(inFileName),'')); +{$ENDIF} + prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser; + prsr.ParseTypes(); +{$IFNDEF WST_INTF_DOM} finally - FreeAndNil(prsr); - FreeAndNil(locDoc); + ReleaseDomNode(locDoc); end; +{$ENDIF} end; - + begin try WriteLn('Parsing the file : ', inFileName); case sourceType of sftPascal : ParsePascalFile(); sftWSDL : ParseWsdlFile(); + sftXsd : ParseXsdFile(); end; Result := True; except @@ -112,7 +141,7 @@ var GenerateWSDL(ASymbol,doc); WriteXML(doc,ADest); finally - FreeAndNil(doc); + ReleaseDomNode(doc); end; end; @@ -198,6 +227,11 @@ var end; begin +{$IFDEF FPC} + {$IF Declared(SetHeapTraceOutput) } + SetHeapTraceOutput('heapOut.txt'); + {$IFEND} +{$ENDIF} osParam := 'windows'; targetParam := 'x86'; diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas new file mode 100644 index 000000000..91ad6bcdd --- /dev/null +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -0,0 +1,1272 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit ws_parser_imp; + +interface +uses + Classes, SysUtils, + {$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF}, + cursor_intf, rtti_filters, + pastree, pascal_parser_intf, logger_intf, + xsd_parser; + +type + + TNameSpaceValueType = ( nvtExpandValue, nvtShortSynonym ); + + TAbstractTypeParserClass = class of TAbstractTypeParser; + + { TAbstractTypeParser } + + TAbstractTypeParser = class + private + FContext : IParserContext; + FTypeNode : TDOMNode; + FSymbols : TwstPasTreeContainer; + FTypeName : string; + FEmbededDef : Boolean; + private + function GetModule: TPasModule;{$IFDEF USE_INLINE}inline;{$ENDIF} + protected + function FindElementNS( + const ANameSpace, + ALocalName : string; + const ASpaceType : TNameSpaceValueType + ) : TPasElement; + function FindElement(const ALocalName : string) : TPasElement; {$IFDEF USE_INLINE}inline;{$ENDIF} + public + constructor Create( + AOwner : IParserContext; + ATypeNode : TDOMNode; + const ATypeName : string; + const AEmbededDef : Boolean + ); + class function ExtractEmbeddedTypeFromElement( + AOwner : IParserContext; + AEltNode : TDOMNode; + ASymbols : TwstPasTreeContainer; + const ATypeName : string + ) : TPasType; + class function GetParserSupportedStyle():string;virtual;abstract; + class procedure RegisterParser(AParserClass : TAbstractTypeParserClass); + class function GetRegisteredParserCount() : Integer; + class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass; + function Parse():TPasType;virtual;abstract; + property Module : TPasModule read GetModule; + end; + + TDerivationMode = ( dmNone, dmExtension, dmRestriction ); + TSequenceType = ( stElement, stAll ); + + { TComplexTypeParser } + + TComplexTypeParser = class(TAbstractTypeParser) + private + FAttCursor : IObjectCursor; + FChildCursor : IObjectCursor; + FContentNode : TDOMNode; + FContentType : string; + FBaseType : TPasType; + FDerivationMode : TDerivationMode; + FDerivationNode : TDOMNode; + FSequenceType : TSequenceType; + private + procedure CreateNodeCursors(); + procedure ExtractTypeName(); + procedure ExtractContentType(); + procedure ExtractBaseType(); + function ParseSimpleContent(const ATypeName : string):TPasType; + function ParseEmptyContent(const ATypeName : string):TPasType; + function ParseComplexContent(const ATypeName : string):TPasType;virtual; + public + class function GetParserSupportedStyle():string;override; + function Parse():TPasType;override; + end; + + { TSimpleTypeParser } + + TSimpleTypeParser = class(TAbstractTypeParser) + private + FAttCursor : IObjectCursor; + FChildCursor : IObjectCursor; + FBaseName : string; + FBaseNameSpace : string; + FRestrictionNode : TDOMNode; + FIsEnum : Boolean; + private + procedure CreateNodeCursors(); + procedure ExtractTypeName(); + function ExtractContentType() : Boolean; + function ParseEnumContent():TPasType; + function ParseOtherContent():TPasType; + public + class function GetParserSupportedStyle():string;override; + function Parse():TPasType;override; + end; + + resourcestring + SResolveError = 'Unable to resolve this namespace : "%s".'; + +implementation +uses dom_cursors, parserutils, StrUtils, Contnrs; + +{ TAbstractTypeParser } + +constructor TAbstractTypeParser.Create( + AOwner : IParserContext; + ATypeNode : TDOMNode; + const ATypeName : string; + const AEmbededDef : Boolean +); +var + symtbl : TwstPasTreeContainer; +begin + Assert(Assigned(AOwner)); + Assert(Assigned(ATypeNode)); + symtbl := AOwner.GetSymbolTable(); + Assert(Assigned(symtbl)); + FContext := AOwner; + FTypeNode := ATypeNode; + FSymbols := symtbl; + FTypeName := ATypeName; + FEmbededDef := AEmbededDef; +end; + +class function TAbstractTypeParser.ExtractEmbeddedTypeFromElement( + AOwner : IParserContext; + AEltNode : TDOMNode; + ASymbols : TwstPasTreeContainer; + const ATypeName : string +): TPasType; + + function ExtractTypeName() : string; + var + locCrs : IObjectCursor; + begin + locCrs := CreateCursorOn( + CreateAttributesCursor(AEltNode,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if not locCrs.MoveNext() then + raise EXsdParserException.Create('Unable to find the tag in the type/element node attributes.'); + Result := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if IsStrEmpty(Result) then begin + raise EXsdParserException.Create('Invalid type/element name( the name is empty ).'); + end; + end; + + function FindParser(out AFoundTypeNode : TDOMNode):TAbstractTypeParserClass; + var + k : Integer; + locPrsClss : TAbstractTypeParserClass; + locFilter : string; + locCrs : IObjectCursor; + begin + Result := nil; + AFoundTypeNode := nil; + for k := 0 to Pred(GetRegisteredParserCount()) do begin + locPrsClss := GetRegisteredParser(k); + locFilter := locPrsClss.GetParserSupportedStyle(); + if not IsStrEmpty(locFilter) then begin + locFilter := CreateQualifiedNameFilterStr(locFilter,AOwner.GetXsShortNames()); + locCrs := CreateCursorOn(CreateChildrenCursor(AEltNode,cetRttiNode),ParseFilter(locFilter,TDOMNodeRttiExposer)); + locCrs.Reset(); + if locCrs.MoveNext() then begin + AFoundTypeNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + Result := locPrsClss; + Break; + end; + end; + end; + end; + +var + typName : string; + prsClss : TAbstractTypeParserClass; + prs : TAbstractTypeParser; + typNode : TDOMNode; +begin + if not AEltNode.HasChildNodes() then begin; + raise EXsdParserException.Create('Invalid type definition, this element must have children.'); + end; + Result := nil; + typName := ATypeName; + if IsStrEmpty(typName) then begin + typName := ExtractTypeName(); + end; + prsClss := FindParser(typNode); + if ( prsClss = nil ) then begin; + raise EXsdInvalidTypeDefinitionException.CreateFmt('This type style is not supported : "%s".',[typName]); + end; + prs := prsClss.Create(AOwner,typNode,typName,True); + try + Result := prs.Parse(); + finally + FreeAndNil(prs); + end; +end; + +var + FTypeParserList : TClassList = nil; +class procedure TAbstractTypeParser.RegisterParser(AParserClass: TAbstractTypeParserClass); +begin + if ( FTypeParserList = nil ) then begin + FTypeParserList := TClassList.Create(); + end; + if ( FTypeParserList.IndexOf(AParserClass) < 0 ) then begin + FTypeParserList.Add(AParserClass); + end; +end; + +class function TAbstractTypeParser.GetRegisteredParserCount(): Integer; +begin + if Assigned(FTypeParserList) then begin + Result := FTypeParserList.Count; + end else begin + Result := 0; + end; +end; + +class function TAbstractTypeParser.GetRegisteredParser(const AIndex: Integer): TAbstractTypeParserClass; +begin + Result := TAbstractTypeParserClass(FTypeParserList[AIndex]); +end; + +function TAbstractTypeParser.FindElementNS( + const ANameSpace, + ALocalName : string; + const ASpaceType : TNameSpaceValueType +) : TPasElement; +var + locNS : string; +begin + if ( ASpaceType = nvtExpandValue ) then begin + locNS := ANameSpace + end else begin + if not FContext.FindNameSpace(ANameSpace,locNS) then + raise EXsdParserAssertException.CreateFmt(SResolveError,[ANameSpace]); + end; + Result := FSymbols.FindElementNS(ALocalName,locNS); +end; + +function TAbstractTypeParser.GetModule() : TPasModule; +begin + Result := FContext.GetTargetModule(); +end; + +function TAbstractTypeParser.FindElement(const ALocalName: string): TPasElement; +begin + Result := FSymbols.FindElementInModule(ALocalName,Module); +end; + +{ TComplexTypeParser } + +procedure TComplexTypeParser.CreateNodeCursors(); +begin + FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode); + FChildCursor := CreateChildrenCursor(FTypeNode,cetRttiNode); +end; + +procedure TComplexTypeParser.ExtractTypeName(); +var + locCrs : IObjectCursor; +begin + if not FEmbededDef then begin + locCrs := CreateCursorOn( + FAttCursor.Clone() as IObjectCursor, + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if not locCrs.MoveNext() then + raise EXsdParserException.Create('Unable to find the tag in the type node attributes.'); + FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + end; + if IsStrEmpty(FTypeName) then + raise EXsdParserException.Create('Invalid type name( the name is empty ).'); +end; + +procedure TComplexTypeParser.ExtractContentType(); +var + locCrs : IObjectCursor; +begin + FContentType := ''; + if Assigned(FChildCursor) then begin + locCrs := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + if Assigned(locCrs) then begin + locCrs.Reset(); + if locCrs.MoveNext() then begin + FContentNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + FContentType := FContentNode.NodeName; + end else begin + locCrs := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FContentNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + FContentType := FContentNode.NodeName; + end else begin + FContentNode := FTypeNode; + FContentType := s_complexContent; + end; + end; + FContentType := ExtractNameFromQName(FContentType); + end; + end; +end; + +procedure TComplexTypeParser.ExtractBaseType(); +var + locContentChildCrs, locCrs : IObjectCursor; + locSymbol : TPasElement; + locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string; +begin + locFilterStr := CreateQualifiedNameFilterStr(s_extension,FContext.GetXsShortNames()); + locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode); + locCrs := CreateCursorOn( + locContentChildCrs.Clone() as IObjectCursor, + ParseFilter(locFilterStr,TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FDerivationMode := dmExtension; + FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + end else begin + locFilterStr := CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames()); + locCrs := CreateCursorOn( + locContentChildCrs.Clone() as IObjectCursor, + ParseFilter(locFilterStr,TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FDerivationMode := dmRestriction; + FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + end else begin + FDerivationMode := dmNone; + FDerivationNode := nil; + end; + end; + if ( FDerivationMode > dmNone ) then begin + locCrs := CreateCursorOn( + CreateAttributesCursor(FDerivationNode,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if not locCrs.MoveNext() then + raise EXsdParserException.CreateFmt('Invalid extention/restriction of type "%s" : "base" attribute not found.',[FTypeName]); + ExplodeQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locBaseTypeLocalName,locBaseTypeLocalSpace); + locSymbol := FindElementNS(locBaseTypeLocalSpace,locBaseTypeLocalName,nvtShortSynonym); + if Assigned(locSymbol) then begin + if locSymbol.InheritsFrom(TPasType) then begin + FBaseType := locSymbol as TPasType; + while Assigned(FBaseType) and FBaseType.InheritsFrom(TPasAliasType) do begin + FBaseType := (FBaseType as TPasAliasType).DestType; + end; + if FBaseType.InheritsFrom(TPasNativeSimpleType) then begin + Assert(Assigned(TPasNativeSimpleType(FBaseType).BoxedType)); + FBaseType := TPasNativeSimpleType(FBaseType).BoxedType; + end; + end else begin + raise EXsdParserException.CreateFmt('"%s" was expected to be a type definition.',[locSymbol.Name]); + end; + end else begin + locBaseTypeInternalName := ExtractIdentifier(locBaseTypeLocalName); + if IsReservedKeyWord(locBaseTypeInternalName) then + locBaseTypeInternalName := '_' + locBaseTypeInternalName ; + FBaseType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locBaseTypeInternalName,Self.Module.InterfaceSection,visDefault,'',0)); + Self.Module.InterfaceSection.Declarations.Add(FBaseType); + Self.Module.InterfaceSection.Types.Add(FBaseType); + if not AnsiSameText(locBaseTypeInternalName,locBaseTypeLocalName) then + FSymbols.RegisterExternalAlias(FBaseType,locBaseTypeLocalName); + end; + end; +end; + +function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType; + + function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor; + var + frstCrsr, tmpCursor : IObjectCursor; + parentNode, tmpNode : TDOMNode; + begin + Result := nil; + AAttCursor := nil; + case FDerivationMode of + dmNone : parentNode := FContentNode; + dmRestriction, + dmExtension : parentNode := FDerivationNode; + end; + if parentNode.HasChildNodes() then begin; + AAttCursor := CreateCursorOn( + CreateChildrenCursor(parentNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode); + tmpCursor := CreateCursorOn( + frstCrsr.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + tmpCursor.Reset(); + if tmpCursor.MoveNext() then begin + FSequenceType := stElement; + tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if tmpNode.HasChildNodes() then begin + tmpCursor := CreateCursorOn( + CreateChildrenCursor(tmpNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + Result := tmpCursor; + end; + end else begin + tmpCursor := CreateCursorOn( + frstCrsr.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + tmpCursor.Reset(); + if tmpCursor.MoveNext() then begin + FSequenceType := stElement; + tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if tmpNode.HasChildNodes() then begin + tmpCursor := CreateCursorOn( + CreateChildrenCursor(tmpNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + Result := tmpCursor; + end; + end; + end + end else begin + Result := nil; + end; + end; + +var + classDef : TPasClassType; + isArrayDef : Boolean; + arrayItems : TObjectList; + + procedure ParseElement(AElement : TDOMNode); + var + locAttCursor, locPartCursor : IObjectCursor; + locName, locTypeName, locTypeInternalName : string; + locType : TPasElement; + locInternalEltName : string; + locProp : TPasProperty; + locHasInternalName : Boolean; + locMinOccur, locMaxOccur : Integer; + locMaxOccurUnbounded : Boolean; + locStrBuffer : string; + locIsRefElement : Boolean; + begin + locType := nil; + locTypeName := ''; + locAttCursor := CreateAttributesCursor(AElement,cetRttiNode); + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + locIsRefElement := False; + if not locPartCursor.MoveNext() then begin + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_ref)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if not locPartCursor.MoveNext() then begin + raise EXsdParserException.Create('Invalid definition : missing "name" or "ref" attribute.'); + end; + locIsRefElement := True; + end; + locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if locIsRefElement then begin + locName := ExtractNameFromQName(locName); + end; + if IsStrEmpty(locName) then + raise EXsdParserException.Create('Invalid definition : empty "name".'); + if locIsRefElement then begin + locTypeName := locName; + end else begin + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue); + end else begin + locTypeName := Format('%s_%s_Type',[FTypeName,locName]); + locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(FContext,AElement,FSymbols,locTypeName); + if ( locType = nil ) then begin + raise EXsdInvalidElementDefinitionException.CreateFmt('Invalid definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]); + end; + Self.Module.InterfaceSection.Declarations.Add(locType); + Self.Module.InterfaceSection.Types.Add(locType); + if locType.InheritsFrom(TPasClassType) then begin + Self.Module.InterfaceSection.Classes.Add(locType); + end; + end; + end; + if IsStrEmpty(locTypeName) then + raise EXsdInvalidElementDefinitionException.Create('Invalid definition : empty "type".'); + locType := FSymbols.FindElement(locTypeName); + if Assigned(locType) then begin + if locIsRefElement then begin + locTypeInternalName := locTypeName; + locTypeInternalName := locTypeInternalName + '_Type'; + locType.Name := locTypeInternalName; + FSymbols.RegisterExternalAlias(locType,locTypeName); + end; + end else begin + locTypeInternalName := locTypeName; + if locIsRefElement or AnsiSameText(locTypeInternalName,locInternalEltName) then begin + locTypeInternalName := locTypeInternalName + '_Type'; + end; + if IsReservedKeyWord(locTypeInternalName) then begin + locTypeInternalName := '_' + locTypeInternalName; + end; + locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeInternalName,Self.Module.InterfaceSection,visDefault,'',0)); + Self.Module.InterfaceSection.Declarations.Add(locType); + Self.Module.InterfaceSection.Types.Add(locType); + if not AnsiSameText(locTypeInternalName,locTypeName) then + FSymbols.RegisterExternalAlias(locType,locTypeName); + end; + + locInternalEltName := locName; + locHasInternalName := IsReservedKeyWord(locInternalEltName); + if locHasInternalName then + locInternalEltName := Format('_%s',[locInternalEltName]); + + locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0)); + classDef.Members.Add(locProp); + locProp.VarType := locType as TPasType; + locType.AddRef(); + if locHasInternalName then + FSymbols.RegisterExternalAlias(locProp,locName); + {if AnsiSameText(locType.Name,locProp.Name) then begin + FSymbols.RegisterExternalAlias(locType,FSymbols.GetExternalName(locType)); + TPasEmentCrack(locType).SetName(locType.Name + '_Type'); + end;} + + locMinOccur := 1; + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then + raise EXsdParserException.CreateFmt('Invalid "minOccurs" value : "%s.%s".',[FTypeName,locName]); + if ( locMinOccur < 0 ) then + raise EXsdParserException.CreateFmt('Invalid "minOccurs" value : "%s.%s".',[FTypeName,locName]); + end; + locProp.ReadAccessorName := 'F' + locProp.Name; + locProp.WriteAccessorName := 'F' + locProp.Name; + if ( locMinOccur = 0 ) then begin + locProp.StoredAccessorName := 'Has' + locProp.Name; + end else begin + locProp.StoredAccessorName := 'True'; + end; + + locMaxOccur := 1; + locMaxOccurUnbounded := False; + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if AnsiSameText(locStrBuffer,s_unbounded) then begin + locMaxOccurUnbounded := True; + end else begin + if not TryStrToInt(locStrBuffer,locMaxOccur) then + raise EXsdParserException.CreateFmt('Invalid "maxOccurs" value : "%s.%s".',[FTypeName,locName]); + if ( locMinOccur < 0 ) then + raise EXsdParserException.CreateFmt('Invalid "maxOccurs" value : "%s.%s".',[FTypeName,locName]); + end; + end; + isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 ); + if isArrayDef then begin + arrayItems.Add(locProp); + end; + if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin + FSymbols.SetPropertyAsAttribute(locProp,True); + end; + end; + + procedure GenerateArrayTypes( + const AClassName : string; + AArrayPropList : TObjectList + ); + var + locPropTyp : TPasProperty; + k : Integer; + locString : string; + locSym : TPasElement; + begin + for k := 0 to Pred(AArrayPropList.Count) do begin + locPropTyp := AArrayPropList[k] as TPasProperty; + locString := Format('%s_%sArray',[AClassName,locPropTyp.Name]); + locSym := FSymbols.FindElement(locString); + if ( locSym = nil ) then begin + locSym := FSymbols.CreateArray( + locString, + locPropTyp.VarType, + locPropTyp.Name, + FSymbols.GetExternalName(locPropTyp), + asEmbeded + ); + Self.Module.InterfaceSection.Declarations.Add(locSym); + Self.Module.InterfaceSection.Types.Add(locSym); + end; + end; + end; + + function ExtractSoapArray(const AInternalName : string; const AHasInternalName : Boolean) : TPasArrayType; + var + ls : TStringList; + crs, locCrs : IObjectCursor; + s : string; + i : Integer; + locSym : TPasElement; + ok : Boolean; + nd : TDOMNode; + begin + if not FDerivationNode.HasChildNodes then begin + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, attributes not found : "%s".',[FTypeName]); + end; + crs := CreateCursorOn( + CreateChildrenCursor(FDerivationNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + ls := TStringList.Create(); + try + ok := False; + crs.Reset(); + while crs.MoveNext() do begin + nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + ls.Clear(); + ExtractNameSpaceShortNamesNested(nd,ls,s_wsdl); + locCrs := CreateAttributesCursor(nd,cetRttiNode); + locCrs := CreateCursorOn( + locCrs, + ParseFilter(CreateQualifiedNameFilterStr(s_arrayType,ls),TDOMNodeRttiExposer) + ); + if Assigned(locCrs) then begin + locCrs.Reset(); + if locCrs.MoveNext() then begin + ok := True; + Break; + end; + end; + end; + end; + finally + FreeAndNil(ls); + end; + if not ok then begin + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, unable to find the "%s" attribute : "%s".',[s_arrayType,FTypeName]); + end; + s := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue); + i := Pos('[',s); + if ( i < 1 ) then begin + i := MaxInt; + end; + s := Copy(s,1,Pred(i)); + locSym := FSymbols.FindElement(s); + if not Assigned(locSym) then begin + locSym := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,s,Self.Module.InterfaceSection,visDefault,'',0)); + Self.Module.InterfaceSection.Declarations.Add(locSym); + Self.Module.InterfaceSection.Types.Add(locSym); + end; + if not locSym.InheritsFrom(TPasType) then + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]); + Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped); + if AHasInternalName then + FSymbols.RegisterExternalAlias(Result,ATypeName); + end; + + function IsHeaderBlock() : Boolean; + var + strBuffer : string; + begin + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer)); + end; + + function IsRecordType() : Boolean; + var + strBuffer : string; + begin + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_record,strBuffer) and AnsiSameText('true',Trim(strBuffer)); + end; + + procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor); + begin + if Assigned(AEltCrs) then begin + AEltCrs.Reset(); + while AEltCrs.MoveNext() do begin + ParseElement((AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + end; + end; + if Assigned(AEltAttCrs) then begin + AEltAttCrs.Reset(); + while AEltAttCrs.MoveNext() do begin + ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + end; + end; + end; + +var + eltCrs, eltAttCrs : IObjectCursor; + internalName : string; + hasInternalName : Boolean; + arrayDef : TPasArrayType; + propTyp, tmpPropTyp : TPasProperty; + tmpClassDef : TPasClassType; + i : Integer; + recordType : TPasRecordType; + tmpRecVar : TPasVariable; +begin + ExtractBaseType(); + eltCrs := ExtractElementCursor(eltAttCrs); + + internalName := ExtractIdentifier(ATypeName); + hasInternalName := IsReservedKeyWord(internalName) or + ( not IsValidIdent(internalName) ) or + //( FSymbols.IndexOf(internalName) <> -1 ) or + ( not AnsiSameText(internalName,ATypeName) ); + if hasInternalName then begin + internalName := Format('_%s',[internalName]); + end; + + if ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) then begin + Result := ExtractSoapArray(internalName,hasInternalName); + end else begin + arrayItems := TObjectList.Create(False); + try + classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,Self.Module.InterfaceSection,visDefault,'',0)); + try + classDef.ObjKind := okClass; + Result := classDef; + if hasInternalName then + FSymbols.RegisterExternalAlias(classDef,ATypeName); + if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin + classDef.AncestorType := FBaseType; + end; + if ( classDef.AncestorType = nil ) then begin + if IsHeaderBlock() then + classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType + else + classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + end; + classDef.AncestorType.AddRef(); + if Assigned(eltCrs) or Assigned(eltAttCrs) then begin + isArrayDef := False; + ParseElementsAndAttributes(eltCrs,eltAttCrs); + if ( arrayItems.Count > 0 ) then begin + if ( arrayItems.Count = 1 ) and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) then begin + Result := nil; + propTyp := arrayItems[0] as TPasProperty; + arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped); + FreeAndNil(classDef); + Result := arrayDef; + if hasInternalName then + FSymbols.RegisterExternalAlias(arrayDef,ATypeName); + end else begin + GenerateArrayTypes(internalName,arrayItems); + tmpClassDef := classDef; + classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,tmpClassDef.Name,Self.Module.InterfaceSection,visPublic,'',0)); + classDef.ObjKind := okClass; + Result := classDef; + classDef.AncestorType := tmpClassDef.AncestorType; + classDef.AncestorType.AddRef(); + if hasInternalName then + FSymbols.RegisterExternalAlias(classDef,ATypeName); + for i := 0 to Pred(tmpClassDef.Members.Count) do begin + if TPasElement(tmpClassDef.Members[i]).InheritsFrom(TPasProperty) then begin + propTyp := TPasProperty(tmpClassDef.Members[i]); + if ( arrayItems.IndexOf(propTyp) = -1 ) then begin + tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0)); + if FSymbols.IsAttributeProperty(propTyp) then begin + FSymbols.SetPropertyAsAttribute(tmpPropTyp,True); + end; + tmpPropTyp.VarType := propTyp.VarType; + tmpPropTyp.VarType.AddRef(); + tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName; + FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp)); + classDef.Members.Add(tmpPropTyp); + end else begin + tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0)); + tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName; + tmpPropTyp.VarType := FSymbols.FindElement(Format('%s_%sArray',[internalName,propTyp.Name])) as TPasType; + tmpPropTyp.VarType.AddRef(); + FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp)); + classDef.Members.Add(tmpPropTyp); + end; + end; + end; + FreeAndNil(tmpClassDef); + end; + end; + end; + + //check for record + if ( FDerivationMode = dmNone ) and Result.InheritsFrom(TPasClassType) and IsRecordType() then begin + tmpClassDef := classDef; + classDef := nil; + recordType := TPasRecordType(FSymbols.CreateElement(TPasRecordType,tmpClassDef.Name,Self.Module.InterfaceSection,visPublic,'',0)); + Result := recordType; + if hasInternalName then + FSymbols.RegisterExternalAlias(recordType,ATypeName); + for i := 0 to Pred(tmpClassDef.Members.Count) do begin + if TPasElement(tmpClassDef.Members[i]).InheritsFrom(TPasProperty) then begin + propTyp := TPasProperty(tmpClassDef.Members[i]); + tmpRecVar := TPasVariable(FSymbols.CreateElement(TPasVariable,propTyp.Name,recordType,visPublic,'',0)); + tmpRecVar.VarType := propTyp.VarType; + tmpRecVar.VarType.AddRef(); + FSymbols.RegisterExternalAlias(tmpRecVar,FSymbols.GetExternalName(propTyp)); + recordType.Members.Add(tmpRecVar); + if FSymbols.IsAttributeProperty(propTyp) then begin + FSymbols.SetPropertyAsAttribute(tmpRecVar,True); + end; + end; + end; + FreeAndNil(tmpClassDef); + end; + except + FreeAndNil(Result); + raise; + end; + finally + FreeAndNil(arrayItems); + end; + end; +end; + +function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TPasType; + + function ExtractAttributeCursor():IObjectCursor; + var + frstCrsr, tmpCursor : IObjectCursor; + parentNode, tmpNode : TDOMNode; + locFilterStr : string; + xsShortNameList : TStrings; + begin + Result := nil; + parentNode := FContentNode; + if parentNode.HasChildNodes() then begin; + xsShortNameList := FContext.GetXsShortNames(); + frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode); + locFilterStr := CreateQualifiedNameFilterStr(s_extension,xsShortNameList) + ' or ' + + CreateQualifiedNameFilterStr(s_restriction,xsShortNameList) ; + tmpCursor := CreateCursorOn(frstCrsr.Clone() as IObjectCursor,ParseFilter(locFilterStr,TDOMNodeRttiExposer)); + if Assigned(tmpCursor) then begin + tmpCursor.Reset(); + if tmpCursor.MoveNext() then begin + tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if tmpNode.HasChildNodes() then begin + locFilterStr := CreateQualifiedNameFilterStr(s_attribute,xsShortNameList); + tmpCursor := CreateCursorOn(CreateChildrenCursor(tmpNode,cetRttiNode),ParseFilter(locFilterStr,TDOMNodeRttiExposer)); + if Assigned(tmpCursor) then begin + Result := tmpCursor; + Result.Reset(); + end; + end; + end; + end; + end else begin + Result := nil; + end; + end; + +var + locClassDef : TPasClassType; + + procedure ParseAttribute(AElement : TDOMNode); + var + locAttCursor, locPartCursor : IObjectCursor; + locName, locTypeName, locStoreOpt : string; + locType : TPasElement; + locStoreOptIdx : Integer; + locAttObj : TPasProperty; + locInternalEltName : string; + locHasInternalName : boolean; + begin + locAttCursor := CreateAttributesCursor(AElement,cetRttiNode); + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if not locPartCursor.MoveNext() then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : missing "name" attribute.',[s_attribute]); + locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if IsStrEmpty(locName) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : empty "name".',[s_attribute]); + + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if not locPartCursor.MoveNext() then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : missing "type" attribute.',[s_attribute]); + locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue); + if IsStrEmpty(locTypeName) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : empty "type".',[s_attribute]); + locType := FSymbols.FindElement(locTypeName) as TPasType; + if not Assigned(locType) then begin + locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeName,Self.Module.InterfaceSection,visPublic,'',0)); + Self.Module.InterfaceSection.Declarations.Add(locType); + Self.Module.InterfaceSection.Types.Add(locType); + end; + + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + locStoreOpt := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue); + if IsStrEmpty(locStoreOpt) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : empty "use".',[s_attribute]); + locStoreOptIdx := AnsiIndexText(locStoreOpt,[s_required,s_optional,s_prohibited]); + if ( locStoreOptIdx < 0 ) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid <%s> definition : invalid "use" value "%s".',[s_attribute,locStoreOpt]); + end else begin + locStoreOptIdx := 0; + end; + + locInternalEltName := locName; + locHasInternalName := IsReservedKeyWord(locInternalEltName); + if locHasInternalName then + locInternalEltName := Format('_%s',[locInternalEltName]); + + locAttObj := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,locClassDef,visPublished,'',0)); + locClassDef.Members.Add(locAttObj); + locAttObj.VarType := locType as TPasType; + locAttObj.VarType.AddRef(); + if locHasInternalName then + FSymbols.RegisterExternalAlias(locAttObj,locName); + FSymbols.SetPropertyAsAttribute(locAttObj,True); + case locStoreOptIdx of + 0 : locAttObj.StoredAccessorName := 'True'; + 1 : locAttObj.StoredAccessorName := 'Has' + locAttObj.Name; + 2 : locAttObj.StoredAccessorName := 'False'; + end; + end; + +var + locAttCrs : IObjectCursor; + internalName : string; + hasInternalName : Boolean; +begin + ExtractBaseType(); + if not ( FDerivationMode in [dmExtension, dmRestriction] ) then + raise EXsdInvalidTypeDefinitionException.Create('Invalid "complexeType.simpleType" definition : restriction/extension not found.'); + + internalName := ATypeName; + hasInternalName := IsReservedKeyWord(internalName) or + ( not IsValidIdent(internalName) );{ or + ( FSymbols.IndexOf(internalName) <> -1 );} + if hasInternalName then + internalName := Format('_%s',[internalName]); + + locAttCrs := ExtractAttributeCursor(); + locClassDef := TPasClassType(FSymbols.CreateElement(TPasClassType,Trim(internalName),Self.Module.InterfaceSection,visDefault,'',0)); + try + locClassDef.ObjKind := okClass; + Result := locClassDef; + if hasInternalName then + FSymbols.RegisterExternalAlias(locClassDef,ATypeName); + if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin + locClassDef.AncestorType := FBaseType; + end; + if ( locClassDef.AncestorType = nil ) then begin + locClassDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + end; + locClassDef.AncestorType.AddRef(); + if ( locAttCrs <> nil ) then begin + locAttCrs.Reset(); + while locAttCrs.MoveNext() do begin + ParseAttribute((locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + end; + end; + except + FreeAndNil(Result); + raise; + end; +end; + +function TComplexTypeParser.ParseEmptyContent(const ATypeName: string): TPasType; +var + internalName : string; + hasInternalName : Boolean; +begin + internalName := ATypeName; + hasInternalName := IsReservedKeyWord(internalName) or + ( not IsValidIdent(internalName) );{ or + ( FSymbols.IndexOf(internalName) <> -1 );} + if hasInternalName then + internalName := Format('_%s',[internalName]); + Result := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,Self.Module.InterfaceSection,visDefault,'',0)); + TPasClassType(Result).ObjKind := okClass; + if hasInternalName then + FSymbols.RegisterExternalAlias(Result,ATypeName); + TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + TPasClassType(Result).AncestorType.AddRef(); +end; + +class function TComplexTypeParser.GetParserSupportedStyle(): string; +begin + Result := s_complexType; +end; + +function TComplexTypeParser.Parse() : TPasType; +var + locSym : TPasElement; + locContinue : Boolean; +begin + if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_complexType) then + raise EXsdParserAssertException.CreateFmt('%s expected but %s found.',[s_complexType,ExtractNameFromQName(FTypeNode.NodeName)]); + CreateNodeCursors(); + ExtractTypeName(); + locContinue := True; + locSym := FSymbols.FindElement(FTypeName); + if Assigned(locSym) then begin + if not locSym.InheritsFrom(TPasType) then + raise EXsdParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]); + locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef); + if not locContinue then; + Result := locSym as TPasType; + end; + if locContinue then begin + ExtractContentType(); + if IsStrEmpty(FContentType) then begin + Result := ParseEmptyContent(FTypeName); + end else begin + if AnsiSameText(FContentType,s_complexContent) then + Result := ParseComplexContent(FTypeName) + else + Result := ParseSimpleContent(FTypeName); + end; + end; +end; + +{ TSimpleTypeParser } + +procedure TSimpleTypeParser.CreateNodeCursors(); +begin + FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode); + FChildCursor := CreateChildrenCursor(FTypeNode,cetRttiNode); +end; + +procedure TSimpleTypeParser.ExtractTypeName(); +var + locCrs : IObjectCursor; +begin + if not FEmbededDef then begin + locCrs := CreateCursorOn( + FAttCursor.Clone() as IObjectCursor, + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if not locCrs.MoveNext() then + raise EXsdParserAssertException.Create('Unable to find the tag in the type node attributes.'); + FTypeName := (locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + end; + if IsStrEmpty(FTypeName) then + raise EXsdParserAssertException.Create('Invalid type name( the name is empty ).'); +end; + +function TSimpleTypeParser.ExtractContentType() : Boolean; +var + locCrs, locAttCrs : IObjectCursor; + tmpNode : TDOMNode; + spaceShort : string; +begin + locCrs := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FRestrictionNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + tmpNode := nil; + locAttCrs := CreateAttributesCursor(FRestrictionNode,cetRttiNode); + if Assigned(locAttCrs) then begin + locAttCrs := CreateCursorOn(locAttCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_base)]),TDOMNodeRttiExposer)); + locAttCrs.Reset(); + if locAttCrs.MoveNext() then begin + tmpNode := (locAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + end; + end; + FBaseName := ''; + FBaseNameSpace := ''; + if Assigned(tmpNode) then begin + ExplodeQName(tmpNode.NodeValue,FBaseName,spaceShort); + if not FContext.FindNameSpace(spaceShort,FBaseNameSpace) then + raise EXsdParserAssertException.CreateFmt(SResolveError,[spaceShort]); + end; + locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor; + if Assigned(locCrs) then begin + locCrs := CreateCursorOn( + locCrs, + ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + locCrs.Reset(); + if locCrs.MoveNext() then begin + FIsEnum := True; + end else begin + if IsStrEmpty(FBaseName) then + raise EXsdParserAssertException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]); + FIsEnum := False + end; + end else begin + if IsStrEmpty(FBaseName) then + raise EXsdParserAssertException.CreateFmt('Base type is not specified for the simple type, parsing : "%s".',[FTypeName]); + FIsEnum := False + end; + Result := True; + end else begin + //raise EWslParserException.CreateFmt('The parser only support "Restriction" mode simple type derivation, parsing : "%s".',[FTypeName]); + Result := False; + end; +end; + +function TSimpleTypeParser.ParseEnumContent(): TPasType; + + function ExtractEnumCursor():IObjectCursor ; + begin + Result := CreateCursorOn( + CreateChildrenCursor(FRestrictionNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + end; + +var + locRes : TPasEnumType; + locOrder : Integer; + + procedure ParseEnumItem(AItemNode : TDOMNode); + var + tmpNode : TDOMNode; + locItemName, locInternalItemName : string; + locCrs : IObjectCursor; + locItem : TPasEnumValue; + locHasInternalName : Boolean; + locBuffer : string; + begin + locCrs := CreateCursorOn(CreateAttributesCursor(AItemNode,cetRttiNode),ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_value)]),TDOMNodeRttiExposer)) as IObjectCursor; + if not Assigned(locCrs) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid "enum" item node : no value attribute, type = "%s".',[FTypeName]); + locCrs.Reset(); + if not locCrs.MoveNext() then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid "enum" item node : no value attribute, type = "%s".',[FTypeName]); + tmpNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + locItemName := tmpNode.NodeValue; + if IsStrEmpty(locItemName) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid "enum" item node : the value attribute is empty, type = "%s".',[FTypeName]); + + locInternalItemName := ExtractIdentifier(locItemName); + locHasInternalName := IsReservedKeyWord(locInternalItemName) or + ( not IsValidIdent(locInternalItemName) ) or + ( FSymbols.FindElementInModule(locInternalItemName,Self.Module) <> nil ) or + FSymbols.IsEnumItemNameUsed(locInternalItemName,Self.Module) or + ( not AnsiSameText(locInternalItemName,locItemName) ); + if locHasInternalName then begin + locBuffer := ExtractIdentifier(FSymbols.GetExternalName(locRes)); + if ( not IsStrEmpty(locBuffer) ) and ( locBuffer[Length(locBuffer)] <> '_' ) then begin + locInternalItemName := Format('%s_%s',[locBuffer,locInternalItemName]); + end else begin + locInternalItemName := Format('%s%s',[locBuffer,locInternalItemName]); + end; + end; + locItem := TPasEnumValue(FSymbols.CreateElement(TPasEnumValue,locInternalItemName,locRes,visDefault,'',0)); + locItem.Value := locOrder; + locRes.Values.Add(locItem); + //locItem := TEnumItemDefinition.Create(locInternalItemName,locRes,locOrder); + if locHasInternalName then + FSymbols.RegisterExternalAlias(locItem,locItemName); + Inc(locOrder); + end; + +var + locEnumCrs : IObjectCursor; + intrName : string; + hasIntrnName : Boolean; +begin + locEnumCrs := ExtractEnumCursor(); + + intrName := FTypeName; + hasIntrnName := IsReservedKeyWord(FTypeName) or + ( ( FindElement(intrName) <> nil ) and ( not FindElement(intrName).InheritsFrom(TPasUnresolvedTypeRef) ) ); + if hasIntrnName then + intrName := '_' + intrName; + + locRes := TPasEnumType(FSymbols.CreateElement(TPasEnumType,Trim(intrName),Self.Module.InterfaceSection,visDefault,'',0)); + try + Result := locRes; + if hasIntrnName then + FSymbols.RegisterExternalAlias(locRes,FTypeName); + locEnumCrs.Reset(); + locOrder := 0; + while locEnumCrs.MoveNext() do begin + ParseEnumItem((locEnumCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + end; + except + FreeAndNil(Result); + raise; + end; +end; + +function TSimpleTypeParser.ParseOtherContent(): TPasType; +begin // todo : implement TSimpleTypeParser.ParseOtherContent + if IsStrEmpty(FBaseName) then + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid simple type definition : base type not provided, "%s".',[FTypeName]); + Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,FTypeName,Self.Module.InterfaceSection,visDefault,'',0)); + TPasTypeAliasType(Result).DestType := FindElementNS(FBaseNameSpace,FBaseName,nvtExpandValue) as TPasType; + TPasTypeAliasType(Result).DestType.AddRef(); +end; + +class function TSimpleTypeParser.GetParserSupportedStyle(): string; +begin + Result := s_simpleType; +end; + +function TSimpleTypeParser.Parse(): TPasType; +var + locSym : TPasElement; + locContinue : Boolean; +begin + if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_simpleType) then + raise EXsdParserAssertException.CreateFmt('%s expected but %s found.',[s_simpleType,ExtractNameFromQName(FTypeNode.NodeName)]); + CreateNodeCursors(); + ExtractTypeName(); + locContinue := True; + locSym := FindElement(FTypeName); + if Assigned(locSym) then begin + if not locSym.InheritsFrom(TPasType) then + raise EXsdParserAssertException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]); + locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef); + if not locContinue then begin + Result := locSym as TPasType; + end; + end; + if locContinue then begin + if ExtractContentType() then begin + if FIsEnum then begin + Result := ParseEnumContent() + end else begin + Result := ParseOtherContent(); + end; + end else begin + FBaseName := 'string'; + FBaseNameSpace := s_xs; + Result := ParseOtherContent(); + end; + end; +end; + +initialization + TAbstractTypeParser.RegisterParser(TSimpleTypeParser); + TAbstractTypeParser.RegisterParser(TComplexTypeParser); + +finalization + FreeAndNil(FTypeParserList); + +end. diff --git a/wst/trunk/ws_helper/wsdl2pas_imp.pas b/wst/trunk/ws_helper/wsdl2pas_imp.pas index 25851b760..910298c09 100644 --- a/wst/trunk/ws_helper/wsdl2pas_imp.pas +++ b/wst/trunk/ws_helper/wsdl2pas_imp.pas @@ -421,7 +421,6 @@ procedure TWsdlParser.Prepare(const AModuleName : string); var locAttCursor : IObjectCursor; locObj : TDOMNodeRttiExposer; - begin CreateWstInterfaceSymbolTable(SymbolTable); FModule := TPasModule(SymbolTable.CreateElement(TPasModule,AModuleName,SymbolTable.Package,visDefault,'',0)); @@ -443,7 +442,7 @@ begin ParseFilter(CreateQualifiedNameFilterStr(s_service,FWsdlShortNames),TDOMNodeRttiExposer) ); FServiceCursor.Reset(); - + FBindingCursor := CreateCursorOn( FChildCursor.Clone() as IObjectCursor, ParseFilter(CreateQualifiedNameFilterStr(s_binding,FWsdlShortNames),TDOMNodeRttiExposer) diff --git a/wst/trunk/ws_helper/wsdl_generator.pas b/wst/trunk/ws_helper/wsdl_generator.pas index dc5f14917..8d12dbcf0 100644 --- a/wst/trunk/ws_helper/wsdl_generator.pas +++ b/wst/trunk/ws_helper/wsdl_generator.pas @@ -153,6 +153,8 @@ const sSOAP_USE = 'use'; sADDRESS = 'address'; + sANNOTATION = 'annotation'; + sAPPINFO = 'appinfo'; sATTRIBUTE = 'attribute'; sBASE = 'base'; sBINDING = 'binding'; @@ -199,7 +201,7 @@ const sWSDL_TYPES = 'types'; var - WsdlTypeHandlerRegistryInst : IWsdlTypeHandlerRegistry; + WsdlTypeHandlerRegistryInst : IWsdlTypeHandlerRegistry = nil; function GetTypeNameSpace( @@ -665,12 +667,12 @@ procedure TClassTypeDefinition_TypeHandler.Generate( AWsdlDocument : TDOMDocument ); var - cplxNode, docNode : TDOMElement; + cplxNode, annNode : TDOMElement; procedure CreateDocNode(); begin - if ( docNode = nil ) then begin - docNode := CreateElement(sDOCUMENT,cplxNode,AWsdlDocument); + if ( annNode = nil ) then begin + annNode := CreateElement(sDOCUMENT,cplxNode,AWsdlDocument); end; end; @@ -686,7 +688,7 @@ var trueParent : TPasType; begin inherited; - docNode := nil; + annNode := nil; typItm := ASymbol as TPasClassType; if Assigned(typItm) then begin GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,AWsdlDocument); @@ -706,8 +708,8 @@ begin if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('THeaderBlock',trueParent.Name) then begin CreateDocNode(); - CreateElement(sCUSTOM_ATTRIBUTE,docNode,AWsdlDocument).SetAttribute(sHEADER_Block,'true'); - end; + CreateElement(sAPPINFO,annNode,AWsdlDocument).SetAttribute(sHEADER_Block,'true'); + end; if trueParent.InheritsFrom(TPasAliasType) then begin trueParent := GetUltimeType(trueParent); @@ -994,12 +996,12 @@ procedure TPasRecordType_TypeHandler.Generate( AWsdlDocument : TDOMDocument ); var - cplxNode, docNode : TDOMElement; + cplxNode, annNode : TDOMElement; procedure CreateDocNode(); begin - if ( docNode = nil ) then begin - docNode := CreateElement(sDOCUMENT,cplxNode,AWsdlDocument); + if ( annNode = nil ) then begin + annNode := CreateElement(Format('%s:%s',[sXSD,sANNOTATION]),cplxNode,AWsdlDocument); end; end; @@ -1013,7 +1015,7 @@ var hasSequence : Boolean; begin inherited; - docNode := nil; + annNode := nil; typItm := ASymbol as TPasRecordType; if Assigned(typItm) then begin GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,AWsdlDocument); @@ -1026,7 +1028,7 @@ begin cplxNode.SetAttribute(sNAME, AContainer.GetExternalName(typItm)) ; CreateDocNode(); - CreateElement(sCUSTOM_ATTRIBUTE,docNode,AWsdlDocument).SetAttribute(sRECORD,'true'); + CreateElement(Format('%s:%s',[sXSD,sAPPINFO]),annNode,AWsdlDocument).SetAttribute(sRECORD,'true'); hasSequence := False; for i := 0 to Pred(typItm.Members.Count) do begin diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas new file mode 100644 index 000000000..ba8b0316b --- /dev/null +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -0,0 +1,1237 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit wsdl_parser; + +interface +uses + Classes, SysUtils, + {$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF}, + cursor_intf, rtti_filters, + pastree, pascal_parser_intf, logger_intf, xsd_parser; + +const + s_TRANSPORT = 'TRANSPORT'; + s_FORMAT = 'FORMAT'; + +type + + TWsdlSchemaParser = class(TCustomXsdSchemaParser) + end; + + TParserMode = ( pmUsedTypes, pmAllTypes ); + + IParser = interface + ['{DE9D8592-150A-4FEC-BCB8-9EDB702EC8E7}'] + procedure Execute(const AMode : TParserMode; const AModuleName : string); + end; + + TWsdlParser = class(TInterfacedObject, IInterface, IParserContext, IParser) + private + FDoc : TXMLDocument; + FSymbols : TwstPasTreeContainer; + FModule : TPasModule; + private + FTargetNameSpace : string; + FNameSpaceList : TStringList; + FXsdParsers : TStringList; + FWsdlShortNames : TStrings; + FSoapShortNames : TStrings; + FXSShortNames : TStrings; + FChildCursor : IObjectCursor; + FServiceCursor : IObjectCursor; + FBindingCursor : IObjectCursor; + FPortTypeCursor : IObjectCursor; + FMessageCursor : IObjectCursor; + FTypesCursor : IObjectCursor; + FSchemaCursor : IObjectCursor; + FOnMessage: TOnParserMessage; + private + procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); + function AddNameSpace(const AValue : string) : TStrings; + private + function CreateWsdlNameFilter(const AName : WideString):IObjectFilter; + function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; + procedure Prepare(const AModuleName : string); + procedure ParseService(ANode : TDOMNode); + procedure ParsePort(ANode : TDOMNode); + function ParsePortType( + ANode, ABindingNode : TDOMNode; + const ABindingStyle : string + ) : TPasClassType; + function ParseOperation( + AOwner : TPasClassType; + ANode : TDOMNode; + const ASoapBindingStyle : string + ) : TPasProcedure; + function GetParser(const ANamespace : string) : IXsdPaser; + function ParseType(const AName : string) : TPasType; + procedure ParseTypes(); + protected + function GetXsShortNames() : TStrings; + function GetSymbolTable() : TwstPasTreeContainer; + function FindNameSpace(const AShortName : string; out AResult : string) : Boolean; + function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; + function GetTargetNameSpace() : string; + function GetTargetModule() : TPasModule; + public + constructor Create( + ADoc : TXMLDocument; + ASymbols : TwstPasTreeContainer; + const ANotifier : TOnParserMessage = nil + ); + destructor Destroy();override; + procedure Execute(const AMode : TParserMode; const AModuleName : string); + property SymbolTable : TwstPasTreeContainer read FSymbols; + + property OnMessage : TOnParserMessage read FOnMessage write FOnMessage; + end; + +implementation +uses ws_parser_imp, dom_cursors, parserutils, StrUtils; + +type + + { TIntfObjectRef } + + TIntfObjectRef = class + private + FIntf: IInterface; + public + constructor Create(AIntf : IInterface); + destructor Destroy();override; + property Intf : IInterface read FIntf; + end; + +function StrToBindingStyle(const AStr : string):TBindingStyle; +begin + if IsStrEmpty(AStr) then begin + Result := bsDocument; + end else if AnsiSameText(AStr,s_document) then begin + Result := bsDocument; + end else if AnsiSameText(AStr,s_rpc) then begin + Result := bsRPC; + end else begin + Result := bsUnknown; + end; +end; + +{ TWsdlParser } + +function TWsdlParser.AddNameSpace(const AValue: string): TStrings; +var + i : PtrInt; + s : string; + ls : TStringList; +begin + s := AValue;//Trim(AValue); + i := FNameSpaceList.IndexOf(s); + if ( i < 0 ) then begin + ls := TStringList.Create(); + FNameSpaceList.AddObject(s,ls); + ls.Duplicates := dupIgnore; + ls.Sorted := True; + Result := ls; + end else begin + Result := FNameSpaceList.Objects[i] as TStrings; + end; +end; + +constructor TWsdlParser.Create( + ADoc : TXMLDocument; + ASymbols : TwstPasTreeContainer; + const ANotifier : TOnParserMessage +); +begin + Assert(Assigned(ADoc)); + Assert(Assigned(ASymbols)); + inherited Create(); + FDoc := ADoc; + if Assigned(ANotifier) then + FOnMessage := ANotifier; + + FNameSpaceList := TStringList.Create(); + FNameSpaceList.Duplicates := dupIgnore; + FNameSpaceList.Sorted := True; + + FXsdParsers := TStringList.Create(); + FXsdParsers.Duplicates := dupIgnore; + FXsdParsers.Sorted := True; + + FSymbols := ASymbols; +end; + +function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter; +begin + Result := ParseFilter(CreateQualifiedNameFilterStr(AName,FWsdlShortNames),TDOMNodeRttiExposer); +end; + +destructor TWsdlParser.Destroy(); + + procedure FreeList(AList : TStrings); + var + j : PtrInt; + begin + if Assigned(AList) then begin + for j := 0 to Pred(AList.Count) do begin + AList.Objects[j].Free(); + AList.Objects[j] := nil; + end; + end; + FreeAndNil(AList); + end; + +begin + FreeList(FXsdParsers); + FreeList(FNameSpaceList); + inherited; +end; + +procedure TWsdlParser.DoOnMessage(const AMsgType: TMessageType; const AMsg: string); +begin + if Assigned(FOnMessage) then begin + FOnMessage(AMsgType,AMsg); + end else if IsConsole then begin + GetLogger().Log(AMsgType, AMsg); + end; +end; + +function TWsdlParser.FindNamedNode( + AList : IObjectCursor; + const AName : WideString; + const AOrder : Integer +): TDOMNode; +var + attCrs, crs : IObjectCursor; + curObj : TDOMNodeRttiExposer; + fltr : IObjectFilter; + locOrder : Integer; +begin + Result := nil; + if Assigned(AList) then begin + fltr := ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer); + AList.Reset(); + locOrder := AOrder; + while AList.MoveNext() do begin + curObj := AList.GetCurrent() as TDOMNodeRttiExposer; + attCrs := CreateAttributesCursor(curObj.InnerObject,cetRttiNode); + if Assigned(attCrs) then begin + crs := CreateCursorOn(attCrs,fltr); + crs.Reset(); + if crs.MoveNext() and AnsiSameText(AName,TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue) then begin + Dec(locOrder); + if ( locOrder <= 0 ) then begin + Result := curObj.InnerObject; + exit; + end; + end; + end; + end; + end; +end; + +function TWsdlParser.FindNameSpace(const AShortName: string; out AResult: string): Boolean; +var + i : PtrInt; + ls : TStrings; +begin + AResult := ''; + Result := False; + for i := 0 to Pred(FNameSpaceList.Count) do begin + ls := FNameSpaceList.Objects[i] as TStrings; + if ( ls.IndexOf(AShortName) >= 0 ) then begin + AResult := FNameSpaceList[i]; + Result := True; + Break; + end; + end; +end; + +function TWsdlParser.FindShortNamesForNameSpace(const ANameSpace: string): TStrings; +var + i : PtrInt; +begin + i := FNameSpaceList.IndexOf(ANameSpace); + if ( i >= 0 ) then + Result := FNameSpaceList.Objects[i] as TStrings + else + Result := nil; +end; + +function TWsdlParser.GetSymbolTable() : TwstPasTreeContainer; +begin + Result := FSymbols; +end; + +function TWsdlParser.GetTargetModule() : TPasModule; +begin + Result := FModule; +end; + +function TWsdlParser.GetTargetNameSpace() : string; +begin + Result := FTargetNameSpace; +end; + +function TWsdlParser.GetXsShortNames() : TStrings; +begin + Result := FXSShortNames; +end; + +procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: string); + + procedure ParseForwardDeclarations(); + var + i, c : Integer; + sym, symNew : TPasElement; + typeCursor : IObjectCursor; + schmNode, tmpNode : TDOMNode; + s : string; + typeList : TList; + begin + if Assigned(FSchemaCursor) then begin + FSchemaCursor.Reset(); + if FSchemaCursor.MoveNext() then begin + schmNode := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if schmNode.HasChildNodes() then begin + typeCursor := CreateChildrenCursor(schmNode,cetRttiNode); + s := CreateQualifiedNameFilterStr(s_complexType,FXSShortNames) + ' or ' + + CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames) + ' or ' + + CreateQualifiedNameFilterStr(s_element,FXSShortNames); + typeCursor := CreateCursorOn(typeCursor,ParseFilter(s,TDOMNodeRttiExposer)); + typeCursor.Reset(); + if typeCursor.MoveNext() then begin + typeList := FSymbols.CurrentModule.InterfaceSection.Declarations; + c := typeList.Count; + i := 0; + while ( i < c ) do begin + sym := TPasElement(typeList[i]); + if sym.InheritsFrom(TPasUnresolvedTypeRef) then begin + typeCursor.Reset(); + tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym)); + if Assigned(tmpNode) then begin + //symNew := ParseType(FSymbols.GetExternalName(sym)); + symNew := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue).ParseType(FSymbols.GetExternalName(sym)); + //symNew := ParseType(tmpNode.Attributes.GetNamedItem(s_name).NodeValue); + if ( sym <> symNew ) then begin + FModule.InterfaceSection.Declarations.Extract(sym); + FModule.InterfaceSection.Types.Extract(sym); + symNew.Name := sym.Name; + DoOnMessage(mtInfo,Format('forward type paring %s; %d %d',[symNew.Name,c, typeList.Count])); + //sym.Release(); + end; + i := 0; //Dec(i); + c := typeList.Count; + end else begin + DoOnMessage(mtInfo, 'unable to find the node of this type : ' + sym.Name); + end; + end; + Inc(i); + end; + end; + end; + end; + end; + end; + + procedure ExtractNameSpace(); + var + tmpCrs : IObjectCursor; + nd : TDOMNode; + s : string; + begin + nd := FDoc.DocumentElement; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_targetNamespace)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + s := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if not IsStrEmpty(s) then begin + FSymbols.RegisterExternalAlias(FSymbols.CurrentModule,s); + end; + end; + end; + end; + +var + locSrvcCrs : IObjectCursor; + locObj : TDOMNodeRttiExposer; +begin + Prepare(AModuleName); + + locSrvcCrs := FServiceCursor.Clone() as IObjectCursor; + locSrvcCrs.Reset(); + while locSrvcCrs.MoveNext() do begin + locObj := locSrvcCrs.GetCurrent() as TDOMNodeRttiExposer; + ParseService(locObj.InnerObject); + end; + + if ( AMode = pmAllTypes ) then begin + ParseTypes(); + end; + + ParseForwardDeclarations(); + ExtractNameSpace(); + SymbolTable.SetCurrentModule(FModule); +end; + +function TWsdlParser.ParseOperation( + AOwner : TPasClassType; + ANode : TDOMNode; + const ASoapBindingStyle : string +) : TPasProcedure; + + function ExtractOperationName(out AName : string):Boolean; + var + attCrs, crs : IObjectCursor; + begin + Result := False; + AName := ''; + attCrs := CreateAttributesCursor(ANode,cetRttiNode); + if Assigned(attCrs) then begin + crs := CreateCursorOn(attCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(s_name) ,TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; + end; + end; + end; + + function ExtractMsgName(const AMsgType : string; out AName : string) : Boolean; + var + chldCrs, crs : IObjectCursor; + begin + chldCrs := CreateChildrenCursor(ANode,cetRttiNode); + if ( chldCrs <> nil ) then begin + //crs := CreateCursorOn(chldCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(AMsgType) ,TDOMNodeRttiExposer)); + crs := CreateCursorOn(chldCrs,CreateWsdlNameFilter(AMsgType)); + crs.Reset(); + if crs.MoveNext() then begin + chldCrs := CreateAttributesCursor(TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject,cetRttiNode); + if ( chldCrs <> nil ) then begin + crs := CreateCursorOn(chldCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(s_message) ,TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; + end; + end; + end; + end; + Result := False; + end; + + function FindMessageNode(const AName : string) : TDOMNode; + begin + Result := FindNamedNode(FMessageCursor.Clone() as IObjectCursor,ExtractNameFromQName(AName)); + end; + + function CreatePartCursor(AMsgNode : TDOMNode):IObjectCursor ; + begin + Result := CreateChildrenCursor(AMsgNode,cetRttiNode); + if Assigned(Result) then + Result := CreateCursorOn(Result,CreateWsdlNameFilter(s_part)); + end; + + function GetDataType(const AName, ATypeOrElement : string):TPasType; + begin + Result := nil; + try + Result := ParseType(AName); + except + on e : Exception do begin + DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement); + raise; + end; + end; + end; + + procedure ExtractMethod( + const AMthdName : string; + out AMthd : TPasProcedure + ); + var + tmpMthd : TPasProcedure; + tmpMthdType : TPasProcedureType; + + procedure ParseInputMessage(); + var + inMsg, strBuffer : string; + inMsgNode, tmpNode : TDOMNode; + crs, tmpCrs : IObjectCursor; + prmName, prmTypeName, prmTypeType, prmTypeInternalName : string; + prmInternameName : string; + prmHasInternameName : Boolean; + prmDef : TPasArgument; + prmTypeDef : TPasType; + begin + tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0)); + tmpMthd.ProcType := tmpMthdType; + if ExtractMsgName(s_input,inMsg) then begin + inMsgNode := FindMessageNode(inMsg); + if ( inMsgNode <> nil ) then begin + crs := CreatePartCursor(inMsgNode); + if ( crs <> nil ) then begin + crs.Reset(); + while crs.MoveNext() do begin + tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; + strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name); + tmpCrs := CreateCursorOn( + CreateAttributesCursor(tmpNode,cetRttiNode), + ParseFilter(strBuffer,TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if not tmpCrs.MoveNext() then begin + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; + prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type); + tmpCrs := CreateCursorOn( + CreateAttributesCursor(tmpNode,cetRttiNode), + ParseFilter(strBuffer,TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if not tmpCrs.MoveNext() then begin + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; + prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName; + if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + end; + if SameText(s_document,ASoapBindingStyle) and + AnsiSameText(prmTypeType,s_element) + then begin + prmName := ExtractNameFromQName(prmTypeName); + end; + prmInternameName := Trim(prmName); + if AnsiSameText(prmInternameName,tmpMthd.Name) then begin + prmInternameName := prmInternameName + 'Param'; + end; + prmHasInternameName := IsReservedKeyWord(prmInternameName) or + ( not IsValidIdent(prmInternameName) ) or + ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 ); + if prmHasInternameName then begin + prmInternameName := '_' + prmInternameName; + end; + prmHasInternameName := not AnsiSameText(prmInternameName,prmName); + prmTypeDef := GetDataType(prmTypeName,prmTypeType); + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + tmpMthdType.Args.Add(prmDef); + prmDef.ArgType := prmTypeDef; + prmTypeDef.AddRef(); + prmDef.Access := argConst; + if prmHasInternameName or ( not AnsiSameText(prmName,prmInternameName) ) then begin + SymbolTable.RegisterExternalAlias(prmDef,prmName); + end; + if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin + prmTypeInternalName := prmTypeDef.Name + '_Type'; + while Assigned(FSymbols.FindElement(prmTypeInternalName)) do begin + prmTypeInternalName := '_' + prmTypeInternalName; + end; + SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef)); + prmTypeDef.Name := prmTypeInternalName; + end; + end; + end; + end; + end; + end; + + procedure ParseOutputMessage(); + var + outMsg, strBuffer : string; + outMsgNode, tmpNode : TDOMNode; + crs, tmpCrs : IObjectCursor; + prmName, prmTypeName, prmTypeType : string; + prmDef : TPasArgument; + prmInternameName : string; + prmHasInternameName : Boolean; + locProcType : TPasProcedureType; + locFunc : TPasFunction; + locFuncType : TPasFunctionType; + j : Integer; + arg_a, arg_b : TPasArgument; + begin + if ExtractMsgName(s_output,outMsg) then begin + outMsgNode := FindMessageNode(outMsg); + if ( outMsgNode <> nil ) then begin + crs := CreatePartCursor(outMsgNode); + if ( crs <> nil ) then begin + prmDef := nil; + crs.Reset(); + while crs.MoveNext() do begin + tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name); + tmpCrs := CreateCursorOn(CreateAttributesCursor(tmpNode,cetRttiNode),ParseFilter(strBuffer,TDOMNodeRttiExposer)); + tmpCrs.Reset(); + if not tmpCrs.MoveNext() then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + prmName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type); + tmpCrs := CreateCursorOn( + CreateAttributesCursor(tmpNode,cetRttiNode), + ParseFilter(strBuffer,TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if not tmpCrs.MoveNext() then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + prmTypeName := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName; + if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then + raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); + if SameText(s_document,ASoapBindingStyle) and + AnsiSameText(prmTypeType,s_element) + then begin + prmName := ExtractNameFromQName(prmTypeName); + end; + prmInternameName := Trim(prmName); + if AnsiSameText(prmInternameName,tmpMthd.Name) then begin + prmInternameName := prmInternameName + 'Param'; + end; + prmHasInternameName := IsReservedKeyWord(prmInternameName) or + ( not IsValidIdent(prmInternameName) ) or + ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 ); + if prmHasInternameName then + prmInternameName := '_' + prmInternameName; + prmHasInternameName := not AnsiSameText(prmInternameName,prmName); + prmDef := FindParameter(tmpMthdType,prmInternameName); + if ( prmDef = nil ) then begin + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + tmpMthdType.Args.Add(prmDef); + prmDef.ArgType := GetDataType(prmTypeName,prmTypeType); + prmDef.ArgType.AddRef(); + prmDef.Access := argOut; + if prmHasInternameName then begin + SymbolTable.RegisterExternalAlias(prmDef,prmName); + end; + end else begin + if SymbolTable.SameName(prmDef.ArgType,prmTypeName) then begin + prmDef.Access := argVar; + end else begin + prmInternameName := '_' + prmInternameName; + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + prmDef.ArgType := GetDataType(prmTypeName,prmTypeType); + prmDef.ArgType.AddRef(); + prmDef.Access := argOut; + tmpMthdType.Args.Add(prmDef); + SymbolTable.RegisterExternalAlias(prmDef,prmName); + end; + end; + end; + if ( SameText(ASoapBindingStyle,s_rpc) and + ( prmDef <> nil ) and ( prmDef.Access = argOut ) and + ( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) ) + ) or + ( SameText(ASoapBindingStyle,s_document) and + ( prmDef <> nil ) and + ( prmDef.Access = argOut ) and + ( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) ) + ) + then begin + locProcType := tmpMthd.ProcType; + locFunc := TPasFunction(SymbolTable.CreateElement(TPasFunction,tmpMthd.Name,AOwner,visDefault,'',0)); + locFuncType := SymbolTable.CreateFunctionType('','Result',locFunc,False,'',0); + locFunc.ProcType := locFuncType; + for j := 0 to ( locProcType.Args.Count - 2 ) do begin + arg_a := TPasArgument(locProcType.Args[j]); + arg_b := TPasArgument(SymbolTable.CreateElement(TPasArgument,arg_a.Name,locFuncType,visDefault,'',0)); + locFuncType.Args.Add(arg_b); + arg_b.Access := arg_a.Access; + arg_b.ArgType := arg_a.ArgType; + arg_b.ArgType.AddRef(); + SymbolTable.RegisterExternalAlias(arg_b,SymbolTable.GetExternalName(arg_a)); + end; + j := locProcType.Args.Count - 1; + arg_a := TPasArgument(locProcType.Args[j]); + locFuncType.ResultEl.ResultType := arg_a.ArgType; + SymbolTable.RegisterExternalAlias(locFuncType.ResultEl,SymbolTable.GetExternalName(arg_a)); + locFuncType.ResultEl.ResultType.AddRef(); + tmpMthd.Release(); + tmpMthd := locFunc; + end; + end; + end; + end; + end; + + begin + AMthd := nil; + tmpMthd := TPasProcedure(SymbolTable.CreateElement(TPasProcedure,AMthdName,AOwner,visDefault,'',0)); + try + ParseInputMessage(); + ParseOutputMessage(); + except + FreeAndNil(tmpMthd); + AMthd := nil; + raise; + end; + AMthd := tmpMthd; + end; + +var + locMthd : TPasProcedure; + mthdName : string; +begin + Result := nil; + locMthd := nil; + if not ExtractOperationName(mthdName) then + raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]); + if SameText(s_document,ASoapBindingStyle) then begin + ExtractMethod(mthdName,locMthd); + if ( locMthd <> nil ) then begin + AOwner.Members.Add(locMthd); + end; + end else if SameText(s_rpc,ASoapBindingStyle) then begin + ExtractMethod(mthdName,locMthd); + if ( locMthd <> nil ) then begin + AOwner.Members.Add(locMthd); + end; + end; + Result := locMthd; +end; + +procedure TWsdlParser.ParsePort(ANode: TDOMNode); + + function FindBindingNode(const AName : WideString):TDOMNode; + var + crs : IObjectCursor; + begin + Result := FindNamedNode(FBindingCursor,AName); + if Assigned(Result) then begin + crs := CreateChildrenCursor(Result,cetRttiNode); + if Assigned(crs) then begin + crs := CreateCursorOn(crs,ParseFilter(CreateQualifiedNameFilterStr(s_binding,FSoapShortNames),TDOMNodeRttiExposer)); + crs.Reset(); + if not crs.MoveNext() then begin + Result := nil; + end; + end else begin + Result := nil; + end; + end; + end; + + function ExtractBindingQName(out AName : WideString):Boolean ; + var + attCrs, crs : IObjectCursor; + begin + Result := False; + attCrs := CreateAttributesCursor(ANode,cetRttiNode); + if Assigned(attCrs) then begin + crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_binding)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; + end; + end; + end; + + function ExtractTypeQName(ABndgNode : TDOMNode; out AName : WideString):Boolean ; + var + attCrs, crs : IObjectCursor; + begin + Result := False; + attCrs := CreateAttributesCursor(ABndgNode,cetRttiNode); + if Assigned(attCrs) then begin + crs := CreateCursorOn(attCrs,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; + end; + end; + end; + + function FindTypeNode(const AName : WideString):TDOMNode; + begin + Result := FindNamedNode(FPortTypeCursor,AName); + end; + + function ExtractAddress() : string; + var + tmpCrs : IObjectCursor; + nd : TDOMNode; + begin + Result := ''; + if ANode.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_address,FSoapShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_location)]),TDOMNodeRttiExposer) + ); + if Assigned(tmpCrs) and tmpCrs.MoveNext() then begin + Result := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + end; + end; + end; + end; + + function ExtractSoapBindingStyle(ABindingNode : TDOMNode;out AName : WideString):Boolean ; + var + childrenCrs, crs, attCrs : IObjectCursor; + s : string; + begin + AName := ''; + Result := False; + childrenCrs := CreateChildrenCursor(ABindingNode,cetRttiNode); + if Assigned(childrenCrs) then begin + s := CreateQualifiedNameFilterStr(s_binding,FSoapShortNames); + crs := CreateCursorOn(childrenCrs,ParseFilter(s,TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + attCrs := CreateAttributesCursor(TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject,cetRttiNode); + if Assigned(attCrs) then begin + s := s_NODE_NAME + ' = ' + QuotedStr(s_style); + crs := CreateCursorOn(attCrs,ParseFilter(s,TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + AName := TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue; + Result := True; + exit; + end; + end; + end; + end; + end; + +var + bindingName, typeName : WideString; + i : Integer; + bindingNode, typeNode : TDOMNode; + intfDef : TPasClassType; + bdng : TwstBinding; + locSoapBindingStyle : string; + locWStrBuffer : WideString; +begin + if ExtractBindingQName(bindingName) then begin + i := Pos(':',bindingName); + bindingName := Copy(bindingName,( i + 1 ), MaxInt); + bindingNode := FindBindingNode(bindingName); + if Assigned(bindingNode) then begin + if ExtractTypeQName(bindingNode,typeName) then begin + i := Pos(':',typeName); + typeName := Copy(typeName,( i + 1 ), MaxInt); + typeNode := FindTypeNode(typeName); + if Assigned(typeNode) then begin + ExtractSoapBindingStyle(bindingNode,locWStrBuffer); + locSoapBindingStyle := locWStrBuffer; + intfDef := ParsePortType(typeNode,bindingNode,locSoapBindingStyle); + bdng := SymbolTable.AddBinding(bindingName,intfDef); + bdng.Address := ExtractAddress(); + bdng.BindingStyle := StrToBindingStyle(locSoapBindingStyle); + end; + end; + end; + end; +end; + +function TWsdlParser.ParsePortType( + ANode, ABindingNode : TDOMNode; + const ABindingStyle : string +) : TPasClassType; +var + s : string; + ws : widestring; + + function ExtractBindingOperationCursor() : IObjectCursor ; + begin + Result := nil; + if ABindingNode.HasChildNodes() then begin + Result := CreateCursorOn( + CreateChildrenCursor(ABindingNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer) + ); + end; + end; + + procedure ParseOperation_EncodingStyle(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure); + var + nd, ndSoap : TDOMNode; + tmpCrs, tmpSoapCrs, tmpXcrs : IObjectCursor; + in_out_count : Integer; + strBuffer : string; + begin + nd := FindNamedNode(ABndngOpCurs,SymbolTable.GetExternalName(AOp)); + if Assigned(nd) and nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter( + CreateQualifiedNameFilterStr(s_input,FWsdlShortNames) + ' or ' + + CreateQualifiedNameFilterStr(s_output,FWsdlShortNames) + , + TDOMNodeRttiExposer + ) + ); + tmpCrs.Reset(); + in_out_count := 0; + while tmpCrs.MoveNext() and ( in_out_count < 2 ) do begin + Inc(in_out_count); + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if nd.HasChildNodes() then begin + tmpSoapCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_body,FSoapShortNames),TDOMNodeRttiExposer) + ); + tmpSoapCrs.Reset(); + if tmpSoapCrs.MoveNext() then begin + ndSoap := (tmpSoapCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if Assigned(ndSoap.Attributes) and ( ndSoap.Attributes.Length > 0 ) then begin + tmpXcrs := CreateCursorOn( + CreateAttributesCursor(ndSoap,cetRttiNode), + ParseFilter( + Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]), + TDOMNodeRttiExposer + ) + ); + tmpXcrs.Reset(); + if tmpXcrs.MoveNext() then begin + if AnsiSameText(s_input,ExtractNameFromQName(nd.NodeName)) then begin + strBuffer := s_soapInputEncoding; + end else begin + strBuffer := s_soapOutputEncoding; + end; + SymbolTable.Properties.SetValue(AOp,s_FORMAT + '_' + strBuffer,(tmpXcrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue); + end; + end; + end; + end; + end; + end; + end; + + procedure ParseOperationAttributes(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure); + var + nd : TDOMNode; + tmpCrs : IObjectCursor; + //s : string; + //ws : widestring; + begin + ws := ''; + s := SymbolTable.GetExternalName(AOp); + ws := s; + nd := FindNamedNode(ABndngOpCurs,ws); + if Assigned(nd) and nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_operation,FSoapShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + tmpCrs := CreateCursorOn( + CreateAttributesCursor(nd,cetRttiNode), + ParseFilter( + Format( '%s = %s or %s = %s', + [ s_NODE_NAME,QuotedStr(s_soapAction), + s_NODE_NAME,QuotedStr(s_style) + ] + ), + TDOMNodeRttiExposer + ) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if AnsiSameText(nd.NodeName,s_style) then begin + SymbolTable.Properties.SetValue(AOp,s_soapStyle,nd.NodeValue); + end else if AnsiSameText(nd.NodeName,s_soapAction) then begin + SymbolTable.Properties.SetValue(AOp,s_TRANSPORT + '_' + s_soapAction,nd.NodeValue); + end; + end; + end; + end; + ParseOperation_EncodingStyle(ABndngOpCurs,AOp); + end; + end; + + function ParseIntfGuid() : string; + var + nd : TDOMNode; + tmpCrs : IObjectCursor; + begin + Result := ''; + tmpCrs := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_document,FWsdlShortNames),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if nd.HasChildNodes() then begin + tmpCrs := CreateCursorOn( + CreateChildrenCursor(nd,cetRttiNode), + ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_guid)]),TDOMNodeRttiExposer) + ); + tmpCrs.Reset(); + if tmpCrs.MoveNext() then begin + nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if ( nd.Attributes <> nil ) then begin + nd := nd.Attributes.GetNamedItem(s_value); + if Assigned(nd) then + Result := Trim(nd.NodeValue); + end; + end; + end; + end; + end; + +var + locIntf : TPasClassType; + locAttCursor : IObjectCursor; + locCursor, locOpCursor, locBindingOperationCursor : IObjectCursor; + locObj : TDOMNodeRttiExposer; + locMthd : TPasProcedure; + inft_guid : TGuid; + ansiStrBuffer : ansistring; + elt : TPasElement; +begin + locIntf := nil; + locAttCursor := CreateAttributesCursor(ANode,cetRttiNode); + locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + locCursor.Reset(); + if not locCursor.MoveNext() then + raise EXsdParserAssertException.CreateFmt('PortType Attribute not found : "%s"',[s_name]); + locObj := locCursor.GetCurrent() as TDOMNodeRttiExposer; + ansiStrBuffer := locObj.NodeValue; + elt := SymbolTable.FindElementInModule(ansiStrBuffer,SymbolTable.CurrentModule); + if ( elt = nil ) then begin + locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + FModule.InterfaceSection.Declarations.Add(locIntf); + FModule.InterfaceSection.Types.Add(locIntf); + FModule.InterfaceSection.Classes.Add(locIntf); + locIntf.ObjKind := okInterface; + Result := locIntf; + locIntf.InterfaceGUID := ParseIntfGuid(); + if IsStrEmpty(locIntf.InterfaceGUID) and ( CreateGUID(inft_guid) = 0 ) then + locIntf.InterfaceGUID := GUIDToString(inft_guid); + locCursor := CreateChildrenCursor(ANode,cetRttiNode); + if Assigned(locCursor) then begin + locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer)); + locOpCursor.Reset(); + locBindingOperationCursor := ExtractBindingOperationCursor(); + while locOpCursor.MoveNext() do begin + locObj := locOpCursor.GetCurrent() as TDOMNodeRttiExposer; + locMthd := ParseOperation(locIntf,locObj.InnerObject,ABindingStyle); + if Assigned(locMthd) then begin + ParseOperationAttributes(locBindingOperationCursor,locMthd); + end; + end; + end; + end else begin + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + Result := TPasClassType(elt); + end else begin + raise EXsdInvalidDefinitionException.CreateFmt('Invalid element definition : "%s".',[elt.Name]); + end; + end; +end; + +procedure TWsdlParser.ParseService(ANode: TDOMNode); +var + locCursor, locPortCursor : IObjectCursor; + locObj : TDOMNodeRttiExposer; +begin + locCursor := CreateChildrenCursor(ANode,cetRttiNode); + if Assigned(locCursor) then begin + locPortCursor := CreateCursorOn( + locCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_port,FWsdlShortNames),TDOMNodeRttiExposer) + ); + locPortCursor.Reset(); + while locPortCursor.MoveNext() do begin + locObj := locPortCursor.GetCurrent() as TDOMNodeRttiExposer; + ParsePort(locObj.InnerObject); + end; + end; +end; + +function TWsdlParser.ParseType(const AName : string) : TPasType; +var + localName, spaceShort, spaceLong : string; + locPrs : IXsdPaser; + xsdModule : TPasModule; +begin + ExplodeQName(AName,localName,spaceShort); + if ( FXSShortNames.IndexOf(spaceShort) >= 0 ) then begin + xsdModule := SymbolTable.FindModule(s_xs); + Result := SymbolTable.FindElementInModule(localName,xsdModule) as TPasType; + if ( Result = nil ) then + raise EXsdTypeNotFoundException.CreateFmt('Type not found : "%s".',[AName]); + end else begin + if not FindNameSpace(spaceShort,spaceLong) then + raise EXsdParserAssertException.CreateFmt('Unable to resolve the namespace : "%s".',[spaceShort]); + locPrs := GetParser(spaceLong); + Result := locPrs.ParseType(AName); + end; +end; + +procedure TWsdlParser.ParseTypes(); +var + locPrs : IXsdPaser; + i : PtrInt; +begin + for i := 0 to Pred(FXsdParsers.Count) do begin + locPrs := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; + locPrs.ParseTypes(); + end; +end; + +procedure TWsdlParser.Prepare(const AModuleName: string); + + function ExtractTargetNameSpace(ANode : TDOMNode) : string; + var + locDomObj : TDOMNode; + begin + locDomObj := ANode; + if ( locDomObj.Attributes = nil ) then + raise EXsdParserAssertException.Create('Invalid document.'); + locDomObj := locDomObj.Attributes.GetNamedItem(s_targetNamespace); + if Assigned(locDomObj) then + Result := locDomObj.NodeValue; + end; + + procedure CreateXsdParsers(); + var + locDomObj : TDOMNode; + locPrs : IXsdPaser; + ns : string; + begin + if Assigned(FSchemaCursor) then begin + FSchemaCursor.Reset(); + while FSchemaCursor.MoveNext() do begin + locDomObj := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + locPrs := TWsdlSchemaParser.Create(FDoc,locDomObj,FSymbols,Self); + locPrs.SetNotifier(FOnMessage); + ns := (locPrs as IParserContext).GetTargetNameSpace(); + FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs)); + end; + end; + end; + +var + locAttCursor : IObjectCursor; + locObj : TDOMNodeRttiExposer; +begin + locAttCursor := CreateAttributesCursor(FDoc.DocumentElement,cetRttiNode); + FChildCursor := CreateChildrenCursor(FDoc.DocumentElement,cetRttiNode); + + FTargetNameSpace := ExtractTargetNameSpace(FDoc.DocumentElement); + CreateWstInterfaceSymbolTable(SymbolTable); + + FModule := TPasModule(SymbolTable.CreateElement(TPasModule,AModuleName,SymbolTable.Package,visDefault,'',0)); + SymbolTable.Package.Modules.Add(FModule); + SymbolTable.RegisterExternalAlias(FModule,FTargetNameSpace); + FModule.InterfaceSection := TPasSection(SymbolTable.CreateElement(TPasSection,'',FModule,visDefault,'',0)); + + FPortTypeCursor := nil; + + FWsdlShortNames := AddNameSpace(s_wsdl); + ExtractNameSpaceShortNames(locAttCursor,FWsdlShortNames,s_wsdl,nfaRaiseException,True,EXsdParserException); + FSoapShortNames := AddNameSpace(s_soap); + ExtractNameSpaceShortNames(locAttCursor,FSoapShortNames,s_soap,nfaRaiseException,False,EXsdParserException); + FXSShortNames := AddNameSpace(s_xs); + ExtractNameSpaceShortNames(locAttCursor,FXSShortNames,s_xs,nfaNone,True,EXsdParserException); + + BuildNameSpaceList(locAttCursor,FNameSpaceList); + FServiceCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_service,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FServiceCursor.Reset(); + + FBindingCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_binding,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FBindingCursor.Reset(); + + FPortTypeCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_portType,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FPortTypeCursor.Reset(); + + FSchemaCursor := nil; + FTypesCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_types,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FTypesCursor.Reset(); + if FTypesCursor.MoveNext() then begin + locObj := FTypesCursor.GetCurrent() as TDOMNodeRttiExposer; + if locObj.InnerObject.HasChildNodes() then begin + FSchemaCursor := CreateChildrenCursor(locObj.InnerObject,cetRttiNode); + FSchemaCursor.Reset(); + FSchemaCursor := CreateCursorOn( + FSchemaCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_schema,FXSShortNames),TDOMNodeRttiExposer) + ); + FSchemaCursor.Reset(); + end; + end; + + FMessageCursor := CreateCursorOn( + FChildCursor.Clone() as IObjectCursor, + ParseFilter(CreateQualifiedNameFilterStr(s_message,FWsdlShortNames),TDOMNodeRttiExposer) + ); + FMessageCursor.Reset(); + CreateXsdParsers(); +end; + +function TWsdlParser.GetParser(const ANamespace: string): IXsdPaser; +var + i : PtrInt; +begin + i := FXsdParsers.IndexOf(ANamespace); + if ( i < 0 ) then + raise EXsdParserAssertException.CreateFmt('Unable to find the parser of the parser, namespace : "%s".',[ANamespace]); + Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; +end; + +{ TIntfObjectRef } + +constructor TIntfObjectRef.Create(AIntf: IInterface); +begin + Assert(Assigned(AIntf)); + FIntf := AIntf; +end; + +destructor TIntfObjectRef.Destroy(); +begin + FIntf := nil; + inherited Destroy(); +end; + +end. diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas new file mode 100644 index 000000000..51ac9335d --- /dev/null +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -0,0 +1,590 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit xsd_parser; + +interface +uses + Classes, SysUtils, + {$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF}, + cursor_intf, rtti_filters, + pastree, pascal_parser_intf, logger_intf; + +type + + EXsdParserException = class(Exception) + end; + + EXsdParserAssertException = class(EXsdParserException) + end; + + EXsdTypeNotFoundException = class(EXsdParserException) + end; + + EXsdInvalidDefinitionException = class(EXsdParserException) + end; + + EXsdInvalidTypeDefinitionException = class(EXsdInvalidDefinitionException) + end; + + EXsdInvalidElementDefinitionException = class(EXsdInvalidDefinitionException) + end; + + TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object; + + + IParserContext = interface + ['{F400BA9E-41AC-456C-ABF9-CEAA75313685}'] + function GetXsShortNames() : TStrings; + function GetSymbolTable() : TwstPasTreeContainer; + function FindNameSpace(const AShortName : string; out AResult : string) : Boolean; + function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; + function GetTargetNameSpace() : string; + function GetTargetModule() : TPasModule; + end; + + IXsdPaser = interface + ['{F0CEC726-A068-4CCC-B1E7-D31F018415B2}'] + function ParseType(const AName : string) : TPasType; + procedure ParseTypes(); + procedure SetNotifier(ANotifier : TOnParserMessage); + end; + + { TCustomXsdSchemaParser } + + TCustomXsdSchemaParser = class(TInterfacedObject, IInterface, IParserContext, IXsdPaser) + private + FDoc : TXMLDocument; + FParentContext : Pointer;//IParserContext; + FSymbols : TwstPasTreeContainer; + FModuleName : string; + FModule : TPasModule; + FTargetNameSpace : string; + FSchemaNode : TDOMNode; + private + FNameSpaceList : TStringList; + FXSShortNames : TStrings; + FChildCursor : IObjectCursor; + FOnMessage: TOnParserMessage; + private + procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); + private + function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; + function AddNameSpace(const AValue : string) : TStrings; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure Prepare(); + function FindElement(const AName: String) : TPasElement; {$IFDEF USE_INLINE}inline;{$ENDIF} + protected + function GetXsShortNames() : TStrings; + function GetSymbolTable() : TwstPasTreeContainer; + function FindNameSpace(const AShortName : string; out AResult : string) : Boolean; + function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings; + function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; + procedure SetNotifier(ANotifier : TOnParserMessage); + public + constructor Create( + ADoc : TXMLDocument; + ASchemaNode : TDOMNode; + ASymbols : TwstPasTreeContainer; + AParentContext : IParserContext + ); + destructor Destroy();override; + function ParseType(const AName : string) : TPasType; + procedure ParseTypes(); + + function GetTargetNameSpace() : string; + function GetTargetModule() : TPasModule; + + property SymbolTable : TwstPasTreeContainer read FSymbols; + property Module : TPasModule read FModule; + property OnMessage : TOnParserMessage read FOnMessage write FOnMessage; + end; + + TXsdParser = class(TCustomXsdSchemaParser) + public + constructor Create( + ADoc : TXMLDocument; + ASymbols : TwstPasTreeContainer; + const AModuleName : string + ); + end; + +implementation +uses ws_parser_imp, dom_cursors, parserutils, StrUtils +{$IFDEF FPC} + ,wst_fpc_xml +{$ENDIF} + ; + +{ TCustomXsdSchemaParser } + +function TCustomXsdSchemaParser.AddNameSpace(const AValue: string): TStrings; +begin + Result := parserutils.AddNameSpace(AValue,FNameSpaceList) +end; + +constructor TCustomXsdSchemaParser.Create( + ADoc : TXMLDocument; + ASchemaNode : TDOMNode; + ASymbols : TwstPasTreeContainer; + AParentContext : IParserContext +); +begin + if ( ADoc = nil ) then + raise EXsdParserAssertException.Create('Invalid DOM document.'); + if ( ASchemaNode = nil ) then + raise EXsdParserAssertException.Create('Invalid schema node.'); + if ( ASymbols = nil ) then + raise EXsdParserAssertException.Create('Invalid Symbol table.'); + if ( ASchemaNode = nil ) then + raise EXsdParserAssertException.Create('Invalid schema node.'); + + FDoc := ADoc; + FParentContext := Pointer(AParentContext); + FSymbols := ASymbols; + FSchemaNode := ASchemaNode; + + FNameSpaceList := TStringList.Create(); + FNameSpaceList.Duplicates := dupError; + FNameSpaceList.Sorted := True; + + Prepare(); +end; + +destructor TCustomXsdSchemaParser.Destroy(); +var + i : PtrInt; +begin + FParentContext := nil; + for i := 0 to Pred(FNameSpaceList.Count) do begin + FNameSpaceList.Objects[i].Free(); + end; + FreeAndNil(FNameSpaceList); + inherited; +end; + +procedure TCustomXsdSchemaParser.DoOnMessage( + const AMsgType: TMessageType; + const AMsg: string +); +begin + if Assigned(FOnMessage) then begin + FOnMessage(AMsgType,AMsg); + end else if IsConsole and HasLogger() then begin + GetLogger().Log(AMsgType, AMsg); + end; +end; + +function TCustomXsdSchemaParser.FindElement(const AName: String): TPasElement; +begin + Result := SymbolTable.FindElementInModule(AName,FModule); +end; + +function TCustomXsdSchemaParser.FindNamedNode( + AList : IObjectCursor; + const AName : WideString; + const AOrder : Integer +): TDOMNode; +var + attCrs, crs : IObjectCursor; + curObj : TDOMNodeRttiExposer; + fltr : IObjectFilter; + locOrder : Integer; +begin + Result := nil; + if Assigned(AList) then begin + fltr := ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer); + AList.Reset(); + locOrder := AOrder; + while AList.MoveNext() do begin + curObj := AList.GetCurrent() as TDOMNodeRttiExposer; + attCrs := CreateAttributesCursor(curObj.InnerObject,cetRttiNode); + if Assigned(attCrs) then begin + crs := CreateCursorOn(attCrs,fltr); + crs.Reset(); + if crs.MoveNext() and AnsiSameText(AName,TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue) then begin + Dec(locOrder); + if ( locOrder <= 0 ) then begin + Result := curObj.InnerObject; + exit; + end; + end; + end; + end; + end; +end; + +function TCustomXsdSchemaParser.FindNameSpace( + const AShortName : string; + out AResult : string +) : Boolean; +var + i : PtrInt; + ls : TStrings; +begin + AResult := ''; + Result := False; + for i := 0 to Pred(FNameSpaceList.Count) do begin + ls := FNameSpaceList.Objects[i] as TStrings; + if ( ls.IndexOf(AShortName) >= 0 ) then begin + AResult := FNameSpaceList[i]; + Result := True; + Break; + end; + end; + if not Result then + Result := GetParentContext().FindNameSpace(AShortName,AResult); +end; + +function TCustomXsdSchemaParser.FindShortNamesForNameSpace(const ANameSpace: string): TStrings; +var + prtCtx : IParserContext; +begin + Result := FindShortNamesForNameSpaceLocal(ANameSpace); + if ( Result = nil ) then begin + prtCtx := GetParentContext(); + if Assigned(prtCtx) then + Result := prtCtx.FindShortNamesForNameSpace(ANameSpace); + end; +end; + +procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage); +begin + FOnMessage := ANotifier; +end; + +function TCustomXsdSchemaParser.FindShortNamesForNameSpaceLocal(const ANameSpace: string): TStrings; +var + i : PtrInt; +begin + i := FNameSpaceList.IndexOf(ANameSpace); + if ( i >= 0 ) then + Result := FNameSpaceList.Objects[i] as TStrings + else + Result := nil; +end; + +function TCustomXsdSchemaParser.GetParentContext() : IParserContext; +begin + Result := IParserContext(FParentContext); +end; + +function TCustomXsdSchemaParser.GetSymbolTable() : TwstPasTreeContainer; +begin + Result := FSymbols; +end; + +function TCustomXsdSchemaParser.GetTargetModule() : TPasModule; +begin + Result := FModule; +end; + +function TCustomXsdSchemaParser.GetTargetNameSpace() : string; +begin + Result := FTargetNameSpace; +end; + +function TCustomXsdSchemaParser.GetXsShortNames() : TStrings; +begin + Result := FXSShortNames; +end; + +function TCustomXsdSchemaParser.ParseType(const AName: string): TPasType; +var + crsSchemaChild : IObjectCursor; + typNd : TDOMNode; + typName : string; + embededType : Boolean; + localTypeName : string; + + procedure Init(); + begin + crsSchemaChild := FChildCursor.Clone() as IObjectCursor; + end; + + function FindTypeNode(out ASimpleTypeAlias : TPasType) : Boolean; + var + nd, oldTypeNode : TDOMNode; + crs : IObjectCursor; + locStrFilter : string; + begin + ASimpleTypeAlias := nil; + Result := True; + typNd := FindNamedNode(crsSchemaChild,localTypeName); + if not Assigned(typNd) then + raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]); + if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin + crs := CreateCursorOn(CreateAttributesCursor(typNd,cetRttiNode),ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); + crs.Reset(); + if crs.MoveNext() then begin + nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + ASimpleTypeAlias := FindElement(ExtractNameFromQName(nd.NodeValue)) as TPasType; + if Assigned(ASimpleTypeAlias) then begin + Result := False; + end else begin + oldTypeNode := typNd; + typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue)); + if not Assigned(typNd) then + raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 2 : "%s"',[AName]); + embededType := False; + if ( typNd = oldTypeNode ) then begin + typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue),2); + if not Assigned(typNd) then + raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 2.1 : "%s"',[AName]); + end; + end; + end else begin + //locStrFilter := Format('%s = %s or %s = %s ',[s_NODE_NAME,QuotedStr(s_complexType),s_NODE_NAME,QuotedStr(s_simpleType)]); + locStrFilter := CreateQualifiedNameFilterStr(s_complexType,FXSShortNames) + ' or ' + + CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames); + crs := CreateCursorOn(CreateChildrenCursor(typNd,cetRttiNode),ParseFilter(locStrFilter,TDOMNodeRttiExposer)); + crs.Reset(); + if not crs.MoveNext() then begin + raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 3 : "%s"',[AName]); + end; + typNd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + typName := ExtractNameFromQName(AName); + embededType := True; + end; + end; + end; + + function ParseComplexType():TPasType; + var + locParser : TComplexTypeParser; + begin + locParser := TComplexTypeParser.Create(Self,typNd,typName,embededType); + try + Result := locParser.Parse(); + finally + FreeAndNil(locParser); + end; + end; + + function ParseSimpleType():TPasType; + var + locParser : TSimpleTypeParser; + begin + locParser := TSimpleTypeParser.Create(Self,typNd,typName,embededType); + try + Result := locParser.Parse(); + finally + FreeAndNil(locParser); + end; + end; + + function CreateTypeAlias(const ABase : TPasType): TPasType; + var + hasInternameName : Boolean; + internameName : string; + begin + internameName := ExtractNameFromQName(AName); + hasInternameName := IsReservedKeyWord(internameName) or + ( not IsValidIdent(internameName) ); + if hasInternameName then begin + internameName := '_' + internameName; + end; + Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + TPasAliasType(Result).DestType := ABase; + ABase.AddRef(); + end; + + function CreateUnresolveType(): TPasType; + var + hasInternameName : Boolean; + internameName : string; + begin + internameName := ExtractNameFromQName(AName); + hasInternameName := IsReservedKeyWord(internameName) or + ( not IsValidIdent(internameName) ); + if hasInternameName then begin + internameName := '_' + internameName; + end; + Result := TPasUnresolvedTypeRef(SymbolTable.CreateElement(TPasUnresolvedTypeRef,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + if not AnsiSameText(internameName,AName) then + SymbolTable.RegisterExternalAlias(Result,AName); + end; + +var + frwType, aliasType : TPasType; + sct : TPasSection; + shortNameSpace, longNameSpace : string; + typeModule : TPasModule; +begin + DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName])); + try + embededType := False; + aliasType := nil; + Result := nil; + typeModule := nil; + ExplodeQName(AName,localTypeName,shortNameSpace); + if IsStrEmpty(shortNameSpace) then begin + typeModule := FModule; + end else begin + if not FindNameSpace(shortNameSpace,longNameSpace) then + raise EXsdParserAssertException.CreateFmt('Unable to resolve namespace, short name = "%s".',[shortNameSpace]); + typeModule := SymbolTable.FindModule(longNameSpace); + end; + if ( typeModule = nil ) then + raise EXsdTypeNotFoundException.Create(AName); + Result := SymbolTable.FindElementInModule(localTypeName,typeModule) as TPasType; + if ( ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) ) and + ( typeModule = FModule ) + then begin + sct := FModule.InterfaceSection; + frwType := Result; + Result := nil; + Init(); + if FindTypeNode(aliasType) then begin + if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin + Result := ParseComplexType(); + end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin + Result := ParseSimpleType(); + end; + if Assigned(Result) then begin + if Assigned(frwType) and AnsiSameText(SymbolTable.GetExternalName(Result),SymbolTable.GetExternalName(frwType)) then begin + Result.Name := frwType.Name; + SymbolTable.RegisterExternalAlias(Result,SymbolTable.GetExternalName(frwType)); + end; + end else begin + raise EXsdTypeNotFoundException.CreateFmt('Type node found but unable to parse it : "%s"',[AName]); + end; + end else begin + Result := CreateTypeAlias(aliasType); + end; + if ( frwType <> nil ) then begin + sct.Declarations.Extract(frwType); + sct.Types.Extract(frwType); + frwType.Release(); + end; + sct.Declarations.Add(Result); + sct.Types.Add(Result); + if Result.InheritsFrom(TPasClassType) then begin + sct.Classes.Add(Result); + end; + end; + except + on e : EXsdTypeNotFoundException do begin + Result := CreateUnresolveType(); + sct.Declarations.Add(Result); + sct.Types.Add(Result); + end; + end; +end; + +procedure TCustomXsdSchemaParser.ParseTypes(); +var + nd : TDOMNodeRttiExposer; + schmCrsr, crsSchemaChild, typTmpCrs : IObjectCursor; + typFilterStr : string; + typNode : TDOMNode; +begin + if Assigned(FChildCursor) then begin + crsSchemaChild := FChildCursor.Clone() as IObjectCursor; + typFilterStr := Format( + '%s or %s or %s', + [ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames), + CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames), + CreateQualifiedNameFilterStr(s_element,FXSShortNames) + ] + ); + crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer)); + crsSchemaChild.Reset(); + while crsSchemaChild.MoveNext() do begin + typNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + typTmpCrs := CreateAttributesCursor(typNode,cetRttiNode); + if Assigned(typTmpCrs) then begin + typTmpCrs.Reset(); + typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); + typTmpCrs.Reset(); + if typTmpCrs.MoveNext() then begin + ParseType( + (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue + ); + end; + end; + end; + end; +end; + +procedure TCustomXsdSchemaParser.Prepare(); +var + locAttCursor : IObjectCursor; + prntCtx : IParserContext; + nd : TDOMNode; + i : PtrInt; + ls : TStrings; +begin + if ( FSchemaNode.Attributes = nil ) or ( GetNodeListCount(FSchemaNode.Attributes) = 0 ) then + raise EXsdParserAssertException.CreateFmt('The Schema node has at least the "%s" attribute.',[s_targetNamespace]); + nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace); + if ( nd = nil ) then + raise EXsdParserAssertException.CreateFmt('The Schema node has at least the "%s" attribute.',[s_targetNamespace]); + FTargetNameSpace := nd.NodeValue; + if IsStrEmpty(FModuleName) then + FModuleName := ExtractIdentifier(FTargetNameSpace); + if ( SymbolTable.FindModule(s_xs) = nil ) then begin + CreateWstInterfaceSymbolTable(SymbolTable); + end; + FChildCursor := CreateChildrenCursor(FSchemaNode,cetRttiNode); + + locAttCursor := CreateAttributesCursor(FSchemaNode,cetRttiNode); + BuildNameSpaceList(locAttCursor,FNameSpaceList); + FXSShortNames := FindShortNamesForNameSpaceLocal(s_xs); + prntCtx := GetParentContext(); + if ( FXSShortNames = nil ) then begin + if ( prntCtx = nil ) then + raise EXsdParserAssertException.CreateFmt('Invalid Schema document, namespace not found :'#13'%s.',[s_xs]); + FXSShortNames := prntCtx.FindShortNamesForNameSpace(s_xs); + if ( FXSShortNames = nil ) then + raise EXsdParserAssertException.CreateFmt('Invalid Schema document, namespace not found ( short names ) :'#13'%s.',[s_xs]); + end; + + if Assigned(prntCtx) then begin + for i:= 0 to Pred(FNameSpaceList.Count) do begin + ls := prntCtx.FindShortNamesForNameSpace(FNameSpaceList[i]); + if Assigned(ls) then + (FNameSpaceList.Objects[i] as TStrings).AddStrings(ls); + end; + end; + + FModule := SymbolTable.FindModule(FTargetNameSpace); + if ( FModule = nil ) then begin + FModule := TPasModule(SymbolTable.CreateElement(TPasModule,FModuleName,SymbolTable.Package,visDefault,'',0)); + SymbolTable.Package.Modules.Add(FModule); + SymbolTable.RegisterExternalAlias(FModule,FTargetNameSpace); + FModule.InterfaceSection := TPasSection(SymbolTable.CreateElement(TPasSection,'',FModule,visDefault,'',0)); + end; +end; + +{ TXsdParser } + +constructor TXsdParser.Create( + ADoc : TXMLDocument; + ASymbols : TwstPasTreeContainer; + const AModuleName : string +); +var + locName : string; +begin + inherited Create(ADoc,ADoc.DocumentElement,ASymbols,nil); + if not IsStrEmpty(AModuleName) then begin + locName := ExtractIdentifier(AModuleName); + if not IsStrEmpty(locName) then begin + FModuleName := locName; + Module.Name := FModuleName; + end; + end; +end; + +end.