omnixmlutils.pas

OmniXML源码

    outb[2] := alphabet[((inb[1] and $03) shl 4) or (inb[2] shr 4)];
    outb[3] := alphabet[(inb[2] and $0f) shl 2];
    outb[4] := Ord('=');
    encoded.Write(outb,4);
  end;
end; { Base64Encode }

procedure Base64Encode(decoded: TStream; var encoded: string); overload;
var
  encStr: TStringStream;
begin
  encStr := TStringStream.Create('');
  try
    Base64Encode(decoded, encStr);
    encoded := encStr.DataString;
  finally FreeAndNil(encStr); end;
end; { Base64Encode }

procedure Base64Encode(const decoded: string; var encoded: string);
var
  decStr: TStringStream;
begin
  decStr := TStringStream.Create(decoded);
  try
    Base64Encode(decStr, encoded);
  finally FreeAndNil(decStr); end;
end; { Base64Encode }

{:Checks whether the specified node is an xml document node.
  @since   2003-01-13
}
function IsDocument(node: IXMLNode): boolean;
var
  docNode: IXMLDocument;
begin
  Result := Supports(node, IXMLDocument, docNode);
end; { IsDocument }

{:@since   2003-01-13
}
function OwnerDocument(node: IXMLNode): IXMLDocument;
begin
  if not Supports(node, IXMLDocument, Result) then
    Result := node.OwnerDocument;
end; { OwnerDocument }

{:@since   2003-01-13
}
function DocumentElement(node: IXMLNode): IXMLElement;
begin
  Result := OwnerDocument(node).DocumentElement;
end; { DocumentElement }

{:@since   2003-01-13
}
function GetTextChild(node: IXMLNode): IXMLNode;
var
  iText: integer;
begin
  Result := nil;
  for iText := 0 to node.ChildNodes.Length-1 do
    if node.ChildNodes.Item[iText].NodeType = TEXT_NODE then begin
      Result := node.ChildNodes.Item[iText];
      break; //for
    end;
end; { GetTextChild }

{:@since   2003-12-12
}
function GetCDataChild(node: IXMLNode): IXMLNode;
var
  iText: integer;
begin
  Result := nil;
  for iText := 0 to node.ChildNodes.Length-1 do
    if node.ChildNodes.Item[iText].NodeType = CDATA_SECTION_NODE then begin
      Result := node.ChildNodes.Item[iText];
      break; //for
    end;
end; { GetCDataChild }

{:@since   2003-01-13
}
function SetTextChild(node: IXMLNode; value: WideString): IXMLNode;
var
  iText: integer;
begin
  iText := 0;
  while iText < node.ChildNodes.Length do begin
    if node.ChildNodes.Item[iText].NodeType = TEXT_NODE then
      node.RemoveChild(node.ChildNodes.Item[iText])
    else
      Inc(iText);
  end; //while
  Result := OwnerDocument(node).CreateTextNode(value);
  node.AppendChild(Result);
end; { SetTextChild }

{:@since   2003-12-12
}
function SetCDataChild(node: IXMLNode; value: WideString): IXMLNode;
var
  iText: integer;
begin
  iText := 0;
  while iText < node.ChildNodes.Length do begin
    if node.ChildNodes.Item[iText].NodeType = CDATA_SECTION_NODE then
      node.RemoveChild(node.ChildNodes.Item[iText])
    else
      Inc(iText);
  end; //while
  Result := OwnerDocument(node).CreateCDATASection(value);
  node.AppendChild(Result);
end; { SetCDataChild }

{:@param   parentNode Parent of the node to be deleted.
  @param   nodeTag    Name of the node (which is child of parentNode) to be
                      deleted.
}
procedure DeleteNode(parentNode: IXMLNode; nodeTag: string);
var
  myNode: IXMLNode;
begin
  myNode := parentNode.SelectSingleNode(nodeTag);
  if assigned(myNode) then
    parentNode.RemoveChild(myNode);
