omnixmlutils.pas

OmniXML源码

function GetNodeAttrTime(parentNode: IXMLNode; attrName: string): TDateTime;
begin
  Result := XMLStrToTime(GetNodeAttrStr(parentNode, attrName));
end; { GetNodeAttrTime }

function XMLRealToStr(value: real): WideString;
begin
  Result := StringReplace(FloatToStr(value),
    DecimalSeparator, DEFAULT_DECIMALSEPARATOR, [rfReplaceAll]);
end; { XMLRealToStr }

function XMLExtendedToStr(value: extended): WideString;
begin
  Result := StringReplace(FloatToStr(value),
    DecimalSeparator, DEFAULT_DECIMALSEPARATOR, [rfReplaceAll]);
end; { XMLExtendedToStr }

function XMLCurrencyToStr(value: Currency): WideString;
begin
  Result := StringReplace(CurrToStr(value),
    DecimalSeparator, DEFAULT_DECIMALSEPARATOR, [rfReplaceAll]);
end; { XMLExtendedToStr }

function XMLIntToStr(value: integer): WideString;
begin
  Result := IntToStr(value);
end; { XMLIntToStr }

function XMLInt64ToStr(value: int64): WideString;
begin
  Result := IntToStr(value)
end; { XMLInt64ToStr }

function XMLBoolToStr(value: boolean): WideString;
begin
  if value then
    Result := DEFAULT_TRUE
  else
    Result := DEFAULT_FALSE;
end; { XMLBoolToStr }

function XMLDateTimeToStr(value: TDateTime): WideString;
begin
  Result := FormatDateTime('yyyy-mm-dd"'+
    DEFAULT_DATETIMESEPARATOR+'"hh":"mm":"ss.zzz',value)
end; { XMLDateTimeToStr }

function XMLDateTimeToStrEx(value: TDateTime): WideString;
begin
  if Trunc(value) = 0 then
    Result := XMLTimeToStr(value)
  else if Frac(Value) = 0 then
    Result := XMLDateToStr(value)
  else
    Result := XMLDateTimeToStr(value);
end; { XMLDateTimeToStrEx }

function XMLDateToStr(value: TDateTime): WideString;
begin
  Result := FormatDateTime('yyyy-mm-dd',value);
end; { XMLDateToStr }

function XMLTimeToStr(value: TDateTime): WideString;
begin
  Result := FormatDateTime('hh":"mm":"ss.zzz',value);
end; { XMLTimeToStr }

function XMLBinaryToStr(value: TStream): WideString;
var
  nodeStream: TStringStream;
begin
  value.Position := 0;
  nodeStream := TStringStream.Create('');
  try
    Base64Encode(value, nodeStream);
    Result := nodeStream.DataString;
  finally FreeAndNil(nodeStream); end;
end; { XMLBinaryToStr }

function XMLVariantToStr(value: Variant): WideString;
begin
  case VarType(value) of
    varSingle, varDouble, varCurrency:
      Result := XMLExtendedToStr(value);
    varDate:
      Result := XMLDateTimeToStrEx(value);
    varBoolean:
      Result := XMLBoolToStr(value);
    else
      Result := value;
  end; //case
end; { XMLVariantToStr }

function SetNodeCData(parentNode: IXMLNode; nodeTag: string;
  value: WideString): IXMLNode;
begin
  Result := EnsureNode(parentNode, nodeTag);
  SetCDataChild(Result, value);
end; { SetNodeCData }

function SetNodeText(parentNode: IXMLNode; nodeTag: string;
  value: WideString): IXMLNode;
begin
  Result := EnsureNode(parentNode, nodeTag);
  SetTextChild(Result, value);
end; { SetNodeText }

procedure SetNodesText(parentNode: IXMLNode; nodeTag: string;
  nodesText: TStrings); 
var
  childNode: IXMLNode;
  iText    : integer;
begin
  for iText := 0 to nodesText.Count-1 do begin
    childNode := OwnerDocument(parentNode).CreateElement(nodeTag);
    parentNode.AppendChild(childNode);
    childNode.Text := nodesText[iText];
  end; //for
end; { SetNodesText }

procedure SetNodesText(parentNode: IXMLNode; nodeTag: string;
  nodesText: string); 
var
  texts: TStringList;
begin
  texts := TStringList.Create;
  try
    texts.Text := nodesText;
    SetNodesText(parentNode, nodeTag, texts);
  finally FreeAndNil(texts); end;
end; { SetNodesText }

