1
0
mirror of synced 2024-11-15 03:23:51 +00:00

Merge branch 'master' into dev

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

View File

@ -27,19 +27,6 @@ object MainForm: TMainForm
Height = 13 Height = 13
Caption = 'Schema file:' Caption = 'Schema file:'
end 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 object gbOutput: TGroupBox
Left = 8 Left = 8
Top = 43 Top = 43
@ -47,7 +34,7 @@ object MainForm: TMainForm
Height = 225 Height = 225
Anchors = [akLeft, akTop, akBottom] Anchors = [akLeft, akTop, akBottom]
Caption = ' Output ' Caption = ' Output '
TabOrder = 1 TabOrder = 0
DesignSize = ( DesignSize = (
422 422
225) 225)
@ -82,10 +69,9 @@ object MainForm: TMainForm
TabOrder = 2 TabOrder = 2
object spFile: TTabSheet object spFile: TTabSheet
TabVisible = False TabVisible = False
ExplicitLeft = 0 DesignSize = (
ExplicitTop = 0 408
ExplicitWidth = 0 83)
ExplicitHeight = 0
object lblFile: TLabel object lblFile: TLabel
Left = 4 Left = 4
Top = 7 Top = 7
@ -93,23 +79,19 @@ object MainForm: TMainForm
Height = 13 Height = 13
Caption = 'Output file:' Caption = 'Output file:'
end end
object feFile: TcxButtonEdit object feFile: TJvFilenameEdit
Left = 88 Left = 89
Top = 4 Top = 3
Properties.Buttons = < Width = 316
item Height = 21
Kind = bkEllipsis DialogOptions = [ofHideReadOnly, ofCreatePrompt]
end> Anchors = [akLeft, akTop, akRight]
Properties.OnButtonClick = feFilePropertiesButtonClick
TabOrder = 0 TabOrder = 0
Width = 317 Text = ''
end end
end end
object spFolder: TTabSheet object spFolder: TTabSheet
TabVisible = False TabVisible = False
DesignSize = (
408
83)
object lblFolder: TLabel object lblFolder: TLabel
Left = 4 Left = 4
Top = 7 Top = 7
@ -131,30 +113,35 @@ object MainForm: TMainForm
Height = 13 Height = 13
Caption = 'File postfix:' Caption = 'File postfix:'
end end
object deFolder: TcxButtonEdit object edtFolderPrefix: TEdit
Left = 88 Left = 89
Top = 4 Top = 31
Anchors = [akLeft, akTop, akRight] Width = 316
Properties.Buttons = < Height = 21
item
Kind = bkEllipsis
end>
Properties.OnButtonClick = deFolderPropertiesButtonClick
TabOrder = 0 TabOrder = 0
Width = 317
end end
object edtFolderPrefix: TcxTextEdit object edtFolderPostfix: TEdit
Left = 88 Left = 89
Top = 29 Top = 59
Width = 316
Height = 21
TabOrder = 1 TabOrder = 1
Text = 'xml_'
Width = 121
end end
object edtFolderPostfix: TcxTextEdit object deFolder: TEdit
Left = 88 Left = 89
Top = 55 Top = 4
Width = 245
Height = 21
TabOrder = 2 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 end
end end
@ -200,7 +187,7 @@ object MainForm: TMainForm
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Cancel = True Cancel = True
Caption = '&Close' Caption = '&Close'
TabOrder = 4 TabOrder = 2
OnClick = btnCloseClick OnClick = btnCloseClick
end end
object btnHints: TButton object btnHints: TButton
@ -211,30 +198,29 @@ object MainForm: TMainForm
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Cancel = True Cancel = True
Caption = 'Generate blank &Hints file' Caption = 'Generate blank &Hints file'
TabOrder = 2 TabOrder = 1
OnClick = btnHintsClick OnClick = btnHintsClick
end end
object DefaultEditStyle: TcxDefaultEditStyleController object feSchema: TJvFilenameEdit
Style.HotTrack = False Left = 104
Left = 264 Top = 8
Top = 60 Width = 316
PixelsPerInch = 96 Height = 21
end OnAfterDialog = feSchemaAfterDialog
object LookAndFeel: TcxLookAndFeelController DialogOptions = [ofHideReadOnly, ofFileMustExist]
Kind = lfFlat TabOrder = 4
Left = 368 Text = ''
Top = 60
end end
object dlgSchema: TOpenDialog object dlgSchema: TOpenDialog
Filter = 'W3C XML Schema files (*.xsd)|*.xsd|All files (*.*)|*.*' Filter = 'W3C XML Schema files (*.xsd)|*.xsd|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
Left = 212 Left = 284
Top = 40 Top = 40
end end
object dlgOutputFile: TSaveDialog object dlgOutputFile: TSaveDialog
Filter = 'Delphi source files (*.pas)|*.pas|All files (*.*)|*.*' Filter = 'Delphi source files (*.pas)|*.pas|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing] Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing]
Left = 323 Left = 387
Top = 45 Top = 37
end end
end end