end; { DeleteNode }

{:@param   parentNode Node containing children to be deleted.
  @param   pattern    Name of the children nodes that have to be deleted. If
                      empty, all children will be deleted.
}
procedure DeleteAllChildren(parentNode: IXMLNode; pattern: string = '');
var
  myNode  : IXMLNode;
  oldText : WideString;
  textNode: IXMLNode;
begin
  textNode := GetTextChild(parentNode);
  if assigned(textNode) then // following code will delete TEXT_NODE
    oldText := textNode.Text;
  repeat
    if pattern = '' then
      myNode := parentNode.FirstChild
    else
      myNode := parentNode.SelectSingleNode(pattern);
    if assigned(myNode) then
      parentNode.RemoveChild(myNode);
  until not assigned(myNode);
  if assigned(textNode) then 
    SetTextChild(parentNode, oldText);
end; { DeleteAllChildren }

function XMLStrToReal(nodeValue: WideString; var value: real): boolean;
begin
  try
    value := XMLStrToReal(nodeValue);
    Result := true;
  except
    on EConvertError do
      Result := false;
  end;
end; { XMLStrToReal }

function XMLStrToReal(nodeValue: WideString): real;
begin
  Result := StrToFloat(StringReplace(nodeValue, DEFAULT_DECIMALSEPARATOR,
    DecimalSeparator, [rfReplaceAll]));
end; { XMLStrToReal }

function XMLStrToRealDef(nodeValue: WideString; defaultValue: real): real;
begin
  if not XMLStrToReal(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToRealDef }

function XMLStrToExtended(nodeValue: WideString; var value: extended): boolean;
begin
  try
    value := XMLStrToExtended(nodeValue);
    Result := true;
  except
    on EConvertError do
      Result := false;
  end;
end; { XMLStrToExtended }

function XMLStrToExtended(nodeValue: WideString): extended;
begin
  try
    Result := StrToFloat(StringReplace(nodeValue, DEFAULT_DECIMALSEPARATOR,
      DecimalSeparator, [rfReplaceAll]));
  except
    on EConvertError do begin
      if (nodeValue = 'INF') or (nodeValue = '+INF') then 
        Result := 1.1e+4932
      else if nodeValue = '-INF' then
        Result := 3.4e-4932
      else
        raise;
    end;
  end;
end; { XMLStrToExtended }

function XMLStrToExtendedDef(nodeValue: WideString; defaultValue: extended): extended;
begin
  if not XMLStrToExtended(nodeValue, Result) then
    Result := defaultValue;
end; { XMLStrToExtendedDef }

function StrToCurr(const S: string): Currency;
begin
  TextToFloat(PChar(S), Result, fvCurrency);
end; { StrToCurr }

function XMLStrToCurrency(nodeValue: WideString; var value: Currency): boolean;
begin
  try
    value := XMLStrToCurrency(nodeValue);
    Result := true;
  except
    on EConvertError do
      Result := false;
  end;
end; { XMLStrToCurrency }

function XMLStrToCurrency(nodeValue: WideString): Currency;
begin
  Result := StrToCurr(StringReplace(nodeValue, DEFAULT_DECIMALSEPARATOR,
    DecimalSeparator, [rfReplaceAll]));
end; { XMLStrToCurrency }

function XMLStrToCurrencyDef(nodeValue: WideString; defaultValue: Currency): Currency;
begin
  if not XMLStrToCurrency(nodeValue, Result) then
    Result := defaultValue;
end; { XMLStrToCurrencyDef }

function XMLStrToInt(nodeValue: WideString; var value: integer): boolean;
begin
  try
    value := XMLStrToInt(nodeValue);
    Result := true;
  except
    on EConvertError do
      Result := false;
  end;
end; { XMLStrToInt }

function XMLStrToInt(nodeValue: WideString): integer;
begin
  Result := StrToInt(nodeValue);
end; { XMLStrToInt }