function SetNodeTextStr(parentNode: IXMLNode; nodeTag: string;
  value: WideString): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,value);
end; { SetNodeTextStr }

function SetNodeTextValueStr(parentNode: IXMLNode; nodeTag: string;
  value: WideString): IXMLNode;
begin
  if Length(value)=0 then
    Result := nil
  else
    Result := SetNodeText(parentNode,nodeTag,value);
end;

function SetNodeTextReal(parentNode: IXMLNode; nodeTag: string;
  value: real): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLRealToStr(value));
end; { SetNodeTextReal }

function SetNodeTextValueReal(parentNode: IXMLNode; nodeTag: string;
  value: real): IXMLNode;
begin
  if value=0 then
    Result := nil
  else
    Result := SetNodeText(parentNode,nodeTag,XMLRealToStr(value));
end; { SetNodeTextReal }

function SetNodeTextInt(parentNode: IXMLNode; nodeTag: string;
  value: integer): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLIntToStr(value));
end; { SetNodeTextInt }

function SetNodeTextValueInt(parentNode: IXMLNode; nodeTag: string;
  value: integer): IXMLNode;
begin
  if value=0 then
    Result := nil
  else
    Result := SetNodeTextInt(parentNode, nodeTag, value);
end;

function SetNodeTextInt64(parentNode: IXMLNode; nodeTag: string;
  value: int64): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLInt64ToStr(value));
end; { SetNodeTextInt64 }

function SetNodeTextBool(parentNode: IXMLNode; nodeTag: string;
  value: boolean): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLBoolToStr(value));
end; { SetNodeTextBool }

function SetNodeTextDateTime(parentNode: IXMLNode; nodeTag: string;
  value: TDateTime): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLDateTimeToStr(value));
end; { SetNodeTextDateTime }

function SetNodeTextDate(parentNode: IXMLNode; nodeTag: string;
  value: TDateTime): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLDateToStr(value));
end; { SetNodeTextDate }

function SetNodeTextTime(parentNode: IXMLNode; nodeTag: string;
  value: TDateTime): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLTimeToStr(value));
end; { SetNodeTextTime }

function SetNodeTextBinary(parentNode: IXMLNode; nodeTag: string;
  const value: TStream): IXMLNode;
begin
  Result := SetNodeText(parentNode,nodeTag,XMLBinaryToStr(value));
end; { SetNodeTextBinary }

function SetNodeTextFont(parentNode: IXMLNode; nodeTag: string;
  value: TFont): IXMLNode;
var
  fontNode  : IXMLNode;
  fStyle    : TFontStyles;
  iStyle    : integer;
begin
  fontNode := EnsureNode(parentNode, nodeTag);
  SetNodeTextStr(fontNode, 'Name', value.Name);
  SetNodeAttrInt(fontNode, 'Charset', value.Charset);
  SetNodeAttrInt(fontNode, 'Color', value.Color);
  SetNodeAttrInt(fontNode, 'Height', value.Height);
  SetNodeAttrInt(fontNode, 'Pitch', Ord(value.Pitch));
  SetNodeAttrInt(fontNode, 'Size', value.Size);
  fStyle := value.Style;
  iStyle := 0;
  Move(fStyle, iStyle, SizeOf(TFontStyles));
  SetNodeAttrInt(fontNode, 'Style', iStyle);
end; { SetNodeTextFont }

procedure SetNodeAttr(parentNode: IXMLNode; attrName: string;
  value: WideString);
var
  attrNode: IXMLNode;
begin
  attrNode := OwnerDocument(parentNode).CreateAttribute(attrName);
  attrNode.NodeValue := value;
  parentNode.Attributes.SetNamedItem(attrNode);
end; { SetNodeAttr }

procedure SetNodeAttrStr(parentNode: IXMLNode; attrName: string;
  value: WideString);
begin
  SetNodeAttr(parentNode,attrName,value);
end; { SetNodeAttrStr }

procedure SetNodeAttrReal(parentNode: IXMLNode; attrName: string;
  value: real);
begin
  SetNodeAttr(parentNode,attrName,XMLRealToStr(value));
end; { SetNodeAttrReal }

procedure SetNodeAttrInt(parentNode: IXMLNode; attrName: string;
  value: integer);
begin
  SetNodeAttr(parentNode,attrName,XMLIntToStr(value));
end; { SetNodeAttrInt }

procedure SetNodeAttrValueInt(parentNode: IXMLNode; attrName: string;
  value: integer);
begin
  if value<>0 then
    SetNodeAttr(parentNode,attrName,XMLIntToStr(value));