View File

@ -13,7 +13,9 @@ uses
StdCtrls, StdCtrls,
XMLDOM, XMLDOM,
XMLIntf, XMLIntf,
DataBindingHintsXML,
XMLDataBindingGenerator, JvExMask, JvToolEdit
{
cxButtonEdit, cxButtonEdit,
cxContainer, cxContainer,
cxControls, cxControls,
@ -22,8 +24,8 @@ uses
cxMaskEdit, cxMaskEdit,
cxTextEdit, cxTextEdit,
DataBindingHintsXML, cxGraphics, cxLookAndFeelPainters, cxClasses}
XMLDataBindingGenerator, cxGraphics, cxLookAndFeelPainters, cxClasses; ;
type type
@ -31,21 +33,14 @@ type
btnClose: TButton; btnClose: TButton;
btnGenerate: TButton; btnGenerate: TButton;
btnHints: TButton; btnHints: TButton;
DefaultEditStyle: TcxDefaultEditStyleController;
deFolder: TcxButtonEdit;
dlgOutputFile: TSaveDialog; dlgOutputFile: TSaveDialog;
dlgSchema: TOpenDialog; dlgSchema: TOpenDialog;
edtFolderPostfix: TcxTextEdit;
edtFolderPrefix: TcxTextEdit;
feFile: TcxButtonEdit;
feSchema: TcxButtonEdit;
gbOutput: TGroupBox; gbOutput: TGroupBox;
lblFile: TLabel; lblFile: TLabel;
lblFolder: TLabel; lblFolder: TLabel;
lblFolderPostfix: TLabel; lblFolderPostfix: TLabel;
lblFolderPrefix: TLabel; lblFolderPrefix: TLabel;
lblSchema: TLabel; lblSchema: TLabel;
LookAndFeel: TcxLookAndFeelController;
plOutput: TPageControl; plOutput: TPageControl;
rbFile: TRadioButton; rbFile: TRadioButton;
rbFolder: TRadioButton; rbFolder: TRadioButton;
@ -53,16 +48,24 @@ type
spFolder: TTabSheet; spFolder: TTabSheet;
cbHasChecksEmpty: TCheckBox; cbHasChecksEmpty: TCheckBox;
cbGenerateGetOptionalOrDefault: TCheckBox; cbGenerateGetOptionalOrDefault: TCheckBox;
edtFolderPrefix: TEdit;
edtFolderPostfix: TEdit;
deFolder: TEdit;
feSchema: TJvFilenameEdit;
deFolderPropertiesButton: TButton;
feFile: TJvFilenameEdit;
procedure btnCloseClick(Sender: TObject); procedure btnCloseClick(Sender: TObject);
procedure btnGenerateClick(Sender: TObject); procedure btnGenerateClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure OutputTypeClick(Sender: TObject); procedure OutputTypeClick(Sender: TObject);
procedure feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure deFolderPropertiesButtonClick(Sender: TObject);
procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesChange(Sender: TObject); procedure feSchemaPropertiesChange(Sender: TObject);
procedure btnHintsClick(Sender: TObject); procedure btnHintsClick(Sender: TObject);
procedure feSchemaAfterDialog(Sender: TObject; var AName: string;
var AAction: Boolean);
private private
function CheckValidSchemaFile: Boolean; function CheckValidSchemaFile: Boolean;
function CheckReadOnly(const AFileName: String): Boolean; function CheckReadOnly(const AFileName: String): Boolean;
@ -173,11 +176,11 @@ begin
if rbFile.Checked then if rbFile.Checked then
begin begin
if not CheckReadOnly(feFile.Text) then if not CheckReadOnly(feFile.FileName) then
Exit; Exit;
generator.OutputType := otSingle; generator.OutputType := otSingle;
generator.OutputPath := feFile.Text; generator.OutputPath := feFile.FileName;
end else if rbFolder.Checked then end else if rbFolder.Checked then
begin begin
generator.OutputType := otMultiple; generator.OutputType := otMultiple;
@ -187,9 +190,9 @@ begin
generator.HasChecksEmpty := cbHasChecksEmpty.Checked; generator.HasChecksEmpty := cbHasChecksEmpty.Checked;
generator.HasGenerateGetOptionalOrDefault := cbGenerateGetOptionalOrDefault.Checked; generator.HasGenerateGetOptionalOrDefault := cbGenerateGetOptionalOrDefault.Checked;
generator.OnGetFileName := GetFileName; generator.OnGetFileName := GetFileName;
generator.Execute(feSchema.Text); generator.Execute(feSchema.Filename);
SaveSettings(feSchema.Text); SaveSettings(feSchema.FileName);
ShowMessage('The data binding has been generated.'); ShowMessage('The data binding has been generated.');
finally finally
@ -222,7 +225,7 @@ begin
end; end;
procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure TMainForm.deFolderPropertiesButtonClick(Sender: TObject);
var var
directory: String; directory: String;
@ -232,6 +235,12 @@ begin
end; 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); procedure TMainForm.feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin begin
if dlgSchema.Execute then if dlgSchema.Execute then
@ -330,7 +339,7 @@ end;
function TMainForm.CheckValidSchemaFile: Boolean; function TMainForm.CheckValidSchemaFile: Boolean;
begin begin
Result := FileExists(feSchema.Text); Result := FileExists(feSchema.FileName);
if not Result then if not Result then
begin begin

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.

