diff --git a/packages/libxml/src/xmlxsd.pas b/packages/libxml/src/xmlxsd.pas index a135f0e586..2c54162b86 100644 --- a/packages/libxml/src/xmlxsd.pas +++ b/packages/libxml/src/xmlxsd.pas @@ -14,6 +14,7 @@ uses ctypes, xml2, Math, + Classes, DateUtils, SysUtils; @@ -51,6 +52,7 @@ const CONVERT_TO_TIMEZONE_UTC: TTimezone = (Kind:tzUTC;Hour:0;Minute:0;Convert:True); { Format functions } +function xsdFormatBase64(Value: TStream): Utf8String; function xsdFormatBoolean(Value: Boolean; UseWords: Boolean = False): Utf8String; function xsdFormatDate(Year, Month, Day: Longword; BC: Boolean; Timezone: PTimezone = nil): Utf8String; function xsdFormatDate(Value: TDateTime; Timezone: PTimezone = nil): Utf8String; @@ -77,6 +79,7 @@ procedure xsdDateConvertTo(var Year, Month, Day: Longword; const Current, Target procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone); { Parse functions } +function xsdTryParseBase64(Chars: xmlCharPtr; Len: Integer; const Value: TStream): Boolean; function xsdTryParseString(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String): Boolean; function xsdTryParseStringLower(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String): Boolean; function xsdTryParseBoolean(Chars: xmlCharPtr; Len: Integer; out Value: Boolean): Boolean; @@ -128,6 +131,7 @@ function xsdParseUnsignedIntDef(Chars: xmlCharPtr; Len: Integer; Default: Longwo function xsdParseUnsignedLongDef(Chars: xmlCharPtr; Len: Integer; Default: QWord): QWord; function xsdParseEnumDef(Chars: xmlCharPtr; Len: Integer; enum: array of Utf8String; Default: Integer): Integer; +procedure xsdParseBase64(Chars: xmlCharPtr; Len: Integer; const Value: TStream); procedure xsdParseString(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String); procedure xsdParseStringLower(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String); procedure xsdParseBoolean(Chars: xmlCharPtr; Len: Integer; out Value: Boolean); @@ -180,6 +184,7 @@ function xsdParseUnsignedLong(Chars: xmlCharPtr; Len: Integer): QWord; function xsdParseEnum(Chars: xmlCharPtr; Len: Integer; enum: array of Utf8String): Integer; { Node creation functions } +function xsdNewChildBase64(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Value: TStream): xmlNodePtr; function xsdNewChildString(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Value: Utf8String): xmlNodePtr; function xsdNewChildBoolean(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Value: Boolean; UseWords: Boolean = False): xmlNodePtr; function xsdNewChildDate(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Year, Month, Day: Longword; BC: Boolean = False; Timezone: PTimezone = nil): xmlNodePtr; @@ -235,6 +240,7 @@ function xsdTestNode(node: xmlNodePtr; name, nameSpace: xmlCharPtr): Boolean; function xsdTryGetChild(node: xmlNodePtr; name, nameSpace: xmlCharPtr; Index: Integer = 0): xmlNodePtr; function xsdTryGetChild(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out child: xmlNodePtr; Index: Integer = 0): Boolean; function xsdTryGetChildChars(node: xmlNodePtr; name, nameSpace: xmlCharPtr; Index: Integer = 0): xmlCharPtr; +function xsdTryGetChildBase64(node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream; Index: Integer = 0): Boolean; function xsdTryGetChildString(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String; Index: Integer = 0): Boolean; function xsdTryGetChildBoolean(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Boolean; Index: Integer = 0): Boolean; function xsdTryGetChildDate(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone = nil; BC: PBoolean = nil; Index: Integer = 0): Boolean; @@ -258,6 +264,7 @@ function xsdTryGetChildEnum(node: xmlNodePtr; name, nameSpace: xmlCharPtr; enum: function xsdGetChild(node: xmlNodePtr; name, nameSpace: xmlCharPtr; Index: Integer = 0): xmlNodePtr; function xsdGetChildChars(node: xmlNodePtr; name, nameSpace: xmlCharPtr; Index: Integer = 0): xmlCharPtr; +procedure xsdGetChildBase64(node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream; Index: Integer = 0); procedure xsdGetChildString(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String; Index: Integer = 0); procedure xsdGetChildBoolean(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Boolean; Index: Integer = 0); procedure xsdGetChildDate(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone = nil; BC: PBoolean = nil; Index: Integer = 0); @@ -283,6 +290,7 @@ procedure xsdGetChildEnum(node: xmlNodePtr; name, nameSpace: xmlCharPtr; enum: a function xsdTryNext(var node: xmlNodePtr; name, nameSpace: xmlCharPtr): xmlNodePtr; function xsdTryNext(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out last: xmlNodePtr): Boolean; function xsdTryNextChars(var node: xmlNodePtr; name, nameSpace: xmlCharPtr): xmlCharPtr; +function xsdTryNextBase64(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream): Boolean; function xsdTryNextString(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String): Boolean; function xsdTryNextBoolean(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Boolean): Boolean; function xsdTryNextDate(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone = nil; BC: PBoolean = nil): Boolean; @@ -306,6 +314,7 @@ function xsdTryNextEnum(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; enum: function xsdNext(var node: xmlNodePtr; name, nameSpace: xmlCharPtr): xmlNodePtr; function xsdNextChars(var node: xmlNodePtr; name, nameSpace: xmlCharPtr): xmlCharPtr; +procedure xsdNextBase64(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream); procedure xsdNextString(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String); procedure xsdNextBoolean(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Boolean); procedure xsdNextDate(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone = nil; BC: PBoolean = nil); @@ -391,6 +400,72 @@ begin inherited CreateFmt(Msg, [S]); end; +function xsdFormatBase64(Value: TStream): Utf8String; +const + Base64: array[0..63] of char = ( + 'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P', + 'Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f', + 'g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v', + 'w','x','y','z','0','1','2','3','4','5','6','7','8','9','+','/' + ); + BufferSize = 3*512; { buffer size must be a multiple of 3 } +var + Buffer: array[0..BufferSize-1] of Byte; + Num, Ofs: Integer; + b1, b2, b3: Byte; +begin + Result := ''; + while True do + begin + Num := Value.Read(Buffer, BufferSize); + if Num = 0 then + Exit; + + Ofs := 0; + while Num >= 3 do + begin + b1 := Buffer[Ofs]; + b2 := Buffer[Ofs+1]; + b3 := Buffer[Ofs+2]; + + Result := Result + + Base64[b1 shr 2] + + Base64[((b1 and $3) shl 4) or (b2 shr 4)] + + Base64[((b2 and $F) shl 2) or (b3 shr 6)] + + Base64[b3 and $3F]; + + Num := Num - 3; + Ofs := Ofs + 3; + end; + + case Num of + 1: begin + b1 := Buffer[Ofs]; + + Result := Result + + Base64[b1 shr 2] + + Base64[((b1 and $3) shl 4)] + + '=='; + + Exit; + end; + + 2: begin + b1 := Buffer[Ofs]; + b2 := Buffer[Ofs+1]; + + Result := Result + + Base64[b1 shr 2] + + Base64[((b1 and $3) shl 4) or (b2 shr 4)] + + Base64[((b2 and $F) shl 2)] + + '='; + + Exit; + end; + end; + end; +end; + function xsdFormatBoolean(Value: Boolean; UseWords: Boolean): Utf8String; begin if UseWords then @@ -538,17 +613,17 @@ end; procedure xsdTimeConvertTo(var Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone); begin - {$warning not implemented} + {$warning xsdTimeConvertTo: not implemented} end; procedure xsdDateConvertTo(var Year, Month, Day: Longword; const Current, Target: TTimezone); begin - {$warning not implemented} + {$warning xsdDateConvertTo: not implemented} end; procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone); begin - {$warning not implemented} + {$warning xsdDateTimeConvertTo: not implemented} end; function __parseNonNegativeInteger(var P: PChar; const L: PChar; out Value: QWord): Boolean; @@ -859,6 +934,181 @@ begin Result := True; end; +function xsdTryParseBase64(Chars: xmlCharPtr; Len: Integer; const Value: TStream): Boolean; +const + BufferSize = 3*512; +var + Buffer: array[0..BufferSize-1] of Byte; + Ofs: Integer; + P,L: PByte; + p1,p2,p3,p4: Shortint; +begin + if Assigned(Chars) then + begin + Ofs := 0; + + P := PByte(Chars); + if Len >= 0 then + begin + if Len mod 4 <> 0 then + Exit(False); + + L := P + Len; + while P < L do + begin + case Chr(P^) of + 'A'..'Z': p1 := P^ - Ord('A'); + 'a'..'z': p1 := P^ - Ord('a') + 26; + '0'..'9': p1 := P^ - Ord('0') + 52; + '+' : p1 := 62; + '/' : p1 := 63; + else Exit(False); + end; + Inc(P); + + case Chr(P^) of + 'A'..'Z': p2 := P^ - Ord('A'); + 'a'..'z': p2 := P^ - Ord('a') + 26; + '0'..'9': p2 := P^ - Ord('0') + 52; + '+' : p2 := 62; + '/' : p2 := 63; + else Exit(False); + end; + Inc(P); + + case Chr(P^) of + 'A'..'Z': p3 := P^ - Ord('A'); + 'a'..'z': p3 := P^ - Ord('a') + 26; + '0'..'9': p3 := P^ - Ord('0') + 52; + '+' : p3 := 62; + '/' : p3 := 63; + '=' : p3 := -1; + else Exit(False); + end; + Inc(P); + + if (p3 >= 0) then + begin + case Chr(P^) of + 'A'..'Z': p4 := P^ - Ord('A'); + 'a'..'z': p4 := P^ - Ord('a') + 26; + '0'..'9': p4 := P^ - Ord('0') + 52; + '+' : p4 := 62; + '/' : p4 := 63; + '=' : p4 := -1; + else Exit(False); + end; + end else begin + if P^ <> Ord('=') then + Exit(False); + p4 := -1; + end; + Inc(P); + + Buffer[Ofs] := (p1 shl 2) or (p2 shr 4); + Ofs := Ofs + 1; + + if p3 >= 0 then + begin + Buffer[Ofs] := ((p2 and $F) shl 4) or (p3 shr 2); + Ofs := Ofs + 1; + + if p4 >= 0 then + begin + Buffer[Ofs] := ((p3 and $3) shl 6) or p4; + Ofs := Ofs + 1; + end; + end; + + if Ofs >= BufferSize-2 then + begin + Value.Write(Buffer, Ofs); + Ofs := 0; + end; + end; + end else begin + while P^ <> 0 do + begin + case Chr(P^) of + 'A'..'Z': p1 := P^ - Ord('A'); + 'a'..'z': p1 := P^ - Ord('a') + 26; + '0'..'9': p1 := P^ - Ord('0') + 52; + '+' : p1 := 62; + '/' : p1 := 63; + else Exit(False); + end; + Inc(P); + + case Chr(P^) of + 'A'..'Z': p2 := P^ - Ord('A'); + 'a'..'z': p2 := P^ - Ord('a') + 26; + '0'..'9': p2 := P^ - Ord('0') + 52; + '+' : p2 := 62; + '/' : p2 := 63; + else Exit(False); + end; + Inc(P); + + case Chr(P^) of + 'A'..'Z': p3 := P^ - Ord('A'); + 'a'..'z': p3 := P^ - Ord('a') + 26; + '0'..'9': p3 := P^ - Ord('0') + 52; + '+' : p3 := 62; + '/' : p3 := 63; + '=' : p3 := -1; + else Exit(False); + end; + Inc(P); + + if (p3 >= 0) then + begin + case Chr(P^) of + 'A'..'Z': p4 := P^ - Ord('A'); + 'a'..'z': p4 := P^ - Ord('a') + 26; + '0'..'9': p4 := P^ - Ord('0') + 52; + '+' : p4 := 62; + '/' : p4 := 63; + '=' : p4 := -1; + else Exit(False); + end; + end else begin + if P^ <> Ord('=') then + Exit(False); + p4 := -1; + end; + Inc(P); + + Buffer[Ofs] := (p1 shl 2) or (p2 shr 4); + Ofs := Ofs + 1; + + if p3 >= 0 then + begin + Buffer[Ofs] := ((p2 and $F) shl 4) or (p3 shr 2); + Ofs := Ofs + 1; + + if p4 >= 0 then + begin + Buffer[Ofs] := ((p3 and $3) shl 6) or p4; + Ofs := Ofs + 1; + end; + end; + + if Ofs >= BufferSize-2 then + begin + Value.Write(Buffer, Ofs); + Ofs := 0; + end; + end; + end; + + if Ofs > 0 then // flush + Value.Write(Buffer, Ofs); + + Result := True; + end else + Result := False; +end; + function xsdTryParseString(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String): Boolean; const AllocChars = 256; @@ -1444,6 +1694,12 @@ begin Result := Default; end; +procedure xsdParseBase64(Chars: xmlCharPtr; Len: Integer; const Value: TStream); +begin + if not xsdTryParseBase64(Chars, Len, Value) then + raise XSDException.CreateFmt(ParserError, [__strpas(Chars,Len), 'xs:base64Binary']); +end; + procedure xsdParseString(Chars: xmlCharPtr; Len: Integer; out Value: Utf8String); begin if not xsdTryParseString(Chars, Len, Value) then @@ -1714,6 +1970,13 @@ function xsdParseEnum(Chars: xmlCharPtr; Len: Integer; enum: array of Utf8String begin xsdParseEnum(Chars, Len, enum, Result); end; +function xsdNewChildBase64(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Value: TStream): xmlNodePtr; +var + Tmp: Utf8String; +begin + Tmp := xsdFormatBase64(Value); + Result := xmlNewChild(parent, ns, name, PChar(Tmp)); +end; function xsdNewChildString(parent: xmlNodePtr; ns: xmlNsPtr; name: xmlCharPtr; Value: Utf8String): xmlNodePtr; begin @@ -2072,6 +2335,11 @@ begin Result := xmlNodeGetContent(xsdTryGetChild(node, name, nameSpace, Index)); end; +function xsdTryGetChildBase64(node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream; Index: Integer): Boolean; +begin + Result := xsdTryParseBase64(xsdTryGetChildChars(node, name, nameSpace, Index), -1, Value); +end; + function xsdTryGetChildString(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String; Index: Integer): Boolean; begin Result := xsdTryParseString(xsdTryGetChildChars(node, name, nameSpace, Index), -1, Value); @@ -2184,6 +2452,11 @@ begin Result := xmlNodeGetContent(xsdGetChild(node, name, nameSpace, Index)); end; +procedure xsdGetChildBase64(node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream; Index: Integer); +begin + xsdParseBase64(xsdGetChildChars(node, name, nameSpace, Index), -1, Value); +end; + procedure xsdGetChildString(node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String; Index: Integer); begin xsdParseString(xsdGetChildChars(node, name, nameSpace, Index), -1, Value); @@ -2308,6 +2581,11 @@ begin Result := xmlNodeGetContent(xsdTryNext(node, name, nameSpace)); end; +function xsdTryNextBase64(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream): Boolean; +begin + Result := xsdTryParseBase64(xsdTryNextChars(node, name, nameSpace), -1, Value); +end; + function xsdTryNextString(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String): Boolean; begin Result := xsdTryParseString(xsdTryNextChars(node, name, nameSpace), -1, Value); @@ -2420,6 +2698,11 @@ begin Result := xmlNodeGetContent(xsdNext(node, name, nameSpace)); end; +procedure xsdNextBase64(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; const Value: TStream); +begin + xsdParseBase64(xsdNextChars(node, name, nameSpace), -1, Value); +end; + procedure xsdNextString(var node: xmlNodePtr; name, nameSpace: xmlCharPtr; out Value: Utf8String); begin xsdParseString(xsdNextChars(node, name, nameSpace), -1, Value);