GitHub-Mirror/x2xmldatabinding
1
0
Fork 0
mirror of synced 2024-11-14 19:13:50 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into dev

Browse Source
This commit is contained in:
Philipp Winkel 2021-02-01 13:30:13 +01:00
commit 4e660cde52
6 changed files with 95 additions and 1000 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
Forms/MainFrm.dfm
View File

@ -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,9 @@ object MainForm: TMainForm
TabOrder = 2
object spFile: TTabSheet
TabVisible = False
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
DesignSize = (
408
83)
object lblFile: TLabel
Left = 4
Top = 7
@ -93,23 +79,19 @@ 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: TJvFilenameEdit
Left = 89
Top = 3
Width = 316
Height = 21
DialogOptions = [ofHideReadOnly, ofCreatePrompt]
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
Width = 317
Text = ''
end
end
object spFolder: TTabSheet
TabVisible = False
DesignSize = (
408
83)
object lblFolder: TLabel
Left = 4
Top = 7
@ -131,30 +113,35 @@ 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
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
end
object edtFolderPostfix: TcxTextEdit
Left = 88
Top = 55
object deFolder: TEdit
Left = 89
Top = 4
Width = 245
Height = 21
TabOrder = 2
Width = 121
end
object deFolderPropertiesButton: TButton
Left = 340
Top = 3
Width = 65
Height = 22
Caption = 'Properties'
TabOrder = 3
OnClick = deFolderPropertiesButtonClick
end
end
end
@ -200,7 +187,7 @@ object MainForm: TMainForm
Anchors = [akRight, akBottom]
Cancel = True
Caption = '&Close'
TabOrder = 4
TabOrder = 2
OnClick = btnCloseClick
end
object btnHints: TButton
@ -211,30 +198,29 @@ 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
OnAfterDialog = feSchemaAfterDialog
DialogOptions = [ofHideReadOnly, ofFileMustExist]
TabOrder = 4
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

43
Forms/MainFrm.pas
View File

@ -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,16 +48,24 @@ type
spFolder: TTabSheet;
cbHasChecksEmpty: TCheckBox;
cbGenerateGetOptionalOrDefault: TCheckBox;
edtFolderPrefix: TEdit;
edtFolderPostfix: TEdit;
deFolder: TEdit;
feSchema: TJvFilenameEdit;
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;
@ -173,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;
@ -187,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
@ -222,7 +225,7 @@ begin
end;
procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject);
var
directory: String;
@ -232,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
@ -330,7 +339,7 @@ end;
function TMainForm.CheckValidSchemaFile: Boolean;
begin
Result := FileExists(feSchema.Text);
Result := FileExists(feSchema.FileName);
if not Result then
begin

908
Shared/XMLDataBindingUtils.pas
View File

@ -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.

23
Units/DelphiXMLDataBindingGenerator.pas
View File

@ -643,11 +643,11 @@ begin
lines.Text := WrapText(documentation, 76);
AWriter.WriteLine(' {');
AWriter.WriteLine(' /// <summary>');
for lineIndex := 0 to Pred(lines.Count) do
AWriter.WriteLine(' ' + lines[lineIndex]);
AWriter.WriteLine(' /// ' + lines[lineIndex]);
AWriter.WriteLine(' }');
AWriter.WriteLine(' /// </summary>');
finally
FreeAndNil(lines);
end;
@ -814,12 +814,13 @@ begin
'ItemClass', GetDataTypeName(propertyItem, False)]);
end;
AWriter.WriteLineNamedFmt(' %<FieldName>:s := CreateCollection(%<CollectionClass>:s, %<ItemInterface>:s, ''%<ItemSourceName>:s'') as %<CollectionInterface>:s;',
AWriter.WriteLineNamedFmt(' %<FieldName>:s := CreateCollection(%<CollectionClass>:s, %<ItemInterface>:s, ''%<ItemSourceName>:s'', ''%<Namespace>:s'') as %<CollectionInterface>: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;
@ -1578,7 +1579,9 @@ var
elementSortCount: Integer;
elementSortOrder: string;
elementRequired: string;
elementNamespaceRequired: string;
elementRequiredCount: Integer;
elementNamespaceRequiredCount: Integer;
attributeRequired: string;
attributeRequiredCount: Integer;
@ -1609,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
@ -1626,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;

2
Units/DelphiXMLDataBindingResources.pas
View File

@ -114,7 +114,7 @@ const
XSDValidateMethodImplementationBegin = 'procedure TXML%<Name>:s.XSDValidate;' + CrLf +
'begin';
XSDValidateMethodImplementationRequired = ' CreateRequiredElements(Self, [%<RequiredElements>:s]);';
XSDValidateMethodImplementationRequired = ' CreateRequiredElements(Self, [%<RequiredElements>:s], [%<RequiredElementNamespaces>:s]);';
XSDValidateMethodImplementationComplex = ' Get%<Name>:s;';
XSDValidateMethodImplementationAttrib = ' CreateRequiredAttributes(Self, [%<RequiredAttributes>:s]);';
XSDValidateMethodImplementationSort = ' SortChildNodes(Self, [%<SortOrder>:s]);';

5
X2XMLDataBinding.dproj
View File

@ -52,6 +52,7 @@
<VerInfo_Locale>1043</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<SanitizedProjectName>X2XMLDataBinding</SanitizedProjectName>
<DCC_UnitSearchPath>..\x2utils;..\x2log;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Data.Win;Datasnap.Win;Web.Win;Soap.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
@ -133,8 +134,8 @@
<Source Name="MainSource">X2XMLDataBinding.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k250.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp250.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k250.bpl">Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp250.bpl">Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Platforms>