View File

@ -643,11 +643,11 @@ begin
lines.Text := WrapText(documentation, 76); lines.Text := WrapText(documentation, 76);
AWriter.WriteLine(' {'); AWriter.WriteLine(' /// <summary>');
for lineIndex := 0 to Pred(lines.Count) do for lineIndex := 0 to Pred(lines.Count) do
AWriter.WriteLine(' ' + lines[lineIndex]); AWriter.WriteLine(' /// ' + lines[lineIndex]);
AWriter.WriteLine(' }'); AWriter.WriteLine(' /// </summary>');
finally finally
FreeAndNil(lines); FreeAndNil(lines);
end; end;
@ -814,12 +814,13 @@ begin
'ItemClass', GetDataTypeName(propertyItem, False)]); 'ItemClass', GetDataTypeName(propertyItem, False)]);
end; 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, ['FieldName', PrefixField + propertyItem.TranslatedName,
'CollectionClass', PrefixClass + propertyItem.Collection.TranslatedName, 'CollectionClass', PrefixClass + propertyItem.Collection.TranslatedName,
'CollectionInterface', PrefixInterface + propertyItem.Collection.TranslatedName, 'CollectionInterface', PrefixInterface + propertyItem.Collection.TranslatedName,
'ItemInterface', GetDataTypeName(propertyItem, True), 'ItemInterface', GetDataTypeName(propertyItem, True),
'ItemSourceName', propertyItem.Name]); 'ItemSourceName', propertyItem.Name,
'Namespace', propertyItem.TargetNamespace]);
end; end;
end; end;
@ -1578,7 +1579,9 @@ var
elementSortCount: Integer; elementSortCount: Integer;
elementSortOrder: string; elementSortOrder: string;
elementRequired: string; elementRequired: string;
elementNamespaceRequired: string;
elementRequiredCount: Integer; elementRequiredCount: Integer;
elementNamespaceRequiredCount: Integer;
attributeRequired: string; attributeRequired: string;
attributeRequiredCount: Integer; attributeRequiredCount: Integer;
@ -1609,8 +1612,10 @@ begin
begin begin
case propertyItem.PropertyType of case propertyItem.PropertyType of
ptSimple: ptSimple:
AddArrayElement(elementRequired, elementRequiredCount, QuotedStr(propertyItem.Name)); begin
AddArrayElement(elementRequired, elementRequiredCount, QuotedStr(propertyItem.Name));
AddArrayElement(elementNamespaceRequired, elementNamespaceRequiredCount, QuotedStr(propertyItem.TargetNamespace));
end;
ptItem: ptItem:
{ For Item properties, we call our getter property. This ensures the child element exists, { 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 but also that it is created using our binding implementation. Otherwise there will be no
@ -1626,8 +1631,10 @@ begin
if elementRequiredCount > 0 then if elementRequiredCount > 0 then
begin begin
Delete(elementRequired, 1, 2); Delete(elementRequired, 1, 2);
Delete(elementNamespaceRequired, 1, 2);
AWriter.WriteLineNamedFmt(IfThen(AStrict, XSDValidateStrictMethodImplementationRequired, XSDValidateMethodImplementationRequired), AWriter.WriteLineNamedFmt(IfThen(AStrict, XSDValidateStrictMethodImplementationRequired, XSDValidateMethodImplementationRequired),
['RequiredElements', elementRequired]); ['RequiredElements', elementRequired,
'RequiredElementNamespaces', elementNamespaceRequired]);
end; end;

View File

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

View File

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