diff --git a/XMLDataBindingUtils.pas b/XMLDataBindingUtils.pas new file mode 100644 index 0000000..bf1cda4 --- /dev/null +++ b/XMLDataBindingUtils.pas @@ -0,0 +1,563 @@ +{ + Helpers functions for the X2Software XML Data Binding + + Last changed: $Date: 2010-07-15 12:57:03 +0200 (do, 15 jul 2010) $ + Revision: $Rev: 54 $ + URL: $URL: http://svn.kamadev.net/private/XMLDataBinding/trunk/Shared/XMLDataBindingUtils.pas $ +} +unit XMLDataBindingUtils; + +interface +uses + Classes, + SysUtils, + XMLIntf; + + +type + EBase64Error = class(Exception); + + TXMLDateTimeFormat = (xdtDateTime, xdtDate, xdtTime); + TXMLTimeFragment = (xtfMilliseconds, xtfTimezone); + TXMLTimeFragments = set of TXMLTimeFragment; + + + IXSDValidate = interface + ['{3BFDC851-7459-403B-87B3-A52E9E85BC8C}'] + procedure XSDValidate; + end; + + +const + AllTimeFragments = [Low(TXMLTimeFragment)..High(TXMLTimeFragment)]; + + + + function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments = AllTimeFragments): string; + function XMLToDateTime(const ADate: string; AFormat: TXMLDateTimeFormat): TDateTime; + + function BoolToXML(AValue: Boolean): WideString; + function XMLToBool(const AValue: WideString): Boolean; + + 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); + + procedure XSDValidate(AParent: IXMLNode; ARecurse: Boolean = True; AValidateParent: Boolean = True); + procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string); + procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string); + procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string); + + +const + XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance'; + + XMLDateFormat = 'yyyy"-"mm"-"dd'; + XMLTimeFormat = 'hh":"nn":"ss'; + XMLMsecsFormat = '"."zzz'; + XMLTimezoneZulu = 'Z'; + XMLTimezoneFormat = '%s%.2d:%.2d'; + + XMLDateTimeFormats: array[TXMLDateTimeFormat] of String = + ( + XMLDateFormat + '"T"' + XMLTimeFormat, + XMLDateFormat, + XMLTimeFormat + ); + + XMLTimezoneSigns: array[Boolean] of Char = ('-', '+'); + XMLBoolValues: array[Boolean] of String = + ( + 'false', + 'true' + ); + + XMLIsNilAttribute = 'nil'; + + Base64ValidChars = ['A'..'Z', 'a'..'z', '0'..'9', '+', '/']; + Base64LookupTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + + 'abcdefghijklmnopqrstuvwxyz' + + '0123456789+/'; + Base64Padding = '='; + + +implementation +uses + DateUtils, + Math, + Types, + Windows; + + +type + PSortNodeInfo = ^TSortNodeInfo; + TSortNodeInfo = record + Node: IXMLNode; + SortIndex: Integer; + OriginalIndex: Integer; + end; + + +function DateTimeToXML(ADate: TDateTime; AFormat: TXMLDateTimeFormat; ATimeFragments: TXMLTimeFragments): string; +var + formatSettings: TFormatSettings; + timeZone: TTimeZoneInformation; + timeOffset: Integer; + +begin + GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, formatSettings); + Result := FormatDateTime(XMLDateTimeFormats[AFormat], ADate, formatSettings); + + if AFormat in [xdtDateTime, xdtTime] then + begin + if xtfMilliseconds in ATimeFragments then + Result := Result + FormatDateTime(XMLMsecsFormat, ADate); + + if xtfTimezone in ATimeFragments then + begin + FillChar(timeZone, SizeOf(TTimeZoneInformation), #0); + if GetTimeZoneInformation(timeZone) <> TIME_ZONE_ID_INVALID then + begin + timeOffset := -timeZone.Bias; + + if timeOffset = 0 then + Result := Result + XMLTimezoneZulu + else + Result := Result + Format(XMLTimezoneFormat, + [XMLTimezoneSigns[timeOffset > 0], + Abs(timeZone.Bias div 60), + Abs(timeZone.Bias mod 60)]); + end; + end; + end; +end; + + +function XMLToDateTime(const ADate: string; AFormat: TXMLDateTimeFormat): TDateTime; +const + { yyyy-mm-ddThh:nn:ss.zzz+xx:xx } + XMLTimeSeparatorPos = 11; + XMLTimeSeparator = 'T'; + XMLMinTimeLength = 8; + +var + date: string; + time: string; + year: Integer; + month: Integer; + day: Integer; + hour: Integer; + minute: Integer; + second: Integer; + msec: Integer; + hasTimezone: Boolean; + xmlOffset: Integer; + timeZone: TTimeZoneInformation; + localOffset: Integer; + +begin + Result := 0; + date := ''; + time := ''; + + case AFormat of + xdtDateTime: + begin + if (Length(ADate) < XMLTimeSeparatorPos) or + (ADate[XMLTimeSeparatorPos] <> XMLTimeSeparator) then + Exit; + + date := ADate; + time := ADate; + SetLength(date, Pred(XMLTimeSeparatorPos)); + Delete(time, 1, XMLTimeSeparatorPos); + end; + + xdtDate: + begin + if Length(ADate) < Pred(XMLTimeSeparatorPos) then + Exit; + + date := ADate; + end; + + xdtTime: + begin + if Length(ADate) < XMLMinTimeLength then + Exit; + + time := ADate; + end; + end; + + if AFormat in [xdtDateTime, xdtDate] then + begin + { Parse date (yyyy-mm-hh) } + if TryStrToInt(Copy(date, 1, 4), year) and + TryStrToInt(Copy(date, 6, 2), month) and + TryStrToInt(Copy(date, 9, 2), day) then + Result := EncodeDate(year, month, day); + end; + + if AFormat in [xdtDateTime, xdtTime] then + begin + { Parse time (hh:nn:ss) } + if TryStrToInt(Copy(time, 1, 2), hour) and + TryStrToInt(Copy(time, 4, 2), minute) and + TryStrToInt(Copy(time, 7, 2), second) then + begin + msec := 0; + Delete(time, 1, 8); + + if Length(time) > 0 then + begin + if time[1] = '.' then + begin + { Parse milliseconds (.zzz) } + if not TryStrToInt(Copy(time, 2, 3), msec) then + msec := 0; + + Delete(time, 1, 4); + end; + end; + + Result := Result + EncodeTime(hour, minute, second, msec); + + if Length(time) > 0 then + begin + hasTimezone := False; + xmlOffset := 0; + + if time[1] = XMLTimezoneZulu then + begin + { Zulu time } + hasTimezone := True; + end else if time[1] in [XMLTimezoneSigns[False], XMLTimezoneSigns[True]] then + begin + { Parse timezone ([+|-]xx:xx) } + if TryStrToInt(Copy(time, 2, 2), hour) and + TryStrToInt(Copy(time, 5, 2), minute) then + begin + xmlOffset := (hour * MinsPerHour) + minute; + hasTimezone := True; + + if time[1] = XMLTimezoneSigns[False] then + xmlOffset := -xmlOffset; + end; + end; + + if hasTimezone then + begin + FillChar(timeZone, SizeOf(TTimeZoneInformation), #0); + if GetTimeZoneInformation(timeZone) <> TIME_ZONE_ID_INVALID then + begin + localOffset := -timeZone.Bias; + Result := IncMinute(Result, localOffset - xmlOffset); + end; + end; + end; + end; + end; +end; + + +function BoolToXML(AValue: Boolean): WideString; +begin + Result := XMLBoolValues[AValue]; +end; + + +function XMLToBool(const AValue: WideString): Boolean; +begin + Result := StrToBoolDef(AValue, False); +end; + + +function GetXMLFloatFormatSettings(): TFormatSettings; +begin + Result.DecimalSeparator := '.'; +end; + + +function FloatToXML(AValue: Extended): WideString; +begin + Result := FloatToStr(AValue, GetXMLFloatFormatSettings()); +end; + + +function XMLToFloat(const AValue: WideString): Extended; +begin + Result := StrToFloat(AValue, GetXMLFloatFormatSettings()); +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 + XMLToBool(ANode.GetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI)); +end; + + +procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean); +begin + if ASetNil then + begin + ANode.ChildNodes.Clear; + ANode.SetAttributeNS(XMLIsNilAttribute, XMLSchemaInstanceURI, BoolToXML(True)); + end else + ANode.AttributeNodes.Delete(XMLIsNilAttribute, XMLSchemaInstanceURI); +end; + + +function DoSortNodes(Item1, Item2: Pointer): Integer; +var + nodeInfo1: PSortNodeInfo; + nodeInfo2: PSortNodeInfo; + +begin + nodeInfo1 := Item1; + nodeInfo2 := Item2; + + if (nodeInfo1^.SortIndex > -1) and (nodeInfo2^.SortIndex = -1) then + Result := GreaterThanValue + + else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex > -1) then + Result := LessThanValue + + else if (nodeInfo1^.SortIndex = -1) and (nodeInfo2^.SortIndex = -1) then + Result := CompareValue(nodeInfo1^.OriginalIndex, nodeInfo2^.OriginalIndex) + + else + Result := CompareValue(nodeInfo1^.SortIndex, nodeInfo2^.SortIndex); +end; + + +procedure XSDValidate(AParent: IXMLNode; ARecurse, AValidateParent: Boolean); +var + validate: IXSDValidate; + childIndex: Integer; + +begin + if AValidateParent and Supports(AParent, IXSDValidate, validate) then + validate.XSDValidate; + + if ARecurse then + begin + for childIndex := 0 to Pred(AParent.ChildNodes.Count) do + XSDValidate(AParent.ChildNodes[childIndex], ARecurse, True); + end; +end; + + +procedure CreateRequiredElements(AParent: IXMLNode; ANodes: array of string); +var + nodeIndex: Integer; + node: IXMLNode; + +begin + for nodeIndex := Low(ANodes) to High(ANodes) do + begin + if not Assigned(AParent.ChildNodes.FindNode(ANodes[nodeIndex])) then + begin + node := AParent.OwnerDocument.CreateElement(ANodes[nodeIndex], AParent.NamespaceURI); + AParent.ChildNodes.Add(node); + end; + end; +end; + + +procedure CreateRequiredAttributes(AParent: IXMLNode; ANodes: array of string); +var + nodeIndex: Integer; + +begin + for nodeIndex := Low(ANodes) to High(ANodes) do + begin + if not Assigned(AParent.AttributeNodes.FindNode(ANodes[nodeIndex])) then + AParent.Attributes[ANodes[nodeIndex]] := ''; + end; +end; + + +procedure SortChildNodes(AParent: IXMLNode; ASortOrder: array of string); +var + sortList: TList; + nodeInfo: PSortNodeInfo; + childIndex: Integer; + sortIndex: Integer; + node: IXMLNode; + +begin + sortList := TList.Create; + try + { Build a list of the child nodes, with their original index and the + index in the ASortOrder array. } + for childIndex := 0 to Pred(AParent.ChildNodes.Count) do + begin + New(nodeInfo); + nodeInfo^.Node := AParent.ChildNodes[childIndex]; + nodeInfo^.OriginalIndex := childIndex; + + for sortIndex := Low(ASortOrder) to High(ASortOrder) do + begin + if ASortOrder[sortIndex] = nodeInfo^.Node.NodeName then + begin + nodeInfo^.SortIndex := sortIndex; + Break; + end; + end; + + sortList.Add(nodeInfo); + end; + + sortList.Sort(DoSortNodes); + + { Rebuild the ChildNodes list } + for childIndex := 0 to Pred(sortList.Count) do + begin + node := PSortNodeInfo(sortList[childIndex])^.Node; + + AParent.ChildNodes.Remove(node); + AParent.ChildNodes.Insert(childIndex, node); + end; + finally + for sortIndex := 0 to Pred(sortList.Count) do + Dispose(PSortNodeInfo(sortList[sortIndex])); + + FreeAndNil(sortList); + end; +end; + +end. +