1
0
mirror of synced 2024-12-22 09:13:07 +01:00

Compatibility with newer XMLDataBinding

This commit is contained in:
Mark van Renswoude 2013-12-06 16:05:34 +00:00
parent 116eda1d96
commit 857be7f9bb

View File

@ -11,6 +11,8 @@ interface
uses
Classes,
SysUtils,
XMLDoc,
xmldom,
XMLIntf;
@ -28,6 +30,37 @@ type
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)];
@ -42,9 +75,6 @@ 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);
@ -52,7 +82,15 @@ const
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';
@ -78,6 +116,7 @@ const
);
XMLIsNilAttribute = 'nil';
XMLIsNilAttributeNS = 'xsi:nil';
Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'];
Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
@ -105,6 +144,66 @@ type
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;
@ -299,128 +398,48 @@ 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;
Result := MimeEncodeString(AValue);
end;
function Base64Decode(AValue: String): String;
begin
Result := MimeDecodeString(AValue);
end;
procedure Base64DecodeToStream(AValue: String; AStream: TStream);
var
pos: Integer;
padCount: Integer;
value: Byte;
input: TStringStream;
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);
input := TStringStream.Create(AValue);
try
MimeDecodeStream(input, AStream);
finally
FreeAndNil(input);
end;
Result := '';
pos := 1;
end;
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);
procedure Base64DecodeToFile(AValue: String; const AFileName: String);
var
input: TStringStream;
output: TFileStream;
value := (Base64LookupIndex(AValue[pos + 2]) shl 6) or
(Base64LookupIndex(AValue[pos + 3]));
Result := Result + Chr(value);
Inc(pos, 4);
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;
{ Delete padding }
if padCount > 0 then
SetLength(Result, Length(Result) - padCount);
end;
@ -432,11 +451,19 @@ end;
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
var
documentElement: IXMLNode;
begin
if ASetNil then
begin
ANode.ChildNodes.Clear;
ANode.SetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI, BoolToXML(True));
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;
@ -457,7 +484,7 @@ begin
else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then
Result := LessThanValue
else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex = -1) then
else if (nodeInfo1^.SortIndex = nodeInfo2^.SortIndex) then
Result := CompareValue(nodeInfo1^.OriginalIndex, nodeInfo2^.OriginalIndex)
else
@ -561,5 +588,323 @@ begin
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.