Compatibility with newer XMLDataBinding
This commit is contained in:
parent
116eda1d96
commit
857be7f9bb
@ -11,6 +11,8 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes,
|
Classes,
|
||||||
SysUtils,
|
SysUtils,
|
||||||
|
XMLDoc,
|
||||||
|
xmldom,
|
||||||
XMLIntf;
|
XMLIntf;
|
||||||
|
|
||||||
|
|
||||||
@ -28,6 +30,37 @@ type
|
|||||||
end;
|
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
|
const
|
||||||
AllTimeFragments = [Low(TXMLTimeFragment)..High(TXMLTimeFragment)];
|
AllTimeFragments = [Low(TXMLTimeFragment)..High(TXMLTimeFragment)];
|
||||||
|
|
||||||
@ -42,9 +75,6 @@ const
|
|||||||
function FloatToXML(AValue: Extended): WideString;
|
function FloatToXML(AValue: Extended): WideString;
|
||||||
function XMLToFloat(const AValue: WideString): Extended;
|
function XMLToFloat(const AValue: WideString): Extended;
|
||||||
|
|
||||||
function Base64Encode(AValue: String): String;
|
|
||||||
function Base64Decode(AValue: String): String;
|
|
||||||
|
|
||||||
function GetNodeIsNil(ANode: IXMLNode): Boolean;
|
function GetNodeIsNil(ANode: IXMLNode): Boolean;
|
||||||
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
|
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
|
||||||
|
|
||||||
@ -54,6 +84,14 @@ const
|
|||||||
procedure SortChildNodes(AParent: IXMLNode; ASortOrder: 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
|
const
|
||||||
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
|
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
|
||||||
|
|
||||||
@ -78,6 +116,7 @@ const
|
|||||||
);
|
);
|
||||||
|
|
||||||
XMLIsNilAttribute = 'nil';
|
XMLIsNilAttribute = 'nil';
|
||||||
|
XMLIsNilAttributeNS = 'xsi:nil';
|
||||||
|
|
||||||
Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'];
|
Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/'];
|
||||||
Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
|
Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
|
||||||
@ -105,6 +144,66 @@ type
|
|||||||
end;
|
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;
|
function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments): string;
|
||||||
var
|
var
|
||||||
formatSettings: TFormatSettings;
|
formatSettings: TFormatSettings;
|
||||||
@ -299,128 +398,48 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
function Base64Encode(AValue: String): String;
|
function Base64Encode(AValue: String): String;
|
||||||
var
|
|
||||||
pos: Integer;
|
|
||||||
lookupIndex: array[0..3] of Byte;
|
|
||||||
padCount: Integer;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := '';
|
Result := MimeEncodeString(AValue);
|
||||||
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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function Base64Decode(AValue: String): String;
|
function Base64Decode(AValue: String): String;
|
||||||
|
begin
|
||||||
|
Result := MimeDecodeString(AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure Base64DecodeToStream(AValue: String; AStream: TStream);
|
||||||
var
|
var
|
||||||
pos: Integer;
|
input: TStringStream;
|
||||||
padCount: Integer;
|
|
||||||
value: Byte;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := '';
|
input := TStringStream.Create(AValue);
|
||||||
if Length(AValue) = 0 then
|
try
|
||||||
exit;
|
MimeDecodeStream(input, AStream);
|
||||||
|
finally
|
||||||
if Length(AValue) mod 4 <> 0 then
|
FreeAndNil(input);
|
||||||
raise EBase64Error.Create('Value length must be a multiple of 4');
|
end;
|
||||||
|
|
||||||
padCount := 0;
|
|
||||||
pos := Length(AValue);
|
|
||||||
|
|
||||||
{ Count padding chars }
|
|
||||||
while (pos > 0) and (AValue[pos] = Base64Padding) do
|
|
||||||
begin
|
|
||||||
Inc(padCount);
|
|
||||||
Dec(pos);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Result := '';
|
|
||||||
pos := 1;
|
|
||||||
|
|
||||||
while pos <= Length(AValue) - 3 do
|
procedure Base64DecodeToFile(AValue: String; const AFileName: String);
|
||||||
|
var
|
||||||
|
input: TStringStream;
|
||||||
|
output: TFileStream;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
value := (Base64LookupIndex(AValue[pos]) shl 2) or
|
input := TStringStream.Create(AValue);
|
||||||
(Base64LookupIndex(AValue[pos + 1]) shr 4);
|
try
|
||||||
Result := Result + Chr(value);
|
output := TFileStream.Create(AFileName, fmCreate or fmShareDenyWrite);
|
||||||
|
try
|
||||||
value := (Base64LookupIndex(AValue[pos + 1]) shl 4) or
|
MimeDecodeStream(input, output);
|
||||||
(Base64LookupIndex(AValue[pos + 2]) shr 2);
|
finally
|
||||||
Result := Result + Chr(value);
|
FreeAndNil(output);
|
||||||
|
end;
|
||||||
value := (Base64LookupIndex(AValue[pos + 2]) shl 6) or
|
finally
|
||||||
(Base64LookupIndex(AValue[pos + 3]));
|
FreeAndNil(input);
|
||||||
Result := Result + Chr(value);
|
|
||||||
|
|
||||||
Inc(pos, 4);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ Delete padding }
|
|
||||||
if padCount > 0 then
|
|
||||||
SetLength(Result, Length(Result) - padCount);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -432,11 +451,19 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
|
procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);
|
||||||
|
var
|
||||||
|
documentElement: IXMLNode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if ASetNil then
|
if ASetNil then
|
||||||
begin
|
begin
|
||||||
ANode.ChildNodes.Clear;
|
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
|
end else
|
||||||
ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI);
|
ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI);
|
||||||
end;
|
end;
|
||||||
@ -457,7 +484,7 @@ begin
|
|||||||
else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then
|
else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then
|
||||||
Result := LessThanValue
|
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)
|
Result := CompareValue(nodeInfo1^.OriginalIndex, nodeInfo2^.OriginalIndex)
|
||||||
|
|
||||||
else
|
else
|
||||||
@ -561,5 +588,323 @@ begin
|
|||||||
end;
|
end;
|
||||||
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.
|
end.
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user