function XMLStrToIntDef(nodeValue: WideString; defaultValue: integer): integer;
begin
  if not XMLStrToInt(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToIntDef }

function XMLStrToInt64(nodeValue: WideString; var value: int64): boolean;
begin
  try
    value := XMLStrToInt64(nodeValue);
    Result := true;
  except
    on EConvertError do
      Result := false;
  end;
end; { XMLStrToInt64 }

function XMLStrToInt64(nodeValue: WideString): int64;
begin
  Result := StrToInt64(nodeValue);
end; { XMLStrToInt64 }

function XMLStrToInt64Def(nodeValue: WideString; defaultValue: int64): int64;
begin
  if not XMLStrToInt64(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToInt64Def }

function XMLStrToBool(nodeValue: WideString; var value: boolean): boolean;
begin
  if nodeValue = DEFAULT_TRUE then begin
    value := true;
    Result := true;
  end
  else if nodeValue = DEFAULT_FALSE then begin
    value := false;
    Result := true;
  end
  else
    Result := false;
end; { XMLStrToBool }

function XMLStrToBool(nodeValue: WideString): boolean; overload;
begin
  if not XMLStrToBool(nodeValue, Result) then
    raise EOmniXMLUtils.CreateFmt('%s is not a boolean value', [nodeValue]);
end; { XMLStrToBool }

function XMLStrToBoolDef(nodeValue: WideString; defaultValue: boolean): boolean;
begin
  if not XMLStrToBool(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToBoolDef }

function XMLStrToDateTime(nodeValue: WideString; var value: TDateTime): boolean;
begin
  try
    value := ISODateTime2DateTime(nodeValue);
    Result := true;
  except
    Result := false;
  end;
end; { XMLStrToDateTime }

function XMLStrToDateTime(nodeValue: WideString): TDateTime;
begin
  if not XMLStrToDateTime(nodeValue, Result) then
    raise EOmniXMLUtils.CreateFmt('%s is not an ISO datetime value', [nodeValue]);
end; { XMLStrToDateTime }

function XMLStrToDateTimeDef(nodeValue: WideString; defaultValue: TDateTime): TDateTime;
begin
  if not XMLStrToDateTime(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToDateTimeDef }

function XMLStrToDate(nodeValue: WideString; var value: TDateTime): boolean;
begin
  try
    value := Int(ISODateTime2DateTime(nodeValue));
    Result := true;
  except
    Result := false;
  end;
end; { XMLStrToDate }

function XMLStrToDate(nodeValue: WideString): TDateTime;
begin
  if not XMLStrToDate(nodeValue, Result) then
    raise EOmniXMLUtils.CreateFmt('%s is not an ISO date value', [nodeValue]);
end; { XMLStrToDate }

function XMLStrToDateDef(nodeValue: WideString; defaultValue: TDateTime): TDateTime;
begin
  if not XMLStrToDate(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToDateDef }

function XMLStrToTime(nodeValue: WideString; var value: TDateTime): boolean;
begin
  try
    value := Str2Time(nodeValue);
    Result := true;
  except
    Result := false;
  end;
end; { XMLStrToTime }

function XMLStrToTime(nodeValue: WideString): TDateTime;
begin
  if not XMLStrToTime(nodeValue, Result) then
    raise EOmniXMLUtils.CreateFmt('%s is not a time value', [nodeValue]);
end; { XMLStrToTime }

function XMLStrToTimeDef(nodeValue: WideString; defaultValue: TDateTime): TDateTime;
begin
  if not XMLStrToTime(nodeValue,Result) then
    Result := defaultValue;
end; { XMLStrToTimeDef }

function XMLStrToBinary(nodeValue: WideString; const value: TStream): boolean;
var
  nodeStream: TStringStream;
begin
  value.Size := 0;
  nodeStream := TStringStream.Create(nodeValue);
  try
    Result := Base64Decode(nodeStream, value);
  finally FreeAndNil(nodeStream); end;