From 7ed849490c664bc8ba71317f992210f86cf13390 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Sun, 20 Jul 2008 12:07:18 +0000 Subject: [PATCH] Added: xsd:base64binary supports --- Shared/XMLDataBindingUtils.pas | 142 +++++++++++++++++++++++- Tests/X2XMLDataBindingTests.dpr | 1 + Units/DelphiXMLDataBindingResources.pas | 47 ++++---- X2XMLDataBinding.bdsproj | 2 +- X2XMLDataBinding.cfg | 11 +- 5 files changed, 175 insertions(+), 28 deletions(-) diff --git a/Shared/XMLDataBindingUtils.pas b/Shared/XMLDataBindingUtils.pas index a74e226..6b4ff01 100644 --- a/Shared/XMLDataBindingUtils.pas +++ b/Shared/XMLDataBindingUtils.pas @@ -9,10 +9,14 @@ unit XMLDataBindingUtils; interface uses + Classes, + SysUtils, XMLIntf; - + type + EBase64Error = class(Exception); + TXMLDateTimeFormat = (xdtDateTime, xdtDate, xdtTime); TXMLTimeFragment = (xtfMilliseconds, xtfTimezone); TXMLTimeFragments = set of TXMLTimeFragment; @@ -32,6 +36,9 @@ const function FloatToXML(AValue: Extended): WideString; function XMLToFloat(const AValue: WideString): Extended; + function Base64Encode(AValue: String): String; + function Base64Decode(AValue: String): String; + function GetNodeIsNil(ANode: IXMLNode): Boolean; procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean); @@ -61,11 +68,16 @@ const XMLIsNilAttribute = 'nil'; + Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/']; + Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + + 'abcdefghijklmnopqrstuvwxyz' + + '0123456789+/'; + Base64Padding = '='; + implementation uses DateUtils, - SysUtils, Windows; @@ -262,6 +274,132 @@ begin end; +function Base64Encode(AValue: String): String; +var + pos: Integer; + lookupIndex: array[0..3] of Byte; + padCount: Integer; + +begin + Result := ''; + if Length(AValue) = 0 then + exit; + + padCount := 0; + + { At least 3 input bytes are required, and the input must be a multiple of 3 } + if Length(AValue) < 3 then + padCount := 3 - Length(AValue) + else if Length(AValue) mod 3 <> 0 then + padCount := 3 - (Length(AValue) mod 3); + + if padCount > 0 then + AValue := AValue + StringOfChar(#0, padCount); + + pos := 1; + + { Process in 3-byte blocks } + while pos <= Length(AValue) - 2 do + begin + { Each 3 input bytes are converted into 4 index values + in the range of 0..63, by taking 6 bits each step. + + 6 high bytes of first char } + lookupIndex[0] := (Ord(AValue[pos]) shr 2) and $3F; + + { 2 low bytes of first char + 4 high bytes of second char } + lookupIndex[1] := ((Ord(AValue[pos]) shl 4) and $3F) or + (Ord(AValue[pos + 1]) shr 4); + + { 4 low bytes of second char + 2 high bytes of third char } + lookupIndex[2] :=((Ord(AValue[pos + 1]) shl 2) and $3F) or + (Ord(AValue[pos + 2]) shr 6); + + { 6 low bytes of third char } + lookupIndex[3] := Ord(AValue[pos + 2]) and $3F; + + Result := Result + Base64LookupTable[lookupIndex[0] + 1] + + Base64LookupTable[lookupIndex[1] + 1] + + Base64LookupTable[lookupIndex[2] + 1] + + Base64LookupTable[lookupIndex[3] + 1]; + Inc(pos, 3); + end; + + { Replace padding } + if padCount > 0 then + begin + for pos := Length(Result) downto Length(Result) - Pred(padCount) do + Result[pos] := Base64Padding; + end; +end; + + +function Base64LookupIndex(AChar: Char): Byte; +var + lookupIndex: Integer; + +begin + Result := Ord(Base64Padding); + + for lookupIndex := 1 to Length(Base64LookupTable) do + if Base64LookupTable[lookupIndex] = AChar then + begin + Result := Pred(lookupIndex); + break; + end; +end; + + +function Base64Decode(AValue: String): String; +var + pos: Integer; + padCount: Integer; + value: Byte; + +begin + Result := ''; + if Length(AValue) = 0 then + exit; + + if Length(AValue) mod 4 <> 0 then + raise EBase64Error.Create('Value length must be a multiple of 4'); + + padCount := 0; + pos := Length(AValue); + + { Count padding chars } + while (pos > 0) and (AValue[pos] = Base64Padding) do + begin + Inc(padCount); + Dec(pos); + end; + + Result := ''; + pos := 1; + + while pos <= Length(AValue) - 3 do + begin + value := (Base64LookupIndex(AValue[pos]) shl 2) or + (Base64LookupIndex(AValue[pos + 1]) shr 4); + Result := Result + Chr(value); + + value := (Base64LookupIndex(AValue[pos + 1]) shl 4) or + (Base64LookupIndex(AValue[pos + 2]) shr 2); + Result := Result + Chr(value); + + value := (Base64LookupIndex(AValue[pos + 2]) shl 6) or + (Base64LookupIndex(AValue[pos + 3])); + Result := Result + Chr(value); + + Inc(pos, 4); + end; + + { Delete padding } + if padCount > 0 then + SetLength(Result, Length(Result) - padCount); +end; + + function GetNodeIsNil(ANode: IXMLNode): Boolean; begin Result := ANode.HasAttribute(XMLIsNilAttribute, XMLSchemaInstanceURI) and diff --git a/Tests/X2XMLDataBindingTests.dpr b/Tests/X2XMLDataBindingTests.dpr index f58615d..808780e 100644 --- a/Tests/X2XMLDataBindingTests.dpr +++ b/Tests/X2XMLDataBindingTests.dpr @@ -1,5 +1,6 @@ program X2XMLDataBindingTests; +{$APPTYPE CONSOLE} uses ActiveX, GUITestRunner, diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas index 6e98833..259af5d 100644 --- a/Units/DelphiXMLDataBindingResources.pas +++ b/Units/DelphiXMLDataBindingResources.pas @@ -181,7 +181,8 @@ type tcDateTime, tcDate, tcTime, - tcString); + tcString, + tcBase64); TTypeConversions = set of TTypeConversion; @@ -193,18 +194,19 @@ type const - SimpleTypeMapping: array[0..9] of TTypeMapping = + SimpleTypeMapping: array[0..10] of TTypeMapping = ( - (SchemaName: 'int'; DelphiName: 'Integer'; Conversion: tcNone), - (SchemaName: 'integer'; DelphiName: 'Integer'; Conversion: tcNone), - (SchemaName: 'short'; DelphiName: 'Smallint'; Conversion: tcNone), - (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), - (SchemaName: 'boolean'; DelphiName: 'Boolean'; Conversion: tcBoolean), - (SchemaName: 'string'; DelphiName: 'WideString'; Conversion: tcString) + (SchemaName: 'int'; DelphiName: 'Integer'; Conversion: tcNone), + (SchemaName: 'integer'; DelphiName: 'Integer'; Conversion: tcNone), + (SchemaName: 'short'; DelphiName: 'Smallint'; Conversion: tcNone), + (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), + (SchemaName: 'boolean'; DelphiName: 'Boolean'; Conversion: tcBoolean), + (SchemaName: 'string'; DelphiName: 'WideString'; Conversion: tcString), + (SchemaName: 'base64Binary'; DelphiName: 'WideString'; Conversion: tcBase64) ); @@ -216,7 +218,8 @@ const { tcDateTime } True, { tcDate } True, { tcTime } True, - { tcString } False + { tcString } False, + { tcBase64 } True ); TypeConversionNone: array[TDelphiAccessor, TDelphiNodeType] of String = @@ -248,7 +251,8 @@ const { tcDateTime } ' %:s := XMLToDateTime(ChildNodes[''%:s''].NodeValue, xdtDateTime);', { tcDate } ' %:s := XMLToDateTime(ChildNodes[''%:s''].NodeValue, xdtDate);', { tcTime } ' %:s := XMLToDateTime(ChildNodes[''%:s''].NodeValue, xdtTime);', - { tcString } ' %:s := ChildNodes[''%:s''].Text;' + { tcString } ' %:s := ChildNodes[''%:s''].Text;', + { tcBas64 } ' %:s := Base64Decode(Trim(ChildNodes[''%:s''].Text));' ), { dntAttribute } ( @@ -258,7 +262,8 @@ const { tcDateTime } ' %:s := XMLToDateTime(AttributeNodes[''%:s''].NodeValue, xdtDateTime);', { tcDate } ' %:s := XMLToDateTime(AttributeNodes[''%:s''].NodeValue, xdtDate);', { tcTime } ' %:s := XMLToDateTime(AttributeNodes[''%:s''].NodeValue, xdtTime);', - { tcString } ' %:s := AttributeNodes[''%:s''].Text;' + { tcString } ' %:s := AttributeNodes[''%:s''].Text;', + { tcBase64 } ' %:s := Base64Decode(Trim(AttributeNodes[''%:s''].Text));' ), { dntCustom} ( @@ -268,7 +273,8 @@ const { tcDateTime } ' %:s := XMLToDateTime(%:s, xdtDateTime);', { tcDate } ' %:s := XMLToDateTime(%:s, xdtDate);', { tcTime } ' %:s := XMLToDateTime(%:s, xdtTime);', - { tcString } '' + { tcString } '', + { tcBase64 } ' %:s := Base64Decode(Trim(%:s));' ) ), { daSet } @@ -281,7 +287,8 @@ const { tcDateTime } ' ChildNodes[''%:s''].NodeValue := DateTimeToXML(%:s, xdtDateTime);', { tcDate } ' ChildNodes[''%:s''].NodeValue := DateTimeToXML(%:s, xdtDate);', { tcTime } ' ChildNodes[''%:s''].NodeValue := DateTimeToXML(%:s, xdtTime);', - { tcString } '' + { tcString } '', + { tcBase64 } ' ChildNodes[''%:s''].NodeValue := Base64Encode(%:s);' ), { dntAttribute } ( @@ -291,7 +298,8 @@ const { tcDateTime } ' SetAttribute(''%:s'', DateTimeToXML(%:s, xdtDateTime));', { tcDate } ' SetAttribute(''%:s'', DateTimeToXML(%:s, xdtDate));', { tcTime } ' SetAttribute(''%:s'', DateTimeToXML(%:s, xdtTime));', - { tcString } '' + { tcString } '', + { tcBase64 } ' SetAttribute(''%:s'', Base64Encode(%:s));' ), { dntCustom} ( @@ -301,7 +309,8 @@ const { tcDateTime } ' %:s := DateTimeToXML(%:s, xdtDateTime);', { tcDate } ' %:s := DateTimeToXML(%:s, xdtDate);', { tcTime } ' %:s := DateTimeToXML(%:s, xdtTime);', - { tcString } '' + { tcString } '', + { tcBase64 } ' %:s := Base64Encode(%:s);' ) ) ); diff --git a/X2XMLDataBinding.bdsproj b/X2XMLDataBinding.bdsproj index 6d57e18..3d9822a 100644 --- a/X2XMLDataBinding.bdsproj +++ b/X2XMLDataBinding.bdsproj @@ -130,7 +130,7 @@ False - "F:\Archive\2007\XMLDataBinding\Tests\Data\02. Collection.xsd" + "F:\Archive\2007\XMLDataBinding\DMS_export_import_formaat.xsd" False diff --git a/X2XMLDataBinding.cfg b/X2XMLDataBinding.cfg index 5ea2a42..2125801 100644 --- a/X2XMLDataBinding.cfg +++ b/X2XMLDataBinding.cfg @@ -1,6 +1,6 @@ -$A8 -$B- --$C- +-$C+ -$D+ -$E- -$F- @@ -12,7 +12,7 @@ -$L+ -$M- -$N+ --$O- +-$O+ -$P+ -$Q- -$R- @@ -22,7 +22,7 @@ -$V+ -$W- -$X+ --$Y+ +-$YD -$Z1 -GD -cg @@ -32,9 +32,8 @@ -M -$M16384,1048576 -K$00400000 --N"lib" --LE"c:\program files\borland\delphi7\Projects\Bpl" --LN"c:\program files\borland\delphi7\Projects\Bpl" +-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" +-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" -w-UNSAFE_TYPE -w-UNSAFE_CODE -w-UNSAFE_CAST