From b1bba371cea7234f6271d339e3e68a1c7a276348 Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Fri, 30 Oct 2020 08:41:26 +0100
Subject: [PATCH 1/6] =?UTF-8?q?[WIP]=20cx=20Komponenten=20durch=20Delphi?=
=?UTF-8?q?=20eigene=20ersetzt=20DPROJ=20Search=20Path=20f=C3=BCr=20x2=20Z?=
=?UTF-8?q?usatzkomponenten=20gesetzt,=20sp=C3=A4ter=20in=20Submodule=20au?=
=?UTF-8?q?slagern?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
Forms/MainFrm.dfm | 102 +++++++++++++++++------------------------
Forms/MainFrm.pas | 21 +++++----
X2XMLDataBinding.dproj | 5 +-
3 files changed, 55 insertions(+), 73 deletions(-)
diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm
index 641bd33..d859bea 100644
--- a/Forms/MainFrm.dfm
+++ b/Forms/MainFrm.dfm
@@ -27,19 +27,6 @@ object MainForm: TMainForm
Height = 13
Caption = 'Schema file:'
end
- object feSchema: TcxButtonEdit
- Left = 99
- Top = 8
- Anchors = [akLeft, akTop, akRight]
- Properties.Buttons = <
- item
- Kind = bkEllipsis
- end>
- Properties.OnButtonClick = feSchemaPropertiesButtonClick
- Properties.OnChange = feSchemaPropertiesChange
- TabOrder = 0
- Width = 331
- end
object gbOutput: TGroupBox
Left = 8
Top = 43
@@ -47,7 +34,7 @@ object MainForm: TMainForm
Height = 225
Anchors = [akLeft, akTop, akBottom]
Caption = ' Output '
- TabOrder = 1
+ TabOrder = 0
DesignSize = (
422
225)
@@ -82,10 +69,6 @@ object MainForm: TMainForm
TabOrder = 2
object spFile: TTabSheet
TabVisible = False
- ExplicitLeft = 0
- ExplicitTop = 0
- ExplicitWidth = 0
- ExplicitHeight = 0
object lblFile: TLabel
Left = 4
Top = 7
@@ -93,23 +76,17 @@ object MainForm: TMainForm
Height = 13
Caption = 'Output file:'
end
- object feFile: TcxButtonEdit
- Left = 88
- Top = 4
- Properties.Buttons = <
- item
- Kind = bkEllipsis
- end>
- Properties.OnButtonClick = feFilePropertiesButtonClick
+ object feFile: TEdit
+ Left = 76
+ Top = 3
+ Width = 316
+ Height = 21
TabOrder = 0
- Width = 317
+ Text = 'D:\Temp\test.pas'
end
end
object spFolder: TTabSheet
TabVisible = False
- DesignSize = (
- 408
- 83)
object lblFolder: TLabel
Left = 4
Top = 7
@@ -131,30 +108,36 @@ object MainForm: TMainForm
Height = 13
Caption = 'File postfix:'
end
- object deFolder: TcxButtonEdit
- Left = 88
- Top = 4
- Anchors = [akLeft, akTop, akRight]
- Properties.Buttons = <
- item
- Kind = bkEllipsis
- end>
- Properties.OnButtonClick = deFolderPropertiesButtonClick
+ object edtFolderPrefix: TEdit
+ Left = 89
+ Top = 31
+ Width = 316
+ Height = 21
TabOrder = 0
- Width = 317
+ Text = 'Edit1'
end
- object edtFolderPrefix: TcxTextEdit
- Left = 88
- Top = 29
+ object edtFolderPostfix: TEdit
+ Left = 89
+ Top = 59
+ Width = 316
+ Height = 21
TabOrder = 1
- Text = 'xml_'
- Width = 121
+ Text = 'Edit1'
end
- object edtFolderPostfix: TcxTextEdit
- Left = 88
- Top = 55
+ object deFolder: TEdit
+ Left = 89
+ Top = 4
+ Width = 256
+ Height = 21
TabOrder = 2
- Width = 121
+ end
+ object BrowseOutputFolderButton: TButton
+ Left = 351
+ Top = 4
+ Width = 64
+ Height = 22
+ Caption = 'BrowseOutputFolderButton'
+ TabOrder = 3
end
end
end
@@ -200,7 +183,7 @@ object MainForm: TMainForm
Anchors = [akRight, akBottom]
Cancel = True
Caption = '&Close'
- TabOrder = 4
+ TabOrder = 2
OnClick = btnCloseClick
end
object btnHints: TButton
@@ -211,19 +194,16 @@ object MainForm: TMainForm
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Generate blank &Hints file'
- TabOrder = 2
+ TabOrder = 1
OnClick = btnHintsClick
end
- object DefaultEditStyle: TcxDefaultEditStyleController
- Style.HotTrack = False
- Left = 264
- Top = 60
- PixelsPerInch = 96
- end
- object LookAndFeel: TcxLookAndFeelController
- Kind = lfFlat
- Left = 368
- Top = 60
+ object feSchema: TJvFilenameEdit
+ Left = 104
+ Top = 8
+ Width = 316
+ Height = 21
+ TabOrder = 4
+ Text = 'feSchema'
end
object dlgSchema: TOpenDialog
Filter = 'W3C XML Schema files (*.xsd)|*.xsd|All files (*.*)|*.*'
diff --git a/Forms/MainFrm.pas b/Forms/MainFrm.pas
index b902384..b45d313 100644
--- a/Forms/MainFrm.pas
+++ b/Forms/MainFrm.pas
@@ -13,7 +13,9 @@ uses
StdCtrls,
XMLDOM,
XMLIntf,
-
+ DataBindingHintsXML,
+ XMLDataBindingGenerator, JvExMask, JvToolEdit
+ {
cxButtonEdit,
cxContainer,
cxControls,
@@ -22,8 +24,8 @@ uses
cxMaskEdit,
cxTextEdit,
- DataBindingHintsXML,
- XMLDataBindingGenerator, cxGraphics, cxLookAndFeelPainters, cxClasses;
+ cxGraphics, cxLookAndFeelPainters, cxClasses}
+ ;
type
@@ -31,21 +33,14 @@ type
btnClose: TButton;
btnGenerate: TButton;
btnHints: TButton;
- DefaultEditStyle: TcxDefaultEditStyleController;
- deFolder: TcxButtonEdit;
dlgOutputFile: TSaveDialog;
dlgSchema: TOpenDialog;
- edtFolderPostfix: TcxTextEdit;
- edtFolderPrefix: TcxTextEdit;
- feFile: TcxButtonEdit;
- feSchema: TcxButtonEdit;
gbOutput: TGroupBox;
lblFile: TLabel;
lblFolder: TLabel;
lblFolderPostfix: TLabel;
lblFolderPrefix: TLabel;
lblSchema: TLabel;
- LookAndFeel: TcxLookAndFeelController;
plOutput: TPageControl;
rbFile: TRadioButton;
rbFolder: TRadioButton;
@@ -53,6 +48,12 @@ type
spFolder: TTabSheet;
cbHasChecksEmpty: TCheckBox;
cbGenerateGetOptionalOrDefault: TCheckBox;
+ edtFolderPrefix: TEdit;
+ edtFolderPostfix: TEdit;
+ feFile: TEdit;
+ deFolder: TEdit;
+ feSchema: TJvFilenameEdit;
+ BrowseOutputFolderButton: TButton;
procedure btnCloseClick(Sender: TObject);
procedure btnGenerateClick(Sender: TObject);
diff --git a/X2XMLDataBinding.dproj b/X2XMLDataBinding.dproj
index cd277d4..081bb05 100644
--- a/X2XMLDataBinding.dproj
+++ b/X2XMLDataBinding.dproj
@@ -52,6 +52,7 @@
1043
$(BDS)\bin\default_app.manifest
X2XMLDataBinding
+ ..\x2utils;..\x2log;$(DCC_UnitSearchPath)
Data.Win;Datasnap.Win;Web.Win;Soap.Win;Bde;$(DCC_Namespace)
@@ -133,8 +134,8 @@
- Microsoft Office 2000 Sample Automation Server Wrapper Components
- Microsoft Office XP Sample Automation Server Wrapper Components
+ Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver
+ Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server
From 6d0265862d1fc2fbf22c879a34e5b863161a0e5a Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Fri, 30 Oct 2020 08:47:54 +0100
Subject: [PATCH 2/6] =?UTF-8?q?Fix=20TargetNamespace=20bei=20Collection=20?=
=?UTF-8?q?Items=20(behebt=20Fehler=20"Interface=20nicht=20unterst=C3=BCtz?=
=?UTF-8?q?t")?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
Units/DelphiXMLDataBindingGenerator.pas | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas
index c570eae..d8ff615 100644
--- a/Units/DelphiXMLDataBindingGenerator.pas
+++ b/Units/DelphiXMLDataBindingGenerator.pas
@@ -814,12 +814,13 @@ begin
'ItemClass', GetDataTypeName(propertyItem, False)]);
end;
- AWriter.WriteLineNamedFmt(' %:s := CreateCollection(%:s, %:s, ''%:s'') as %:s;',
+ AWriter.WriteLineNamedFmt(' %:s := CreateCollection(%:s, %:s, ''%:s'', ''%:s'') as %:s;',
['FieldName', PrefixField + propertyItem.TranslatedName,
'CollectionClass', PrefixClass + propertyItem.Collection.TranslatedName,
'CollectionInterface', PrefixInterface + propertyItem.Collection.TranslatedName,
'ItemInterface', GetDataTypeName(propertyItem, True),
- 'ItemSourceName', propertyItem.Name]);
+ 'ItemSourceName', propertyItem.Name,
+ 'Namespace', propertyItem.TargetNamespace]);
end;
end;
From 5e1fa91e85abf1ef5a4aa70138a67136adb4f992 Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Mon, 2 Nov 2020 09:34:03 +0100
Subject: [PATCH 3/6] Various Bugfixes for Filename Input
---
Forms/MainFrm.dfm | 36 +++++++++++++++++++++---------------
Forms/MainFrm.pas | 26 +++++++++++++++++---------
2 files changed, 38 insertions(+), 24 deletions(-)
diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm
index d859bea..adf8064 100644
--- a/Forms/MainFrm.dfm
+++ b/Forms/MainFrm.dfm
@@ -69,6 +69,9 @@ object MainForm: TMainForm
TabOrder = 2
object spFile: TTabSheet
TabVisible = False
+ DesignSize = (
+ 408
+ 83)
object lblFile: TLabel
Left = 4
Top = 7
@@ -76,13 +79,15 @@ object MainForm: TMainForm
Height = 13
Caption = 'Output file:'
end
- object feFile: TEdit
- Left = 76
+ object feFile: TJvFilenameEdit
+ Left = 89
Top = 3
Width = 316
Height = 21
+ DialogOptions = [ofHideReadOnly, ofCreatePrompt]
+ Anchors = [akLeft, akTop, akRight]
TabOrder = 0
- Text = 'D:\Temp\test.pas'
+ Text = ''
end
end
object spFolder: TTabSheet
@@ -114,7 +119,6 @@ object MainForm: TMainForm
Width = 316
Height = 21
TabOrder = 0
- Text = 'Edit1'
end
object edtFolderPostfix: TEdit
Left = 89
@@ -122,22 +126,22 @@ object MainForm: TMainForm
Width = 316
Height = 21
TabOrder = 1
- Text = 'Edit1'
end
object deFolder: TEdit
Left = 89
Top = 4
- Width = 256
+ Width = 245
Height = 21
TabOrder = 2
end
- object BrowseOutputFolderButton: TButton
- Left = 351
- Top = 4
- Width = 64
+ object deFolderPropertiesButton: TButton
+ Left = 340
+ Top = 3
+ Width = 65
Height = 22
- Caption = 'BrowseOutputFolderButton'
+ Caption = 'Properties'
TabOrder = 3
+ OnClick = deFolderPropertiesButtonClick
end
end
end
@@ -202,19 +206,21 @@ object MainForm: TMainForm
Top = 8
Width = 316
Height = 21
+ OnAfterDialog = feSchemaAfterDialog
+ DialogOptions = [ofHideReadOnly, ofFileMustExist]
TabOrder = 4
- Text = 'feSchema'
+ Text = ''
end
object dlgSchema: TOpenDialog
Filter = 'W3C XML Schema files (*.xsd)|*.xsd|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
- Left = 212
+ Left = 284
Top = 40
end
object dlgOutputFile: TSaveDialog
Filter = 'Delphi source files (*.pas)|*.pas|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing]
- Left = 323
- Top = 45
+ Left = 387
+ Top = 37
end
end
diff --git a/Forms/MainFrm.pas b/Forms/MainFrm.pas
index b45d313..5bbfecc 100644
--- a/Forms/MainFrm.pas
+++ b/Forms/MainFrm.pas
@@ -50,20 +50,22 @@ type
cbGenerateGetOptionalOrDefault: TCheckBox;
edtFolderPrefix: TEdit;
edtFolderPostfix: TEdit;
- feFile: TEdit;
deFolder: TEdit;
feSchema: TJvFilenameEdit;
- BrowseOutputFolderButton: TButton;
+ deFolderPropertiesButton: TButton;
+ feFile: TJvFilenameEdit;
procedure btnCloseClick(Sender: TObject);
procedure btnGenerateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OutputTypeClick(Sender: TObject);
procedure feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
- procedure deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
+ procedure deFolderPropertiesButtonClick(Sender: TObject);
procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesChange(Sender: TObject);
procedure btnHintsClick(Sender: TObject);
+ procedure feSchemaAfterDialog(Sender: TObject; var AName: string;
+ var AAction: Boolean);
private
function CheckValidSchemaFile: Boolean;
function CheckReadOnly(const AFileName: String): Boolean;
@@ -174,11 +176,11 @@ begin
if rbFile.Checked then
begin
- if not CheckReadOnly(feFile.Text) then
+ if not CheckReadOnly(feFile.FileName) then
Exit;
generator.OutputType := otSingle;
- generator.OutputPath := feFile.Text;
+ generator.OutputPath := feFile.FileName;
end else if rbFolder.Checked then
begin
generator.OutputType := otMultiple;
@@ -188,9 +190,9 @@ begin
generator.HasChecksEmpty := cbHasChecksEmpty.Checked;
generator.HasGenerateGetOptionalOrDefault := cbGenerateGetOptionalOrDefault.Checked;
generator.OnGetFileName := GetFileName;
- generator.Execute(feSchema.Text);
+ generator.Execute(feSchema.Filename);
- SaveSettings(feSchema.Text);
+ SaveSettings(feSchema.FileName);
ShowMessage('The data binding has been generated.');
finally
@@ -223,7 +225,7 @@ begin
end;
-procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
+procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject);
var
directory: String;
@@ -233,6 +235,12 @@ begin
end;
+procedure TMainForm.feSchemaAfterDialog(Sender: TObject; var AName: string;
+ var AAction: Boolean);
+begin
+ feFile.FileName := ChangeFileExt(AName, '.pas');
+end;
+
procedure TMainForm.feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
if dlgSchema.Execute then
@@ -331,7 +339,7 @@ end;
function TMainForm.CheckValidSchemaFile: Boolean;
begin
- Result := FileExists(feSchema.Text);
+ Result := FileExists(feSchema.FileName);
if not Result then
begin
From ede9c973464333e47270ed011a10f5dcc5f75722 Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Mon, 2 Nov 2020 10:09:20 +0100
Subject: [PATCH 4/6] delete XMLDataBindingUtils since it used togaether in
x2utils as searchpath
---
Shared/XMLDataBindingUtils.pas | 908 ---------------------------------
1 file changed, 908 deletions(-)
delete mode 100644 Shared/XMLDataBindingUtils.pas
diff --git a/Shared/XMLDataBindingUtils.pas b/Shared/XMLDataBindingUtils.pas
deleted file mode 100644
index 2b0d80d..0000000
--- a/Shared/XMLDataBindingUtils.pas
+++ /dev/null
@@ -1,908 +0,0 @@
-{
- Helpers functions for the X2Software XML Data Binding
-
- Last changed: $Date$
- Revision: $Rev$
- URL: $URL$
-}
-unit XMLDataBindingUtils;
-
-interface
-uses
- Classes,
- SysUtils,
- XMLDoc,
- xmldom,
- XMLIntf;
-
-
-type
- EBase64Error = class(Exception);
-
- TXMLDateTimeFormat = (xdtDateTime, xdtDate, xdtTime);
- TXMLTimeFragment = (xtfMilliseconds, xtfTimezone);
- TXMLTimeFragments = set of TXMLTimeFragment;
-
-
- IXSDValidate = interface
- ['{3BFDC851-7459-403B-87B3-A52E9E85BC8C}']
- procedure XSDValidate;
- end;
-
-
- TX2XMLNode = class(TXMLNode)
- private
- function GetChildNodesNS(const ANodeName, ANamespaceURI: DOMString): IXMLNode;
- protected
- property ChildNodesNS[const ANodeName, ANamespaceURI: DOMString]: IXMLNode read GetChildNodesNS;
- end;
-
-
- TX2XMLNodeCollection = class(TXMLNodeCollection)
- private
- function GetChildNodesNS(const ANodeName, ANamespaceURI: DOMString): IXMLNode;
- protected
- property ChildNodesNS[const ANodeName, ANamespaceURI: DOMString]: IXMLNode read GetChildNodesNS;
- end;
-
-
- TXMLNodeCollectionEnumerator = class(TInterfacedObject)
- private
- FNodeCollection: IXMLNodeCollection;
- FIndex: Integer;
- public
- constructor Create(ANodeCollection: IXMLNodeCollection);
-
- function GetCurrent: IXMLNode;
- function MoveNext: Boolean; virtual;
-
- property Current: IXMLNode read GetCurrent;
- end;
-
-
-
-const
- AllTimeFragments = [Low(TXMLTimeFragment)..High(TXMLTimeFragment)];
-
-
-
- function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments = AllTimeFragments): string;
- function XMLToDateTime(const ADate: string; AFormat: TXMLDateTimeFormat): TDateTime;
-
- function BoolToXML(AValue: Boolean): WideString;
- function XMLToBool(const AValue: WideString): Boolean;
-
- function FloatToXML(AValue: Extended): WideString;
- function XMLToFloat(const AValue: WideString): Extended;
-
- function GetNodeIsNil(ANode: IXMLNode): Boolean;
- procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
-
- procedure XSDValidate(AParent: IXMLNode; ARecurse: Boolean = True; AValidateParent: Boolean = True);
- procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string);
- procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string);
- procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string);
-
-
- { Now wraps the JclMime implementation:
- Lightening fast Mime (Base64) Encoding and Decoding routines.
- Coded by Ralf Junker (ralfjunker@gmx.de).}
- function Base64Encode(AValue: String): String;
- function Base64Decode(AValue: String): String;
- procedure Base64DecodeToStream(AValue: String; AStream: TStream);
- procedure Base64DecodeToFile(AValue: String; const AFileName: String);
-
-const
- XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
-
- XMLDateFormat = 'yyyy"-"mm"-"dd';
- XMLTimeFormat = 'hh":"nn":"ss';
- XMLMsecsFormat = '"."zzz';
- XMLTimezoneZulu = 'Z';
- XMLTimezoneFormat = '%s%.2d:%.2d';
-
- XMLDateTimeFormats: array[TXMLDateTimeFormat] of String =
- (
- XMLDateFormat + '"T"' + XMLTimeFormat,
- XMLDateFormat,
- XMLTimeFormat
- );
-
- XMLTimezoneSigns: array[Boolean] of Char = ('-', '+');
- XMLBoolValues: array[Boolean] of String =
- (
- 'false',
- 'true'
- );
-
- XMLIsNilAttribute = 'nil';
- XMLIsNilAttributeNS = 'xsi:nil';
-
- Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'];
- Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
- 'abcdefghijklmnopqrstuvwxyz' +
- '0123456789+/';
- Base64Padding = '=';
-
-
-implementation
-uses
- DateUtils,
- Math,
- Types,
- Windows;
-
-
-type
- PSortNodeInfo = ^TSortNodeInfo;
- TSortNodeInfo = record
- Node: IXMLNode;
- SortIndex: Integer;
- OriginalIndex: Integer;
- end;
-
-
- function MimeEncodeString(const S: AnsiString): AnsiString; forward;
- function MimeDecodeString(const S: AnsiString): AnsiString; forward;
- procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); forward;
- procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); forward;
- function MimeEncodedSize(const I: Cardinal): Cardinal; forward;
- function MimeDecodedSize(const I: Cardinal): Cardinal; forward;
- procedure MimeEncode(var InputBuffer; const InputByteCount: Cardinal; var OutputBuffer); forward;
- function MimeDecode(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer): Cardinal; forward;
- function MimeDecodePartial(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; forward;
- function MimeDecodePartialEnd(var OutputBuffer; const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; forward;
-
-
-
-{ TX2XMLNode }
-function TX2XMLNode.GetChildNodesNS(const ANodeName, ANamespaceURI: DOMString): IXMLNode;
-begin
- Result := ChildNodes.FindNode(ANodeName, ANamespaceURI);
- if (not Assigned(Result)) and (doNodeAutoCreate in OwnerDocument.Options) then
- Result := AddChild(ANodeName, ANamespaceURI);
-end;
-
-
-
-{ TX2XMLNodeCollection }
-function TX2XMLNodeCollection.GetChildNodesNS(const ANodeName, ANamespaceURI: DOMString): IXMLNode;
-begin
- Result := ChildNodes.FindNode(ANodeName, ANamespaceURI);
- if (not Assigned(Result)) and (doNodeAutoCreate in OwnerDocument.Options) then
- Result := AddChild(ANodeName, ANamespaceURI);
-end;
-
-
-
-{ TXMLNodeCollectionEnumerator }
-constructor TXMLNodeCollectionEnumerator.Create(ANodeCollection: IXMLNodeCollection);
-begin
- inherited Create;
-
- FNodeCollection := ANodeCollection;
- FIndex := -1;
-end;
-
-
-function TXMLNodeCollectionEnumerator.GetCurrent: IXMLNode;
-begin
- if (FIndex >= 0) and (FIndex < FNodeCollection.Count) then
- Result := FNodeCollection.Nodes[FIndex]
- else
- Result := nil;
-end;
-
-
-function TXMLNodeCollectionEnumerator.MoveNext: Boolean;
-begin
- Inc(FIndex);
- Result := (FIndex < FNodeCollection.Count);
-end;
-
-
-
-function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments): string;
-var
- formatSettings: TFormatSettings;
- timeZone: TTimeZoneInformation;
- timeOffset: Integer;
-
-begin
- GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, formatSettings);
- Result := FormatDateTime(XMLDateTimeFormats[AFormat], ADate, formatSettings);
-
- if AFormat in [xdtDateTime, xdtTime] then
- begin
- if xtfMilliseconds in ATimeFragments then
- Result := Result + FormatDateTime(XMLMsecsFormat, ADate);
-
- if xtfTimezone in ATimeFragments then
- begin
- FillChar(timeZone, SizeOf(TTimeZoneInformation), #0);
- if GetTimeZoneInformation(timeZone) <> TIME_ZONE_ID_INVALID then
- begin
- timeOffset := -timeZone.Bias;
-
- if timeOffset = 0 then
- Result := Result + XMLTimezoneZulu
- else
- Result := Result + Format(XMLTimezoneFormat,
- [XMLTimezoneSigns[timeOffset > 0],
- Abs(timeZone.Bias div 60),
- Abs(timeZone.Bias mod 60)]);
- end;
- end;
- end;
-end;
-
-
-function XMLToDateTime(const ADate: string; AFormat: TXMLDateTimeFormat): TDateTime;
-const
- { yyyy-mm-ddThh:nn:ss.zzz+xx:xx }
- XMLTimeSeparatorPos = 11;
- XMLTimeSeparator = 'T';
- XMLMinTimeLength = 8;
-
-var
- date: string;
- time: string;
- year: Integer;
- month: Integer;
- day: Integer;
- hour: Integer;
- minute: Integer;
- second: Integer;
- msec: Integer;
- hasTimezone: Boolean;
- xmlOffset: Integer;
- timeZone: TTimeZoneInformation;
- localOffset: Integer;
-
-begin
- Result := 0;
- date := '';
- time := '';
-
- case AFormat of
- xdtDateTime:
- begin
- if (Length(ADate) < XMLTimeSeparatorPos) or
- (ADate[XMLTimeSeparatorPos] <> XMLTimeSeparator) then
- Exit;
-
- date := ADate;
- time := ADate;
- SetLength(date, Pred(XMLTimeSeparatorPos));
- Delete(time, 1, XMLTimeSeparatorPos);
- end;
-
- xdtDate:
- begin
- if Length(ADate) < Pred(XMLTimeSeparatorPos) then
- Exit;
-
- date := ADate;
- end;
-
- xdtTime:
- begin
- if Length(ADate) < XMLMinTimeLength then
- Exit;
-
- time := ADate;
- end;
- end;
-
- if AFormat in [xdtDateTime, xdtDate] then
- begin
- { Parse date (yyyy-mm-hh) }
- if TryStrToInt(Copy(date, 1, 4), year) and
- TryStrToInt(Copy(date, 6, 2), month) and
- TryStrToInt(Copy(date, 9, 2), day) then
- Result := EncodeDate(year, month, day);
- end;
-
- if AFormat in [xdtDateTime, xdtTime] then
- begin
- { Parse time (hh:nn:ss) }
- if TryStrToInt(Copy(time, 1, 2), hour) and
- TryStrToInt(Copy(time, 4, 2), minute) and
- TryStrToInt(Copy(time, 7, 2), second) then
- begin
- msec := 0;
- Delete(time, 1, 8);
-
- if Length(time) > 0 then
- begin
- if time[1] = '.' then
- begin
- { Parse milliseconds (.zzz) }
- if not TryStrToInt(Copy(time, 2, 3), msec) then
- msec := 0;
-
- Delete(time, 1, 4);
- end;
- end;
-
- Result := Result + EncodeTime(hour, minute, second, msec);
-
- if Length(time) > 0 then
- begin
- hasTimezone := False;
- xmlOffset := 0;
-
- if time[1] = XMLTimezoneZulu then
- begin
- { Zulu time }
- hasTimezone := True;
- end else if time[1] in [XMLTimezoneSigns[False], XMLTimezoneSigns[True]] then
- begin
- { Parse timezone ([+|-]xx:xx) }
- if TryStrToInt(Copy(time, 2, 2), hour) and
- TryStrToInt(Copy(time, 5, 2), minute) then
- begin
- xmlOffset := (hour * MinsPerHour) + minute;
- hasTimezone := True;
-
- if time[1] = XMLTimezoneSigns[False] then
- xmlOffset := -xmlOffset;
- end;
- end;
-
- if hasTimezone then
- begin
- FillChar(timeZone, SizeOf(TTimeZoneInformation), #0);
- if GetTimeZoneInformation(timeZone) <> TIME_ZONE_ID_INVALID then
- begin
- localOffset := -timeZone.Bias;
- Result := IncMinute(Result, localOffset - xmlOffset);
- end;
- end;
- end;
- end;
- end;
-end;
-
-
-function BoolToXML(AValue: Boolean): WideString;
-begin
- Result := XMLBoolValues[AValue];
-end;
-
-
-function XMLToBool(const AValue: WideString): Boolean;
-begin
- Result := StrToBoolDef(AValue, False);
-end;
-
-
-function GetXMLFloatFormatSettings(): TFormatSettings;
-begin
- Result.DecimalSeparator := '.';
-end;
-
-
-function FloatToXML(AValue: Extended): WideString;
-begin
- Result := FloatToStr(AValue, GetXMLFloatFormatSettings());
-end;
-
-
-function XMLToFloat(const AValue: WideString): Extended;
-begin
- Result := StrToFloat(AValue, GetXMLFloatFormatSettings());
-end;
-
-
-function Base64Encode(AValue: String): String;
-begin
- Result := MimeEncodeString(AValue);
-end;
-
-
-function Base64Decode(AValue: String): String;
-begin
- Result := MimeDecodeString(AValue);
-end;
-
-
-procedure Base64DecodeToStream(AValue: String; AStream: TStream);
-var
- input: TStringStream;
-
-begin
- input := TStringStream.Create(AValue);
- try
- MimeDecodeStream(input, AStream);
- finally
- FreeAndNil(input);
- end;
-end;
-
-
-procedure Base64DecodeToFile(AValue: String; const AFileName: String);
-var
- input: TStringStream;
- output: TFileStream;
-
-begin
- input := TStringStream.Create(AValue);
- try
- output := TFileStream.Create(AFileName, fmCreate or fmShareDenyWrite);
- try
- MimeDecodeStream(input, output);
- finally
- FreeAndNil(output);
- end;
- finally
- FreeAndNil(input);
- end;
-end;
-
-
-function GetNodeIsNil(ANode: IXMLNode): Boolean;
-begin
- Result := ANode.HasAttribute(XMLIsNilAttribute, XMLSchemaInstanceURI) and
- XMLToBool(ANode.GetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI));
-end;
-
-
-procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
-var
- documentElement: IXMLNode;
-
-begin
- if ASetNil then
- begin
- ANode.ChildNodes.Clear;
-
- documentElement := ANode.OwnerDocument.DocumentElement;
- if not documentElement.HasAttribute('xmlns:xsi') then
- documentElement.SetAttributeNS('xmlns:xsi', '', XMLSchemaInstanceURI);
-
- ANode.SetAttributeNS(XMLIsNilAttributeNS, XMLSchemaInstanceURI, BoolToXML(True));
- end else
- ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI);
-end;
-
-
-function DoSortNodes(Item1, Item2: Pointer): Integer;
-var
- nodeInfo1: PSortNodeInfo;
- nodeInfo2: PSortNodeInfo;
-
-begin
- nodeInfo1 := Item1;
- nodeInfo2 := Item2;
-
- if (nodeInfo1^.SortIndex > -1) and (nodeInfo2^.SortIndex = -1) then
- Result := GreaterThanValue
-
- else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then
- Result := LessThanValue
-
- else if (nodeInfo1^.SortIndex = nodeInfo2^.SortIndex) then
- Result := CompareValue(nodeInfo1^.OriginalIndex, nodeInfo2^.OriginalIndex)
-
- else
- Result := CompareValue(nodeInfo1^.SortIndex, nodeInfo2^.SortIndex);
-end;
-
-
-procedure XSDValidate(AParent: IXMLNode; ARecurse, AValidateParent: Boolean);
-var
- validate: IXSDValidate;
- childIndex: Integer;
-
-begin
- if AValidateParent and Supports(AParent, IXSDValidate, validate) then
- validate.XSDValidate;
-
- if ARecurse then
- begin
- for childIndex := 0 to Pred(AParent.ChildNodes.Count) do
- XSDValidate(AParent.ChildNodes[childIndex], ARecurse, True);
- end;
-end;
-
-
-procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string);
-var
- nodeIndex: Integer;
- node: IXMLNode;
-
-begin
- for nodeIndex := Low(ANodes) to High(ANodes) do
- begin
- if not Assigned(AParent.ChildNodes.FindNode(ANodes[nodeIndex])) then
- begin
- node := AParent.OwnerDocument.CreateElement(ANodes[nodeIndex], AParent.NamespaceURI);
- AParent.ChildNodes.Add(node);
- end;
- end;
-end;
-
-
-procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string);
-var
- nodeIndex: Integer;
-
-begin
- for nodeIndex := Low(ANodes) to High(ANodes) do
- begin
- if not Assigned(AParent.AttributeNodes.FindNode(ANodes[nodeIndex])) then
- AParent.Attributes[ANodes[nodeIndex]] := '';
- end;
-end;
-
-
-procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string);
-var
- sortList: TList;
- nodeInfo: PSortNodeInfo;
- childIndex: Integer;
- sortIndex: Integer;
- node: IXMLNode;
-
-begin
- sortList := TList.Create;
- try
- { Build a list of the child nodes, with their original index and the
- index in the ASortOrder array. }
- for childIndex := 0 to Pred(AParent.ChildNodes.Count) do
- begin
- New(nodeInfo);
- nodeInfo^.Node := AParent.ChildNodes[childIndex];
- nodeInfo^.OriginalIndex := childIndex;
-
- for sortIndex := Low(ASortOrder) to High(ASortOrder) do
- begin
- if ASortOrder[sortIndex] = nodeInfo^.Node.NodeName then
- begin
- nodeInfo^.SortIndex := sortIndex;
- Break;
- end;
- end;
-
- sortList.Add(nodeInfo);
- end;
-
- sortList.Sort(DoSortNodes);
-
- { Rebuild the ChildNodes list }
- for childIndex := 0 to Pred(sortList.Count) do
- begin
- node := PSortNodeInfo(sortList[childIndex])^.Node;
-
- AParent.ChildNodes.Remove(node);
- AParent.ChildNodes.Insert(childIndex, node);
- end;
- finally
- for sortIndex := 0 to Pred(sortList.Count) do
- Dispose(PSortNodeInfo(sortList[sortIndex]));
-
- FreeAndNil(sortList);
- end;
-end;
-
-
-{ --- JclMime implementation from here. }
-// Caution: For MimeEncodeStream and all other kinds of multi-buffered
-// Mime encodings (i.e. Files etc.), BufferSize must be set to a multiple of 3.
-// Even though the implementation of the Mime decoding routines below
-// do not require a particular buffer size, they work fastest with sizes of
-// multiples of four. The chosen size is a multiple of 3 and of 4 as well.
-// The following numbers are, in addition, also divisible by 1024:
-// $2400, $3000, $3C00, $4800, $5400, $6000, $6C00.
-
-const
- BUFFER_SIZE = $3000;
- EqualSign = Byte('=');
-
- MIME_ENCODE_TABLE: array [0..63] of Byte = (
- 65, 66, 67, 68, 69, 70, 71, 72, // 00 - 07
- 73, 74, 75, 76, 77, 78, 79, 80, // 08 - 15
- 81, 82, 83, 84, 85, 86, 87, 88, // 16 - 23
- 89, 90, 97, 98, 99, 100, 101, 102, // 24 - 31
- 103, 104, 105, 106, 107, 108, 109, 110, // 32 - 39
- 111, 112, 113, 114, 115, 116, 117, 118, // 40 - 47
- 119, 120, 121, 122, 48, 49, 50, 51, // 48 - 55
- 52, 53, 54, 55, 56, 57, 43, 47); // 56 - 63
-
- MIME_DECODE_TABLE: array [Byte] of Cardinal = (
- 255, 255, 255, 255, 255, 255, 255, 255, // 00 - 07
- 255, 255, 255, 255, 255, 255, 255, 255, // 08 - 15
- 255, 255, 255, 255, 255, 255, 255, 255, // 16 - 23
- 255, 255, 255, 255, 255, 255, 255, 255, // 24 - 31
- 255, 255, 255, 255, 255, 255, 255, 255, // 32 - 39
- 255, 255, 255, 62, 255, 255, 255, 63, // 40 - 47
- 52, 53, 54, 55, 56, 57, 58, 59, // 48 - 55
- 60, 61, 255, 255, 255, 255, 255, 255, // 56 - 63
- 255, 0, 1, 2, 3, 4, 5, 6, // 64 - 71
- 7, 8, 9, 10, 11, 12, 13, 14, // 72 - 79
- 15, 16, 17, 18, 19, 20, 21, 22, // 80 - 87
- 23, 24, 25, 255, 255, 255, 255, 255, // 88 - 95
- 255, 26, 27, 28, 29, 30, 31, 32, // 96 - 103
- 33, 34, 35, 36, 37, 38, 39, 40, // 104 - 111
- 41, 42, 43, 44, 45, 46, 47, 48, // 112 - 119
- 49, 50, 51, 255, 255, 255, 255, 255, // 120 - 127
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255,
- 255, 255, 255, 255, 255, 255, 255, 255);
-
-type
- PByte4 = ^TByte4;
- TByte4 = packed record
- B1: Byte;
- B2: Byte;
- B3: Byte;
- B4: Byte;
- end;
-
- PByte3 = ^TByte3;
- TByte3 = packed record
- B1: Byte;
- B2: Byte;
- B3: Byte;
- end;
-
-
-//------------------------------------------------------------------------------
-// Wrapper functions & procedures
-//------------------------------------------------------------------------------
-
-function MimeEncodeString(const S: AnsiString): AnsiString;
-var
- L: Cardinal;
-begin
- L := Length(S);
- if L > 0 then
- begin
- SetLength(Result, MimeEncodedSize(L));
- MimeEncode(PChar(S)^, L, PChar(Result)^);
- end
- else
- Result := '';
-end;
-
-//------------------------------------------------------------------------------
-
-function MimeDecodeString(const S: AnsiString): AnsiString;
-var
- ByteBuffer, ByteBufferSpace: Cardinal;
- L: Cardinal;
-begin
- L := Length(S);
- if L > 0 then
- begin
- SetLength(Result, MimeDecodedSize(L));
- ByteBuffer := 0;
- ByteBufferSpace := 4;
- L := MimeDecodePartial(PChar(S)^, L, PChar(Result)^, ByteBuffer, ByteBufferSpace);
- Inc(L, MimeDecodePartialEnd(PChar(Cardinal(Result) + L)^, ByteBuffer, ByteBufferSpace));
- SetLength(Result, L);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream);
-var
- InputBuffer: array [0..BUFFER_SIZE - 1] of Byte;
- OutputBuffer: array [0..((BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte;
- BytesRead: Integer;
-begin
- BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
- while BytesRead > 0 do
- begin
- MimeEncode(InputBuffer, BytesRead, OutputBuffer);
- OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead));
- BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream);
-var
- ByteBuffer, ByteBufferSpace: Cardinal;
- InputBuffer: array [0..(BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte;
- OutputBuffer: array [0..BUFFER_SIZE - 1] of Byte;
- BytesRead: Integer;
-begin
- ByteBuffer := 0;
- ByteBufferSpace := 4;
- BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
- while BytesRead > 0 do
- begin
- OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead, OutputBuffer, ByteBuffer, ByteBufferSpace));
- BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
- end;
- OutputStream.Write(OutputBuffer, MimeDecodePartialEnd(OutputBuffer, ByteBuffer, ByteBufferSpace));
-end;
-
-//------------------------------------------------------------------------------
-// Helper functions
-//------------------------------------------------------------------------------
-
-function MimeEncodedSize(const I: Cardinal): Cardinal;
-begin
- Result := (I + 2) div 3 * 4;
-end;
-
-//------------------------------------------------------------------------------
-
-function MimeDecodedSize(const I: Cardinal): Cardinal;
-begin
- Result := (I + 3) div 4 * 3;
-end;
-
-//------------------------------------------------------------------------------
-// Primary functions & procedures
-//------------------------------------------------------------------------------
-
-procedure MimeEncode(var InputBuffer; const InputByteCount: Cardinal; var OutputBuffer);
-var
- B: Cardinal;
- InMax3: Cardinal;
- InPtr, InLimitPtr: ^Byte;
- OutPtr: PByte4;
-begin
- if InputByteCount <= 0 then
- Exit;
-
- InPtr := @InputBuffer;
- InMax3 := InputByteCount div 3 * 3;
- OutPTr := @OutputBuffer;
- Cardinal(InLimitPtr) := Cardinal(InPtr) + InMax3;
-
- while InPtr <> InLimitPtr do
- begin
- B := InPtr^;
- B := B shl 8;
- Inc(InPtr);
- B := B or InPtr^;
- B := B shl 8;
- Inc(InPtr);
- B := B or InPtr^;
- Inc(InPtr);
- // Write 4 bytes to OutputBuffer (in reverse order).
- OutPtr.B4 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPtr.B3 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPtr.B1 := MIME_ENCODE_TABLE[B];
- Inc(OutPtr);
- end;
-
- case InputByteCount - InMax3 of
- 1:
- begin
- B := InPtr^;
- B := B shl 4;
- OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPtr.B1 := MIME_ENCODE_TABLE[B];
- OutPtr.B3 := EqualSign; // Fill remaining 2 bytes.
- OutPtr.B4 := EqualSign;
- end;
- 2:
- begin
- B := InPtr^;
- Inc(InPtr);
- B := B shl 8;
- B := B or InPtr^;
- B := B shl 2;
- OutPtr.B3 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPTr.b2 := MIME_ENCODE_TABLE[B and $3F];
- B := B shr 6;
- OutPtr.B1 := MIME_ENCODE_TABLE[B];
- OutPtr.B4 := EqualSign; // Fill remaining byte.
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function MimeDecode(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer): Cardinal;
-var
- ByteBuffer, ByteBufferSpace: Cardinal;
-begin
- ByteBuffer := 0;
- ByteBufferSpace := 4;
- Result := MimeDecodePartial(InputBuffer, InputBytesCount, OutputBuffer, ByteBuffer, ByteBufferSpace);
- Inc(Result, MimeDecodePartialEnd(PChar(Cardinal(OutputBuffer) + Result)^, ByteBuffer, ByteBufferSpace));
-end;
-
-//------------------------------------------------------------------------------
-
-function MimeDecodePartial(var InputBuffer; const InputBytesCount: Cardinal;
- var OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
-var
- lByteBuffer, lByteBufferSpace, C: Cardinal;
- InPtr, InLimitPtr: ^Byte;
- OutPtr: PByte3;
-begin
- if InputBytesCount > 0 then
- begin
- InPtr := @InputBuffer;
- Cardinal(InLimitPtr) := Cardinal(InPtr) + InputBytesCount;
- OutPtr := @OutputBuffer;
- lByteBuffer := ByteBuffer;
- lByteBufferSpace := ByteBufferSpace;
- while InPtr <> InLimitPtr do
- begin
- C := MIME_DECODE_TABLE[InPtr^]; // Read from InputBuffer.
- Inc(InPtr);
- if C = $FF then
- Continue;
-
- lByteBuffer := lByteBuffer shl 6;
- lByteBuffer := lByteBuffer or C;
- Dec(lByteBufferSpace);
- if lByteBufferSpace <> 0 then
- Continue; // Read 4 bytes from InputBuffer?
-
- OutPtr.B3 := Byte(lByteBuffer); // Write 3 bytes to OutputBuffer (in reverse order).
- lByteBuffer := lByteBuffer shr 8;
- OutPtr.B2 := Byte(lByteBuffer);
- lByteBuffer := lByteBuffer shr 8;
- OutPtr.B1 := Byte(lByteBuffer);
- lByteBuffer := 0;
- Inc(OutPtr);
- lByteBufferSpace := 4;
- end;
- ByteBuffer := lByteBuffer;
- ByteBufferSpace := lByteBufferSpace;
- Result := Cardinal(OutPtr) - Cardinal(@OutputBuffer);
- end
- else
- Result := 0;
-end;
-
-//------------------------------------------------------------------------------
-
-function MimeDecodePartialEnd(var OutputBuffer; const ByteBuffer: Cardinal;
- const ByteBufferSpace: Cardinal): Cardinal;
-var
- lByteBuffer: Cardinal;
-begin
- case ByteBufferSpace of
- 1:
- begin
- lByteBuffer := ByteBuffer shr 2;
- PByte3(@OutputBuffer).B2 := Byte(lByteBuffer);
- lByteBuffer := lByteBuffer shr 8;
- PByte3(@OutputBuffer).B1 := Byte(lByteBuffer);
- Result := 2;
- end;
- 2:
- begin
- lByteBuffer := ByteBuffer shr 4;
- PByte3(@OutputBuffer).B1 := Byte(lByteBuffer);
- Result := 1;
- end;
- else
- Result := 0;
- end;
-end;
-
-end.
-
From 96eeb95d17203acf06dbfabeabcc9af33dadece4 Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Tue, 3 Nov 2020 17:11:34 +0100
Subject: [PATCH 5/6] XML Validation: CreateRequiredElements with correct
namespaces
---
Units/DelphiXMLDataBindingGenerator.pas | 12 +++++++++---
Units/DelphiXMLDataBindingResources.pas | 2 +-
2 files changed, 10 insertions(+), 4 deletions(-)
diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas
index d8ff615..2027b33 100644
--- a/Units/DelphiXMLDataBindingGenerator.pas
+++ b/Units/DelphiXMLDataBindingGenerator.pas
@@ -1579,7 +1579,9 @@ var
elementSortCount: Integer;
elementSortOrder: string;
elementRequired: string;
+ elementNamespaceRequired: string;
elementRequiredCount: Integer;
+ elementNamespaceRequiredCount: Integer;
attributeRequired: string;
attributeRequiredCount: Integer;
@@ -1610,8 +1612,10 @@ begin
begin
case propertyItem.PropertyType of
ptSimple:
- AddArrayElement(elementRequired, elementRequiredCount, QuotedStr(propertyItem.Name));
-
+ begin
+ AddArrayElement(elementRequired, elementRequiredCount, QuotedStr(propertyItem.Name));
+ AddArrayElement(elementNamespaceRequired, elementNamespaceRequiredCount, QuotedStr(propertyItem.TargetNamespace));
+ end;
ptItem:
{ For Item properties, we call our getter property. This ensures the child element exists,
but also that it is created using our binding implementation. Otherwise there will be no
@@ -1627,8 +1631,10 @@ begin
if elementRequiredCount > 0 then
begin
Delete(elementRequired, 1, 2);
+ Delete(elementNamespaceRequired, 1, 2);
AWriter.WriteLineNamedFmt(IfThen(AStrict, XSDValidateStrictMethodImplementationRequired, XSDValidateMethodImplementationRequired),
- ['RequiredElements', elementRequired]);
+ ['RequiredElements', elementRequired,
+ 'RequiredElementNamespaces', elementNamespaceRequired]);
end;
diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas
index 12fbda1..e6ea2a8 100644
--- a/Units/DelphiXMLDataBindingResources.pas
+++ b/Units/DelphiXMLDataBindingResources.pas
@@ -114,7 +114,7 @@ const
XSDValidateMethodImplementationBegin = 'procedure TXML%:s.XSDValidate;' + CrLf +
'begin';
- XSDValidateMethodImplementationRequired = ' CreateRequiredElements(Self, [%:s]);';
+ XSDValidateMethodImplementationRequired = ' CreateRequiredElements(Self, [%:s], [%:s]);';
XSDValidateMethodImplementationComplex = ' Get%:s;';
XSDValidateMethodImplementationAttrib = ' CreateRequiredAttributes(Self, [%:s]);';
XSDValidateMethodImplementationSort = ' SortChildNodes(Self, [%:s]);';
From 023c5197fedfd00ea2aa62edc3f73bec6359bdc6 Mon Sep 17 00:00:00 2001
From: Philipp Winkel
Date: Tue, 10 Nov 2020 17:54:59 +0100
Subject: [PATCH 6/6] =?UTF-8?q?XML=20Kommentare=20f=C3=BCr=20Delphi=20Docu?=
=?UTF-8?q?mentation=20Insight?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
Units/DelphiXMLDataBindingGenerator.pas | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas
index 2027b33..17c5171 100644
--- a/Units/DelphiXMLDataBindingGenerator.pas
+++ b/Units/DelphiXMLDataBindingGenerator.pas
@@ -643,11 +643,11 @@ begin
lines.Text := WrapText(documentation, 76);
- AWriter.WriteLine(' {');
+ AWriter.WriteLine(' /// ');
for lineIndex := 0 to Pred(lines.Count) do
- AWriter.WriteLine(' ' + lines[lineIndex]);
+ AWriter.WriteLine(' /// ' + lines[lineIndex]);
- AWriter.WriteLine(' }');
+ AWriter.WriteLine(' /// ');
finally
FreeAndNil(lines);
end;