Added: xsd:base64binary supports

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

Tests/X2XMLDataBindingTests.dpr

@@ -1,5 +1,6 @@
 program X2XMLDataBindingTests;
 
+{$APPTYPE CONSOLE}
 uses
   ActiveX,
   GUITestRunner,

Units/DelphiXMLDataBindingResources.pas

@@ -181,7 +181,8 @@ type
                        tcDateTime,
                        tcDate,
                        tcTime,
-                       tcString);
+                       tcString,
+                       tcBase64);
                        
   TTypeConversions  = set of TTypeConversion;
 
@@ -193,7 +194,7 @@ 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),
@@ -204,7 +205,8 @@ const
                         (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:  '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 }  '  %<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;'
+                                  { tcString }    '  %<Destination>:s := ChildNodes[''%<Source>:s''].Text;',
+                                  { tcBas64 }     '  %<Destination>:s := Base64Decode(Trim(ChildNodes[''%<Source>:s''].Text));'
                                 ),
                                 { dntAttribute }
                                 (
@@ -258,7 +262,8 @@ const
                                   { 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;'
+                                  { tcString }    '  %<Destination>:s := AttributeNodes[''%<Source>:s''].Text;',
+                                  { tcBase64 }    '  %<Destination>:s := Base64Decode(Trim(AttributeNodes[''%<Source>:s''].Text));'
                                 ),
                                 { dntCustom}
                                 (
@@ -268,7 +273,8 @@ const
                                   { tcDateTime }  '  %<Destination>:s := XMLToDateTime(%<Source>:s, xdtDateTime);',
                                   { tcDate }      '  %<Destination>:s := XMLToDateTime(%<Source>:s, xdtDate);',
                                   { tcTime }      '  %<Destination>:s := XMLToDateTime(%<Source>:s, xdtTime);',
-                                  { tcString }    ''
+                                  { tcString }    '',
+                                  { tcBase64 }    '  %<Destination>:s := Base64Decode(Trim(%<Source>:s));'
                                 )
                               ),
                               { daSet }
@@ -281,7 +287,8 @@ const
                                   { 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 }    ''
+                                  { tcString }    '',
+                                  { tcBase64 }    '  ChildNodes[''%<Destination>:s''].NodeValue := Base64Encode(%<Source>:s);'
                                 ),
                                 { dntAttribute }
                                 (
@@ -291,7 +298,8 @@ const
                                   { 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 }    ''
+                                  { tcString }    '',
+                                  { tcBase64 }    '  SetAttribute(''%<Destination>:s'', Base64Encode(%<Source>:s));'
                                 ),
                                 { dntCustom}
                                 (
@@ -301,7 +309,8 @@ const
                                   { tcDateTime }  '  %<Destination>:s := DateTimeToXML(%<Source>:s, xdtDateTime);',
                                   { tcDate }      '  %<Destination>:s := DateTimeToXML(%<Source>:s, xdtDate);',
                                   { tcTime }      '  %<Destination>:s := DateTimeToXML(%<Source>:s, xdtTime);',
-                                  { tcString }    ''
+                                  { tcString }    '',
+                                  { tcBase64 }    '  %<Destination>:s := Base64Encode(%<Source>:s);'
                                 )
                               )
                             );

X2XMLDataBinding.bdsproj

@@ -130,7 +130,7 @@
 			<Directories Name="UsePackages">False</Directories>
 		</Directories>
 		<Parameters>
-			<Parameters Name="RunParams">"F:\Archive\2007\XMLDataBinding\Tests\Data\02. Collection.xsd"</Parameters>
+			<Parameters Name="RunParams">"F:\Archive\2007\XMLDataBinding\DMS_export_import_formaat.xsd"</Parameters>
 			<Parameters Name="HostApplication"></Parameters>
 			<Parameters Name="Launcher"></Parameters>
 			<Parameters Name="UseLauncher">False</Parameters>

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:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
--LE"c:\program files\borland\delphi7\Projects\Bpl"
+-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
--LN"c:\program files\borland\delphi7\Projects\Bpl"
 -w-UNSAFE_TYPE
 -w-UNSAFE_CODE
 -w-UNSAFE_CAST