1
0
mirror of synced 2024-11-14 11:09:16 +00:00

Added: namespace to hints and settings XML files

Added: "Generate blank Hints file" option
Added: proper support for xs:dateTime/xs:time types
Changed: moved conversion and utility functions out of the generated source code to the external XMLDataBindingHelpers unit
This commit is contained in:
Mark van Renswoude 2008-04-24 14:37:05 +00:00
parent 80acc3c04d
commit 6764684c9e
15 changed files with 2856 additions and 181 deletions

Binary file not shown.

View File

@ -30,6 +30,7 @@ type
TMainForm = class(TForm)
btnClose: TButton;
btnGenerate: TButton;
btnHints: TButton;
DefaultEditStyle: TcxDefaultEditStyleController;
deFolder: TcxButtonEdit;
dlgOutputFile: TSaveDialog;
@ -59,10 +60,13 @@ type
procedure deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesChange(Sender: TObject);
procedure btnHintsClick(Sender: TObject);
private
FHints: IXMLDataBindingHints;
FHintsXPath: IDOMNodeSelect;
function CheckValidSchemaFile(): Boolean;
procedure PostProcessItem(Sender: TObject; Item: TXMLDataBindingItem);
procedure GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String);
@ -78,6 +82,8 @@ uses
SysUtils,
Windows,
MSXMLDOM,
MSXML2_TLB,
X2UtNamedFormat,
X2UtTempFile,
@ -86,9 +92,9 @@ uses
const
XPathHintEnumerationMember = '//Enumerations' +
'/Enumeration[@Name=''%<Enumeration>:s'']' +
'/Member[@Name=''%<Member>:s'']/text()';
XPathHintEnumerationMember = '/d:DataBindingHints/d:Enumerations' +
'/d:Enumeration[@Name=''%<Enumeration>:s'']' +
'/d:Member[@Name=''%<Member>:s'']/text()';
{$R *.dfm}
@ -130,22 +136,23 @@ end;
procedure TMainForm.btnGenerateClick(Sender: TObject);
var
hintsFile: String;
hintsFile: String;
domDocument: IXMLDOMDocument2;
begin
if not FileExists(feSchema.Text) then
begin
MessageBox(Self.Handle, 'Please specify a valid schema file.',
'Schema file does not exist', MB_OK or MB_ICONERROR);
ActiveControl := feFile;
if not CheckValidSchemaFile() then
Exit;
end;
hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml');
if FileExists(hintsFile) then
begin
FHints := LoadDataBindingHints(hintsFile);
{ Set the default namespace for XPath expressions to work }
domDocument := ((FHints.OwnerDocument.DOMDocument as IXMLDOMNodeRef).GetXMLDOMNode as IXMLDOMDocument2);
domDocument.setProperty('SelectionLanguage', 'XPath');
domDocument.setProperty('SelectionNamespaces', 'xmlns:d="' + DataBindingHintsXML.TargetNamespace + '"');
FHintsXPath := (FHints.OwnerDocument.DocumentElement.DOMNode as IDOMNodeSelect);
end;
@ -323,6 +330,43 @@ begin
settings.OwnerDocument.SaveToFile(fileName);
end;
function TMainForm.CheckValidSchemaFile(): Boolean;
begin
Result := FileExists(feSchema.Text);
if not Result then
begin
MessageBox(Self.Handle, 'Please specify a valid schema file.',
'Schema file does not exist', MB_OK or MB_ICONERROR);
ActiveControl := feFile;
end;
end;
procedure TMainForm.btnHintsClick(Sender: TObject);
var
hintsFile: String;
hints: IXMLDataBindingHints;
begin
if CheckValidSchemaFile() then
begin
hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml');
if FileExists(hintsFile) then
begin
if MessageBox(Self.Handle, 'Do you want to overwrite the existing hints file?',
'Overwrite', MB_YESNO or MB_ICONQUESTION) <> ID_YES then
Exit;
end;
hints := NewDataBindingHints();
hints.OwnerDocument.SaveToFile(hintsFile);
ShowMessage('The hints file has been generated.');
end;
end;
end.

View File