end; { SetNodeAttrInt }

procedure SetNodeAttrInt64(parentNode: IXMLNode; attrName: string;
  value: int64);
begin
  SetNodeAttr(parentNode,attrName,XMLInt64ToStr(value));
end; { SetNodeAttrInt64 }

procedure SetNodeAttrBool(parentNode: IXMLNode; attrName: string;
  value: boolean);
begin
  SetNodeAttr(parentNode,attrName,XMLBoolToStr(value));
end; { SetNodeAttrBool }

procedure SetNodeAttrDateTime(parentNode: IXMLNode; attrName: string;
  value: TDateTime);
begin
  SetNodeAttr(parentNode,attrName,XMLDateTimeToStr(value));
end; { SetNodeAttrDateTime }

procedure SetNodeAttrDate(parentNode: IXMLNode; attrName: string;
  value: TDateTime);
begin
  SetNodeAttr(parentNode,attrName,XMLDateToStr(value));
end; { SetNodeAttrDate }

procedure SetNodeAttrTime(parentNode: IXMLNode; attrName: string;
  value: TDateTime);
begin
  SetNodeAttr(parentNode,attrName,XMLTimeToStr(value));
end; { SetNodeAttrTime }

{$IFNDEF USE_MSXML}
function InternalFilterNodes(parentNode: IXMLNode; matchesName,
  matchesText: string;
  matchOnGrandchildrenName, matchOnGrandchildrenText: boolean;
  matchesChildNames, matchesChildText: array of string): IXMLNodeList;
var
  childNode  : IXMLNode;
  grandNode  : IXMLNode;
  iGrandChild: integer;
  iNode      : integer;
  matches    : boolean;
begin
  Result := TXMLNodeList.Create;
  iNode := 0;
  while iNode < parentNode.ChildNodes.Length do begin
    childNode := parentNode.ChildNodes.Item[iNode];
    if childNode.NodeType = ELEMENT_NODE then begin
      matches := true;
      if matches and (matchesName <> '') then
        matches := (childNode.NodeName = matchesName);
      if matches and (matchesText <> '') then
        matches := (Trim(childNode.Text) = matchesText);
      if matches and matchOnGrandchildrenName then begin
        for iGrandChild := Low(matchesChildNames) to High(matchesChildNames) do
        begin
          grandNode := childNode.SelectSingleNode(matchesChildNames[iGrandChild]);
          if not assigned(grandNode) then begin
            matches := false;
            break; //for
          end
          else begin
            if matchOnGrandchildrenText and
               (iGrandChild >= Low(matchesChildText)) and
               (iGrandChild <= High(matchesChildText)) then
              matches := (Trim(grandNode.Text) = matchesChildText[iGrandChild]);
          end;
        end; //for
      end;
      if matches then
        Result.AddNode(parentNode.ChildNodes.Item[iNode]);
    end;
    Inc(iNode);
  end;
end; { InternalFilterNodes }

{:@param   parentNode        Parent node for the filter operation.
  @param   matchesName       If not empty, child node name is checked. Only if
                             equal to this parameter, child node can be
                             included in the result list.
  @param   matchesText       If not empty, child node text is checked. Only if
                             equal to this parameter, child node can be
                             included in the result list.
  @param   matchesChildNames If not empty, grandchildren nodes with specified
                             names must exist. Only if they exist, child node
                             can be included in the result list.
  @param   matchesChildText  If not empty, grandchildren nodes text is checked.
                             For each grandchildren node named
                             matchesChildNames[], its text must equal
                             matchesChildText[]. Only if this condition is
                             satisfied, child node can be included in the result
                             list.
  @returns List of child nodes that satisfy conditions described above.
  @since   2001-09-25
}
function FilterNodes(parentNode: IXMLNode; matchesName, matchesText: string;
  matchesChildNames, matchesChildText: array of string): IXMLNodeList;
begin
  Result := InternalFilterNodes(parentNode, matchesName, matchesText,
    true, true, matchesChildNames, matchesChildText);
end; { FilterNodes }

{:@param   parentNode        Parent node for the filter operation.
  @param   matchesName       If not empty, child node name is checked. Only if
                             equal to this parameter, child node can be
                             included in the result list.
  @param   matchesText       If not empty, child node text is checked. Only if
                             equal to this parameter, child node can be
                             included in the result list.
  @param   matchesChildNames If not empty, grandchildren nodes with specified
                             names must exist. Only if they exist, child node
                             can be included in the result list.
  @returns List of child nodes tha