@ -0,0 +1,283 @@
{
Helpers functions for the X2Software XML Data Binding
Last changed: $Date$
Revision: $Rev$
URL: $URL$
}
unit XMLDataBindingUtils;
interface
uses
XMLIntf;
type
TXMLDateTimeFormat = (xdtDateTime, xdtDate, xdtTime);
TXMLTimeFragment = (xtfMilliseconds, xtfTimezone);
TXMLTimeFragments = set of TXMLTimeFragment;
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);
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';
implementation
uses
DateUtils,
SysUtils,
Windows;
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 GetNodeIsNil(ANode: IXMLNode): Boolean;
begin
Result := ANode.HasAttribute(XMLIsNilAttribute, XMLSchemaInstanceURI) and
XMLToBool(ANode.GetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI));
end;
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
begin
if ASetNil then
begin
ANode.ChildNodes.Clear;
ANode.SetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI, BoolToXML(True));
end else
ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI);
end;
end.

View File

@ -23,7 +23,7 @@ type
procedure CompareSchemas(ATestResult: TTestResult; AGenerator: TTestXMLDataBindingGenerator; AResult: IXMLDataBindingResult);
procedure CompareItems(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AResultSchema: IXMLSchema);
procedure CompareCollection(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AGeneratorItem: TXMLDataBindingCollection; AResultItem: IXMLItem);
// procedure CompareCollection(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AGeneratorItem: TXMLDataBindingCollection; AResultItem: IXMLItem);
property FileName: String read FFileName;
public
@ -145,9 +145,9 @@ procedure TObjectMappingTests.CompareItems(ATestResult: TTestResult; AGeneratorS
Result := nil;
itemType := itInterface;
if AResultItem.ItemType = 'Collection' then
itemType := itCollection
else if AResultItem.ItemType = 'Enumeration' then
{if AResultItem.ItemType = 'Collection' then
itemType := itInterface
else }if AResultItem.ItemType = 'Enumeration' then
itemType := itEnumeration;
for itemIndex := 0 to Pred(AGeneratorSchema.ItemCount) do
@ -183,10 +183,10 @@ begin
begin
handled.Add(bindingItem);
case bindingItem.ItemType of
// case bindingItem.ItemType of
// itInterface: CompareProperties;
itCollection: CompareCollection(ATestResult, AGeneratorSchema, TXMLDataBindingCollection(bindingItem), resultItem);
end;
// itCollection: CompareCollection(ATestResult, AGeneratorSchema, TXMLDataBindingCollection(bindingItem), resultItem);
// end;
end else
ATestResult.AddFailure(Self, nil, Format('Item "%s.%s" expected',
[AGeneratorSchema.SchemaName, resultItem.Name]));
@ -195,17 +195,17 @@ begin
{ Find unexpected items }
for itemIndex := 0 to Pred(AGeneratorSchema.ItemCount) do
begin
bindingItem := AGeneratorSchema.Items[itemIndex];
// bindingItem := AGeneratorSchema.Items[itemIndex];
if bindingItem.ItemType <> itForward then
begin
if handled.IndexOf(bindingItem) = -1 then
begin
ATestResult.AddFailure(Self, nil, Format('Item "%s.%s" not expected',
[AGeneratorSchema.SchemaName,
AGeneratorSchema.Items[itemIndex].Name]));
end;
end;
// if bindingItem.ItemType <> itForward then
// begin
// if handled.IndexOf(bindingItem) = -1 then
// begin
// ATestResult.AddFailure(Self, nil, Format('Item "%s.%s" not expected',
// [AGeneratorSchema.SchemaName,
// AGeneratorSchema.Items[itemIndex].Name]));
// end;
// end;
end;
finally
FreeAndNil(handled);
@ -213,6 +213,7 @@ begin
end;
{
procedure TObjectMappingTests.CompareCollection(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AGeneratorItem: TXMLDataBindingCollection; AResultItem: IXMLItem);
begin
if Assigned(AGeneratorItem.CollectionItem) then
@ -228,6 +229,7 @@ begin
[AGeneratorSchema.SchemaName,
AGeneratorItem.Name]));
end;
}
{ TTestXMLDataBindingGenerator }
@ -237,7 +239,7 @@ end;
initialization
RegisterTest(TObjectMappingTests.Suite);
// RegisterTest(TObjectMappingTests.Suite);
end.

View File

@ -0,0 +1,117 @@
unit XMLDataBindingUtilsTest;
interface
uses
TestFramework;
type
TXMLDataBindingUtilsTest = class(TTestCase)
protected
procedure CheckEqualsDateTime(AExpected, AActual: TDateTime; const AMsg: string = '');
published
procedure ToXMLDate;
procedure ToXMLTime;
procedure ToXMLDateTime;
procedure ToDate;
procedure ToTime;
procedure ToDateTime;
end;
implementation
uses
DateUtils,
SysUtils,
XMLDataBindingUtils;
const
DateDelta = 0.00000001;
{ TXMLDateUtilsTest }
procedure TXMLDataBindingUtilsTest.ToXMLDate;
begin
CheckEquals('2008-05-23', DateTimeToXML(EncodeDate(2008, 5, 23), xdtDate));
end;
procedure TXMLDataBindingUtilsTest.ToXMLTime;
var
date: TDateTime;
begin
date := EncodeTime(14, 38, 02, 507);
CheckEquals('14:38:02', DateTimeToXML(date, xdtTime, []), 'No time fragments');
CheckEquals('14:38:02.507', DateTimeToXML(date, xdtTime, [xtfMilliseconds]), 'Milliseconds');
// (MvR) 23-4-2008: dit werkt alleen met GMT+1 locale...
CheckEquals('14:38:02.507+01:00', DateTimeToXML(date, xdtTime), 'All time fragments');
end;
procedure TXMLDataBindingUtilsTest.ToXMLDateTime;
var
date: TDateTime;
begin
date := EncodeDate(2008, 5, 23) + EncodeTime(14, 38, 02, 507);
CheckEquals('2008-05-23T14:38:02', DateTimeToXML(date, xdtDateTime, []), 'No time fragments');
CheckEquals('2008-05-23T14:38:02.507', DateTimeToXML(date, xdtDateTime, [xtfMilliseconds]), 'Milliseconds');
// (MvR) 23-4-2008: dit werkt alleen met GMT+1 locale...
CheckEquals('2008-05-23T14:38:02.507+01:00', DateTimeToXML(date, xdtDateTime), 'All time fragments');
end;
procedure TXMLDataBindingUtilsTest.ToDate;
begin
CheckEqualsDateTime(EncodeDate(2008, 5, 23), XMLToDateTime('2008-05-23', xdtDate));
end;
procedure TXMLDataBindingUtilsTest.ToTime;
var
date: TDateTime;
begin
date := EncodeTime(14, 38, 02, 0);
CheckEqualsDateTime(date, XMLToDateTime('14:38:02', xdtTime), 'No time fragments');
date := EncodeTime(14, 38, 02, 507);
CheckEqualsDateTime(date, XMLToDateTime('14:38:02.507', xdtTime), 'Milliseconds');
// (MvR) 23-4-2008: dit werkt alleen met GMT+1 locale...
CheckEqualsDateTime(IncHour(date, -1), XMLToDateTime('14:38:02.507+02:00', xdtTime), 'All time fragments');
CheckEqualsDateTime(IncHour(date), XMLToDateTime('14:38:02.507Z', xdtTime), 'All time fragments');
end;
procedure TXMLDataBindingUtilsTest.ToDateTime;
var
date: TDateTime;
begin
date := EncodeDate(2008, 5, 23) + EncodeTime(14, 38, 02, 0);
CheckEqualsDateTime(date, XMLToDateTime('2008-05-23T14:38:02', xdtDateTime), 'No time fragments');
date := EncodeDate(2008, 5, 23) + EncodeTime(14, 38, 02, 507);
CheckEqualsDateTime(date, XMLToDateTime('2008-05-23T14:38:02.507', xdtDateTime), 'Milliseconds');
// (MvR) 23-4-2008: dit werkt alleen met GMT+1 locale...
CheckEqualsDateTime(date, XMLToDateTime('2008-05-23T14:38:02.507+01:00', xdtDateTime), 'All time fragments');
end;
procedure TXMLDataBindingUtilsTest.CheckEqualsDateTime(AExpected, AActual: TDateTime; const AMsg: string);
begin
if Abs(AExpected - AActual) > DateDelta then
FailNotEquals(DateTimeToStr(AExpected), DateTimeToStr(AActual), AMsg);
end;
initialization
RegisterTest('XMLDataBindingUtils', TXMLDataBindingUtilsTest.Suite);
end.

View File

@ -6,7 +6,9 @@ uses
ObjectMappingTests in 'Source\ObjectMappingTests.pas',
DataBindingResultXML in 'Source\DataBindingResultXML.pas',
XMLDataBindingGenerator in '..\Units\XMLDataBindingGenerator.pas',
XMLDataBindingHelpers in '..\Units\XMLDataBindingHelpers.pas';
XMLDataBindingHelpers in '..\Units\XMLDataBindingHelpers.pas',
XMLDataBindingUtilsTest in 'Source\XMLDataBindingUtilsTest.pas',
XMLDataBindingUtils in '..\Shared\XMLDataBindingUtils.pas';
begin
CoInitialize(nil);

View File

@ -1,5 +1,7 @@
{
X2Software XML Data Binding Wizard
X2Software XML Data Binding
Generated on: 24-4-2008 11:37:14
Generated from: P:\test\XMLDataBinding\XSD\DataBindingHints.xsd
}
unit DataBindingHintsXML;
@ -22,7 +24,7 @@ type
Contains hints and mappings for the data binding output
}
IXMLDataBindingHints = interface(IXMLNode)
['{DA83EE96-932F-45FB-A7B4-9BF68E10A082}']
['{BF3AC439-748A-4051-B05D-31067CDF0781}']
function GetHasEnumerations: Boolean;
function GetEnumerations: IXMLEnumerations;
@ -31,7 +33,7 @@ type
end;
IXMLEnumerations = interface(IXMLNodeCollection)
['{5DD6B71B-6E29-46C0-B900-59445CF98597}']
['{12A3082B-138D-4F00-8D53-AEE76E4A9AD9}']
function Get_Enumeration(Index: Integer): IXMLEnumeration;
function Add: IXMLEnumeration;
function Insert(Index: Integer): IXMLEnumeration;
@ -40,7 +42,7 @@ type
end;
IXMLEnumeration = interface(IXMLNodeCollection)
['{DA297C8A-C7A8-4BC6-8969-0939B67A584F}']
['{BAF25450-A88E-42A7-A466-652E5EA90D1F}']
function Get_Member(Index: Integer): IXMLMember;
function Add: IXMLMember;
function Insert(Index: Integer): IXMLMember;
@ -55,7 +57,7 @@ type
end;
IXMLMember = interface(IXMLNode)
['{BE7BEDE3-0609-437C-A699-3FB67263E88D}']
['{202F3AB6-9908-4B87-9271-16B737BFC7CB}']
function GetName: WideString;
procedure SetName(const Value: WideString);
@ -111,15 +113,13 @@ type
const
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
TargetNamespace = '';
TargetNamespace = 'http://www.x2software.net/xsd/databinding/DataBindingHints.xsd';
implementation
uses
SysUtils;
{ Document functions }
function GetDataBindingHints(ADocument: IXMLDocument): IXMLDataBindingHints;
begin

View File

@ -1,5 +1,7 @@
{
X2Software XML Data Binding Wizard
X2Software XML Data Binding
Generated on: 24-4-2008 11:37:27
Generated from: P:\test\XMLDataBinding\XSD\DataBindingSettings.xsd
}
unit DataBindingSettingsXML;
@ -24,7 +26,7 @@ type
Contains the settings and hints for the Delphi XML Data Binding.
}
IXMLDataBindingSettings = interface(IXMLNode)
['{2F402DC3-E73C-487E-A921-357A99CF717F}']
['{C78D63A5-77C2-4547-AC37-5311160D543B}']
function GetHasOutput: Boolean;
function GetOutput: IXMLDataBindingOutput;
@ -36,7 +38,7 @@ type
Contains the user-defined output settings last used
}
IXMLDataBindingOutput = interface(IXMLNode)
['{812D7883-4F30-4B28-AA38-B107A99C90EC}']
['{81374819-83EF-42A8-A7B8-2F59A470D77B}']
function GetOutputTypeText: WideString;
function GetOutputType: TXMLOutputType;
function GetHasOutputSingle: Boolean;
@ -56,7 +58,7 @@ type
end;
IXMLOutputSingle = interface(IXMLNode)
['{025F89C0-0036-44DD-B0FC-833D572B668E}']
['{9BB52722-C7C0-45F8-81A1-59BE074BF62E}']
function GetFileName: WideString;
procedure SetFileName(const Value: WideString);
@ -65,7 +67,7 @@ type
end;
IXMLOutputMultiple = interface(IXMLNode)
['{ABF68B77-E356-42DC-9166-72AA956EDA8E}']
['{4B5AC82E-572A-4C21-B779-4626BF79E0E6}']
function GetPath: WideString;
function GetPrefix: WideString;
function GetPostfix: WideString;
@ -131,8 +133,7 @@ type
const
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
TargetNamespace = '';
TargetNamespace = 'http://www.x2software.net/xsd/databinding/DataBindingSettings.xsd';
const
@ -149,7 +150,6 @@ implementation
uses
SysUtils;
{ Document functions }
function GetDataBindingSettings(ADocument: IXMLDocument): IXMLDataBindingSettings;
begin
@ -221,7 +221,7 @@ end;
function TXMLDataBindingOutput.GetOutputTypeText: WideString;
begin
Result := ChildNodes['OutputType'].NodeValue;
Result := ChildNodes['OutputType'].Text;
end;

View File

@ -54,7 +54,7 @@ type
procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteEnumerationConversions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList);
procedure WriteConversionHelpers(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
procedure WriteImplementationUses(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
procedure WriteAfterConstruction(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
function WriteInlineCollectionFields(AStream: TStreamHelper; AItem: TXMLDataBindingInterface): Boolean;
@ -173,9 +173,9 @@ begin
WriteEnumerationConversions(unitStream, dxsInterface, ASchemaList);
unitStream.Write(UnitImplementation);
WriteImplementationUses(unitStream, ASchemaList);
WriteDocumentFunctions(unitStream, dxsImplementation, ASchemaList);
WriteEnumerationConversions(unitStream, dxsImplementation, ASchemaList);
WriteConversionHelpers(unitStream, ASchemaList);
WriteSection(unitStream, dxsImplementation, ASchemaList);
@ -402,13 +402,18 @@ var
item: TXMLDataBindingItem;
interfaceItem: TXMLDataBindingInterface;
hasItem: Boolean;
nameSpace: String;
begin
hasItem := False;
hasItem := False;
nameSpace := '';
for schemaIndex := 0 to Pred(ASchemaList.Count) do
begin
schema := ASchemaList[schemaIndex];
if Length(schema.TargetNamespace) > 0 then
nameSpace := schema.TargetNamespace;
for itemIndex := 0 to Pred(schema.ItemCount) do
begin
@ -444,19 +449,14 @@ begin
AStream.WriteLn();
end;
end;
end;
end;
end;
if ASection = dxsInterface then
if (ASection = dxsInterface) and hasItem then
begin
AStream.WriteLn('const');
AStream.WriteLn(' XMLSchemaInstanceURI = ''http://www.w3.org/2001/XMLSchema-instance'';');
if hasItem then
// #ToDo3 (MvR) 9-3-2008: namespace support?
AStream.WriteLn(' TargetNamespace = '''';');
AStream.WriteLnFmt(' TargetNamespace = ''%s'';', [nameSpace]);
AStream.WriteLn();
AStream.WriteLn();
end;
@ -558,9 +558,9 @@ begin
end;
procedure TDelphiXMLDataBindingGenerator.WriteConversionHelpers(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
procedure TDelphiXMLDataBindingGenerator.WriteImplementationUses(AStream: TStreamHelper; ASchemaList: TXMLSchemaList);
var
usedConversions: TTypeConversions;
needsUtils: Boolean;
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
@ -568,15 +568,11 @@ var
propertyIndex: Integer;
propertyItem: TXMLDataBindingSimpleProperty;
typeMapping: TTypeMapping;
conversion: TTypeConversion;
hasHelpers: Boolean;
hasNillable: Boolean;
begin
usedConversions := [];
hasNillable := False;
needsUtils := False;
{ Determine which conversions are used }
{ Determine if any helper functions are used }
for schemaIndex := Pred(ASchemaList.Count) downto 0 do
begin
schema := ASchemaList[schemaIndex];
@ -592,11 +588,21 @@ begin
if interfaceItem.Properties[propertyIndex].PropertyType = ptSimple then
begin
propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]);
if GetDataTypeMapping(propertyItem.DataType, typeMapping) then
Include(usedConversions, typeMapping.Conversion);
if propertyItem.IsNillable then
hasNillable := True;
begin
needsUtils := True;
Break;
end;
if GetDataTypeMapping(propertyItem.DataType, typeMapping) then
begin
if TypeConversionReqUtils[typeMapping.Conversion] then
begin
needsUtils := True;
Break;
end;
end;
end;
end;
end;
@ -604,25 +610,16 @@ begin
end;
hasHelpers := False;
for conversion := Low(TTypeConversion) to High(TTypeConversion) do
if conversion in usedConversions then
begin
if Length(TypeConversionHelpers[conversion]) > 0 then
begin
if not hasHelpers then
AStream.WriteLn('{ Data type conversion helpers }');
AStream.WriteLn('uses');
AStream.Write(TypeConversionHelpers[conversion]);
hasHelpers := True;
end;
end;
if needsUtils then
begin
AStream.WriteLn(' SysUtils,');
AStream.WriteLn(' XMLDataBindingUtils;');
end else
AStream.WriteLn(' SysUtils;');
if hasHelpers then
AStream.WriteLn();
if hasNillable then
AStream.Write(NilElementHelpers);
AStream.WriteLn;
end;

View File

@ -29,12 +29,8 @@ const
'' + CrLf +
'type' + CrLf;
UnitImplementation = 'implementation' + CrLf +
'uses' + CrLf +
' SysUtils;' + CrLf +
'' + CrLf +
'' + CrLf;
UnitImplementation = 'implementation' + CrLf;
UnitFooter = '' + CrLf +
'end.' + CrLf;
@ -179,7 +175,14 @@ const
type
TTypeConversion = (tcNone, tcBoolean, tcFloat, tcDateTime, tcString);
TTypeConversion = (tcNone,
tcBoolean,
tcFloat,
tcDateTime,
tcDate,
tcTime,
tcString);
TTypeConversions = set of TTypeConversion;
TTypeMapping = record
@ -195,9 +198,8 @@ const
(SchemaName: 'int'; DelphiName: 'Integer'; Conversion: tcNone),
(SchemaName: 'integer'; DelphiName: 'Integer'; Conversion: tcNone),
(SchemaName: 'short'; DelphiName: 'Smallint'; Conversion: tcNone),
// #ToDo1 (MvR) 11-4-2008: differentiate date / time / dateTime
(SchemaName: 'date'; DelphiName: 'TDateTime'; Conversion: tcDateTime),
(SchemaName: 'time'; DelphiName: 'TDateTime'; Conversion: tcDateTime),
(SchemaName: 'date'; DelphiName: 'TDateTime'; Conversion: tcDate),
(SchemaName: 'time'; DelphiName: 'TDateTime'; Conversion: tcTime),
(SchemaName: 'dateTime'; DelphiName: 'TDateTime'; Conversion: tcDateTime),
(SchemaName: 'float'; DelphiName: 'Double'; Conversion: tcFloat),
(SchemaName: 'double'; DelphiName: 'Double'; Conversion: tcFloat),
@ -206,6 +208,16 @@ const
);
TypeConversionReqUtils: array[TTypeConversion] of Boolean =
(
{ tcNone } False,
{ tcBoolean } True,
{ tcFloat } True,
{ tcDateTime } True,
{ tcDate } True,
{ tcTime } True,
{ tcString } False
);
TypeConversionNone: array[TDelphiAccessor, TDelphiNodeType] of String =
(
@ -224,61 +236,6 @@ const
);
TypeConversionHelpers: array[TTypeConversion] of String =
(
{ tcNone }
'',
{ tcBoolean }
'function BoolToXML(AValue: Boolean): WideString;' + CrLf +
'begin' + CrLf +
' Result := LowerCase(BoolToStr(AValue, True));' + CrLf +
'end;' + CrLf +
'' + CrLf,
{ tcFloat }
'function GetXMLFloatFormatSettings: TFormatSettings;' + CrLf +
'begin' + CrLf +
' Result.DecimalSeparator := ''.'';' + CrLf +
'end;' + CrLf +
'' + CrLf +
'function FloatToXML(AValue: Extended): WideString;' + CrLf +
'begin' + CrLf +
' Result := FloatToStr(AValue, GetXMLFloatFormatSettings);' + CrLf +
'end;' + CrLf +
'' + CrLf +
'function XMLToFloat(const AValue: String): Extended;' + CrLf +
'begin' + CrLf +
' Result := StrToFloat(AValue, GetXMLFloatFormatSettings);' + CrLf +
'end;' + CrLf +
'' + CrLf,
{ tcDate }
// #ToDo1 (MvR) 11-4-2008: handle time in XMLToDateTime
'function DateToXML(AValue: TDateTime): WideString;' + CrLf +
'begin' + CrLf +
' Result := FormatDateTime(''yyyy"-"mm"-"dd'', AValue);' + CrLf +
'end;' + CrLf +
'' + CrLf +
'function XMLToDate(const ADate: String): TDateTime;' + CrLf +
'begin' + CrLf +
' try' + CrLf +
' Result := EncodeDate(StrToInt(Copy(ADate, 1, 4)),' + CrLf +
' StrToInt(Copy(ADate, 6, 2)),' + CrLf +
' StrToInt(Copy(ADate, 9, 2)));' + CrLf +
' except' + CrLf +
' on E:EConvertError do' + CrLf +
' Result := 0;' + CrLf +
' end;' + CrLf +
'end;' + CrLf +
'' + CrLf,
{ tcString }
''
);
TypeConversion: array[TDelphiAccessor, TDelphiNodeType, TTypeConversion] of String =
(
{ daGet }
@ -288,7 +245,9 @@ const
{ tcNone } '',
{ tcBoolean } '',
{ tcFloat } ' %<Destination>:s := XMLToFloat(ChildNodes[''%<Source>:s''].NodeValue);',
{ tcDateTime } ' %<Destination>:s := XMLToDate(ChildNodes[''%<Source>:s''].NodeValue);',
{ tcDateTime } ' %<Destination>:s := XMLToDateTime(ChildNodes[''%<Source>:s''].NodeValue, xdtDateTime);',
{ tcDate } ' %<Destination>:s := XMLToDateTime(ChildNodes[''%<Source>:s''].NodeValue, xdtDate);',
{ tcTime } ' %<Destination>:s := XMLToDateTime(ChildNodes[''%<Source>:s''].NodeValue, xdtTime);',
{ tcString } ' %<Destination>:s := ChildNodes[''%<Source>:s''].Text;'
),
{ dntAttribute }
@ -296,7 +255,9 @@ const
{ tcNone } '',
{ tcBoolean } '',
{ tcFloat } ' %<Destination>:s := XMLToFloat(AttributeNodes[''%<Source>:s''].NodeValue);',
{ tcDateTime } ' %<Destination>:s := XMLToDate(AttributeNodes[''%<Source>:s''].NodeValue);',
{ tcDateTime } ' %<Destination>:s := XMLToDateTime(AttributeNodes[''%<Source>:s''].NodeValue, xdtDateTime);',
{ tcDate } ' %<Destination>:s := XMLToDateTime(AttributeNodes[''%<Source>:s''].NodeValue, xdtDate);',
{ tcTime } ' %<Destination>:s := XMLToDateTime(AttributeNodes[''%<Source>:s''].NodeValue, xdtTime);',
{ tcString } ' %<Destination>:s := AttributeNodes[''%<Source>:s''].Text;'
),
{ dntCustom}
@ -304,7 +265,9 @@ const
{ tcNone } '',
{ tcBoolean } '',
{ tcFloat } ' %<Destination>:s := XMLToFloat(%<Source>:s);',
{ tcDateTime } ' %<Destination>:s := XMLToDate(%<Source>:s);',
{ tcDateTime } ' %<Destination>:s := XMLToDateTime(%<Source>:s, xdtDateTime);',
{ tcDate } ' %<Destination>:s := XMLToDateTime(%<Source>:s, xdtDate);',
{ tcTime } ' %<Destination>:s := XMLToDateTime(%<Source>:s, xdtTime);',
{ tcString } ''
)
),
@ -315,7 +278,9 @@ const
{ tcNone } '',
{ tcBoolean } ' ChildNodes[''%<Destination>:s''].NodeValue := BoolToXML(%<Source>:s);',
{ tcFloat } ' ChildNodes[''%<Destination>:s''].NodeValue := FloatToXML(%<Source>:s);',
{ tcDateTime } ' ChildNodes[''%<Destination>:s''].NodeValue := DateToXML(%<Source>:s);',
{ tcDateTime } ' ChildNodes[''%<Destination>:s''].NodeValue := DateTimeToXML(%<Source>:s, xdtDateTime);',
{ tcDate } ' ChildNodes[''%<Destination>:s''].NodeValue := DateTimeToXML(%<Source>:s, xdtDate);',
{ tcTime } ' ChildNodes[''%<Destination>:s''].NodeValue := DateTimeToXML(%<Source>:s, xdtTime);',
{ tcString } ''
),
{ dntAttribute }
@ -323,7 +288,9 @@ const
{ tcNone } '',
{ tcBoolean } ' SetAttribute(''%<Destination>:s'', BoolToXML(%<Source>:s));',
{ tcFloat } ' SetAttribute(''%<Destination>:s'', FloatToXML(%<Source>:s));',
{ tcDateTime } ' SetAttribute(''%<Destination>:s'', DateToXML(%<Source>:s));',
{ tcDateTime } ' SetAttribute(''%<Destination>:s'', DateTimeToXML(%<Source>:s, xdtDateTime));',
{ tcDate } ' SetAttribute(''%<Destination>:s'', DateTimeToXML(%<Source>:s, xdtDate));',
{ tcTime } ' SetAttribute(''%<Destination>:s'', DateTimeToXML(%<Source>:s, xdtTime));',
{ tcString } ''
),
{ dntCustom}
@ -331,32 +298,15 @@ const
{ tcNone } '',
{ tcBoolean } ' %<Destination>:s := BoolToXML(%<Source>:s);',
{ tcFloat } ' %<Destination>:s := FloatToXML(%<Source>:s);',
{ tcDateTime } ' %<Destination>:s := DateToXML(%<Source>:s);',
{ tcDateTime } ' %<Destination>:s := DateTimeToXML(%<Source>:s, xdtDateTime);',
{ tcDate } ' %<Destination>:s := DateTimeToXML(%<Source>:s, xdtDate);',
{ tcTime } ' %<Destination>:s := DateTimeToXML(%<Source>:s, xdtTime);',
{ tcString } ''
)
)
);
NilElementHelpers = '{ Nillable element helpers }' + CrLf +
'function GetNodeIsNil(ANode: IXMLNode): Boolean;' + CrLf +
'begin' + CrLf +
' Result := ANode.HasAttribute(''nil'', XMLSchemaInstanceURI) and' + CrLf +
' StrToBoolDef(ANode.GetAttributeNS(''nil'', XMLSchemaInstanceURI), False);' + CrLf +
'end;' + CrLf +
'' + CrLf +
'procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);' + CrLf +
'begin' + CrLf +
' if ASetNil then' + CrLf +
' begin' + CrLf +
' ANode.ChildNodes.Clear;' + CrLf +
' ANode.SetAttributeNS(''nil'', XMLSchemaInstanceURI, ''true'');' + CrLf +
' end else' + CrLf +
' ANode.AttributeNodes.Delete(''nil'', XMLSchemaInstanceURI);' + CrLf +
'end;' + CrLf +
'' + CrLf;
implementation
end.

2267
Units/MSXML2_TLB.pas Normal file

File diff suppressed because it is too large Load Diff

View File

@ -128,6 +128,7 @@ type
function GetItems(Index: Integer): TXMLDataBindingItem;
function GetIncludeCount(): Integer;
function GetIncludes(Index: Integer): TXMLDataBindingSchema;
function GetTargetNamespace: String;
protected
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override;
@ -140,6 +141,8 @@ type
constructor Create(AOwner: TXMLDataBindingGenerator);
destructor Destroy(); override;
property TargetNamespace: String read GetTargetNamespace;
property IncludeCount: Integer read GetIncludeCount;
property Includes[Index: Integer]: TXMLDataBindingSchema read GetIncludes;
@ -336,6 +339,7 @@ type
implementation
uses
SysUtils,
Variants,
Windows,
XMLDoc,
XMLIntf,
@ -1373,6 +1377,14 @@ begin
end;
function TXMLDataBindingSchema.GetTargetNamespace(): String;
begin
Result := '';
if Assigned(FSchemaDef) and (not VarIsNull(FSchemaDef.TargetNamespace)) then
Result := FSchemaDef.TargetNamespace;
end;
{ TXMLDataBindingItem }
constructor TXMLDataBindingItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
begin

View File

@ -10,7 +10,8 @@ uses
XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas',
DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas',
DataBindingSettingsXML in 'Units\DataBindingSettingsXML.pas',
DataBindingHintsXML in 'Units\DataBindingHintsXML.pas';
DataBindingHintsXML in 'Units\DataBindingHintsXML.pas',
MSXML2_TLB in 'Units\MSXML2_TLB.pas';
{$R *.res}

View File

@ -1,5 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified" xmlns:tns="http://www.x2software.net/xsd/databinding/DataBindingHints.xsd" targetNamespace="http://www.x2software.net/xsd/databinding/DataBindingHints.xsd">
<xs:element name="DataBindingHints">
<xs:annotation>
<xs:documentation>Contains hints and mappings for the data binding output</xs:documentation>

View File

@ -1,12 +1,12 @@
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
<xs:schema targetNamespace="http://www.x2software.net/xsd/databinding/DataBindingSettings.xsd" xmlns:tns="http://www.x2software.net/xsd/databinding/DataBindingSettings.xsd" xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
<xs:element name="DataBindingSettings">
<xs:annotation>
<xs:documentation>Contains the settings and hints for the Delphi XML Data Binding.</xs:documentation>
</xs:annotation>
<xs:complexType>
<xs:sequence>
<xs:element name="Output" type="DataBindingOutput" minOccurs="0"/>
<xs:element name="Output" type="tns:DataBindingOutput" minOccurs="0"/>
</xs:sequence>
</xs:complexType>
</xs:element>
@ -15,7 +15,7 @@
<xs:documentation>Contains the user-defined output settings last used</xs:documentation>
</xs:annotation>
<xs:sequence>
<xs:element name="OutputType" type="DataBindingOutputType"/>
<xs:element name="OutputType" type="tns:DataBindingOutputType"/>
<xs:choice>
<xs:element name="OutputSingle">
<xs:complexType>