omnixmlutils.pas

OmniXML源码

  function XMLDateToStr(value: TDateTime): WideString;
  function XMLTimeToStr(value: TDateTime): WideString;
  function XMLBinaryToStr(value: TStream): WideString; 
  function XMLVariantToStr(value: Variant): WideString;

{$IFNDEF USE_MSXML}
  {:Select specified child nodes. Can filter on subnode name and text.
  }
  function FilterNodes(parentNode: IXMLNode; matchesName: string;
    matchesText: string = ''): IXMLNodeList; overload;

  {:Select specified child nodes. Can filter on subnode name, subnode text and
    on grandchildren names.
  }
  function FilterNodes(parentNode: IXMLNode; matchesName, matchesText: string;
    matchesChildNames: array of string): IXMLNodeList; overload;

  {:Select specified child nodes. Can filter on subnode name, subnode text and
    on grandchildren names and text.
  }
  function FilterNodes(parentNode: IXMLNode; matchesName, matchesText: string;
    matchesChildNames, matchesChildText: array of string): IXMLNodeList; overload;
{$ENDIF USE_MSXML}

  {:Select first child node that satisfies the criteria. Can filter on subnode
    name and text.
  }
  function FindNode(parentNode: IXMLNode; matchesName: string;
    matchesText: string = ''): IXMLNode; overload;

  {:Select first child node that satisfies the criteria. Can filter on subnode
    name, subnode text and on grandchildren names.
  }
  function FindNode(parentNode: IXMLNode; matchesName, matchesText: string;
    matchesChildNames: array of string): IXMLNode; overload;

  {:Select first child node that satisfies the criteria. Can filter on subnode
    name, subnode text and on grandchildren names and text.
  }
  function FindNode(parentNode: IXMLNode; matchesName, matchesText: string;
    matchesChildNames, matchesChildText: array of string): IXMLNode; overload;

  {:Returns 'processing instruction' node if it exists, nil otherwise.
  }
  function FindProcessingInstruction(
    xmlDocument: IXMLDocument): IXMLProcessingInstruction;

  {:Returns owner document interface of the specified node.
  }
  function OwnerDocument(node: IXMLNode): IXMLDocument;

  {:Returns document element node.
  }
  function DocumentElement(node: IXMLNode): IXMLElement;

{$IFDEF MSWINDOWS}
  {:Load XML document from the named RCDATA resource and return interface to it.
  }
  function XMLLoadFromResource(xmlDocument: IXMLDocument;
    const resourceName: string): boolean;
{$ENDIF}

  {:Load XML document from a wide string.
  }
  function XMLLoadFromString(xmlDocument: IXMLDocument;
    const xmlData: WideString): boolean;

  {:Load XML document from an ansi string.
  }
  function XMLLoadFromAnsiString(xmlDocument: IXMLDocument;
    const xmlData: AnsiString): boolean;

  {:Save XML document to a wide string.
  }
  function XMLSaveToString(xmlDocument: IXMLDocument;
    outputFormat: TOutputFormat = ofNone): WideString;

  {:Save XML document to an ansi string, automatically adding UTF8 processing
    instruction if required.
  }
  function XMLSaveToAnsiString(xmlDocument: IXMLDocument;
    outputFormat: TOutputFormat = ofNone): AnsiString;

  {:Load XML document from a stream.
  }
  function XMLLoadFromStream(xmlDocument: IXMLDocument;
    const xmlStream: TStream): boolean;

  {:Save XML document to a stream.
  }
  procedure XMLSaveToStream(xmlDocument: IXMLDocument;
    const xmlStream: TStream; outputFormat: TOutputFormat = ofNone);

  {:Load XML document from a file.
  }
  function XMLLoadFromFile(xmlDocument: IXMLDocument;
    const xmlFileName: string): boolean;

  {:Save XML document to a file.
  }
  procedure XMLSaveToFile(xmlDocument: IXMLDocument;
    const xmlFileName: string; outputFormat: TOutputFormat = ofNone);

{$IFDEF MSWINDOWS}
  {:Load XML document from the registry.
  }
  function  XMLLoadFromRegistry(xmlDocument: IXMLDocument; rootKey: HKEY;
    const key, value: string): boolean;

  {:Save XML document to the registry.
  }
  function XMLSaveToRegistry(xmlDocument: IXMLDocument; rootKey: HKEY;
    const key, value: string; outputFormat: TOutputFormat): boolean;
{$ENDIF}

  {:Select single node possibly more than one level below.
  @since   2003-09-21
  }
  function SelectNode(parentNode: IXMLNode; nodeTag: string): IXMLNode;

  {:Ensure that the node exists and return its interface.
  }
  function EnsureNode(parentNode: IXMLNode; nodeTag: string): IXMLNode;

  {:Append new child node to the parent.
    @since   2004-03-27
  }        
  function AppendNode(parentNode: IXMLNode; nodeTag: string): IXMLNode;

  {:Constructs XML document from given data.
  }
  function ConstructXMLDocument(const documentTag: string;
    const nodeTags, nodeValues: array of string): IXMLDocument; overload;

  {:Constructs XML document containing only documentelement node.
  }
  function ConstructXMLDocument(const documentTag: string): IXMLDocument; overload;

type
  TFilterXMLNodeEvent = procedure(node: IXMLNode; var canProcess: boolean) of object;

  {:Copies contents of one node into another. Some (sub)nodes can optionally be
    filtered out during the copy operation.
  }
  procedure CopyNode(sourceNode, targetNode: IXMLNode;
    copySubnodes: boolean = true; filterProc: TFilterXMLNodeEvent = nil);

  {:Copies contents of one node into another, then removes source node. Some
    (sub)nodes can optionally be filtered out during the copy operation.
  }
  procedure MoveNode(sourceNode, targetNode: IXMLNode;
    copySubnodes: boolean = true; filterProc: TFilterXMLNodeEvent = nil);

  {:Generates a copy of old node with new name, removes old node, and returns
    interface of the new node.
  }
  function RenameNode(node: IXMLNode; const newName: string): IXMLNode;

  {:Creates a copy of a XML document. Some nodes can optionally be filtered out
    during the copy operation.
    @since   2003-01-06
  }
  function CloneDocument(sourceDoc: IXMLDocument;
    filterProc: TFilterXMLNodeEvent = nil): IXMLDocument;

  {:Decode base64-encoded stream.
  }
  function  Base64Decode(encoded, decoded: TStream): boolean; overload;

  {:Decode base64-encoded string.
  }
  function  Base64Decode(const encoded: string; decoded: TStream): boolean; overload;

  {:Decode base64-encoded string.
  }
  function  Base64Decode(const encoded: string; var decoded: string): boolean; overload;

  {:Encode a stream into base64 form.
  }
  procedure Base64Encode(decoded, encoded: TStream); overload;

  {:Encode a stream into base64 form.
  }
  procedure Base64Encode(decoded: TStream; var encoded: string); overload;

  {:Encode a string into base64 form.
  }
  procedure Base64Encode(const decoded: string; var encoded: string); overload;

  procedure CheckXMLNode(Node: IXMLNode; const sName: string);
  
implementation

uses
{$IFDEF MSWINDOWS}
  Registry,
{$ENDIF}
  GpMemStr;

const
  DEFAULT_DECIMALSEPARATOR  = '.'; // don't change!
  DEFAULT_TRUE              = '1'; // don't change!
  DEFAULT_FALSE             = '0'; // don't change!
  DEFAULT_DATETIMESEPARATOR = 'T'; // don't change!
  DEFAULT_DATESEPARATOR     = '-'; // don't change!
  DEFAULT_TIMESEPARATOR     = ':'; // don't change!
  DEFAULT_MSSEPARATOR       = '.'; // don't change!

{:Convert time from string (ISO format) to TDateTime.
}
function Str2Time(s: string): TDateTime;
var
  hour  : word;
  minute: word;
  msec  : word;
  p     : integer;
  second: word;
begin
  s := Trim(s);
  if s = '' then
    Result := 0
  else begin
    p := Pos(DEFAULT_TIMESEPARATOR,s);
    hour := StrToInt(Copy(s,1,p-1));
    Delete(s,1,p);
    p := Pos(DEFAULT_TIMESEPARATOR,s);
    minute := StrToInt(Copy(s,1,p-1));
    Delete(s,1,p);
    p := Pos(DEFAULT_MSSEPARATOR,s);
    if p > 0 then begin
      msec := StrToInt(Copy(s,p+1,Length(s)-p));
      Delete(s,p,Length(s)-p+1);
    end
    else
      msec := 0;
    second := StrToInt(s);
    Result := EncodeTime(hour,minute,second,msec);
  end;
end; { Str2Time }

{:Convert date/time from string (ISO format) to TDateTime.
}
function ISODateTime2DateTime (const ISODT: String): TDateTime;
var
  day   : word;
  month : word;
  p     : integer;
  sDate : string;
  sTime : string;
  year  : word;
begin
  p := Pos (DEFAULT_DATETIMESEPARATOR,ISODT);
  // detect all known date/time formats
  if (p = 0) and (Pos(DEFAULT_DATESEPARATOR, ISODT) > 0) then
    p := Length(ISODT) + 1;
  sDate := Trim(Copy(ISODT,1,p-1));
  sTime := Trim(Copy(ISODT,p+1,Length(ISODT)-p));
  Result := 0;
  if sDate <> '' then begin
    p := Pos (DEFAULT_DATESEPARATOR,sDate);
    year :=  StrToInt(Copy(sDate,1,p-1));
    Delete(sDate,1,p);
    p := Pos (DEFAULT_DATESEPARATOR,sDate);
    month :=  StrToInt(Copy(sDate,1,p-1));
    day := StrToInt(Copy(sDate,p+1,Length(sDate)-p));
    Result := EncodeDate(year,month,day);
  end;
  Result := Result + Frac(Str2Time(sTime));
end; { ISODateTime2DateTime }

function Base64Decode(encoded, decoded: TStream): boolean;
var
  ch: char;
  group3: longint; { Must be a 3+ byte entity }
  idx: integer;
  outb: array [1..3] of byte;
begin
  Result := true;
  group3 := 0;
  idx := 0;
  while encoded.Read(ch,1) = 1 do begin
    case ch of
      'A'..'Z': group3 := (group3 shl 6) + Ord(ch) - Ord('A');
      'a'..'z': group3 := (group3 shl 6) + Ord(ch) - Ord('a') + 26;
      '0'..'9': group3 := (group3 shl 6) + Ord(ch) - Ord('0') + 52;
      '+'     : group3 := (group3 shl 6) + 62;
      '/'     : group3 := (group3 shl 6) + 63;
      '='     : group3 := (group3 shl 6);
      else begin
        Result := false;
        Exit;
      end;
    end; //case
    if ch <> '=' then
      idx := (idx + 1) mod 4;
    if idx = 0 then begin
      outb[1] := (group3 shr 16) and $ff;
      outb[2] := (group3 shr 8)  and $ff;
      outb[3] := group3 and $ff;
      decoded.Write(outb,3);
      group3 := 0;
    end;
  end;
  { Do the last one or two bytes }
  case Idx of
   0:
     { Not possible };
   2:
     begin
       { Two encoded-data bytes yield one decoded byte }
       outb[1] := (Group3 shr 16) and $ff;
       decoded.Write(outb,1);
     end; //2
   3:
     begin
       { Three encoded-data bytes yield two decoded bytes }
       outb[1] := (Group3 shr 16) and $ff;
       outb[2] := (Group3 shr 8) and $ff;
       decoded.Write(outb,2);
     end; //3
   else
     Result := false;
  end; //case
end; { Base64Decode }

function Base64Decode(const encoded: string; decoded: TStream): boolean; overload;
var
  encStr: TStringStream;
begin
  encStr := TStringStream.Create(encoded);
  try
    Result := Base64Decode(encStr, decoded);
  finally FreeAndNil(encStr); end;
end; { Base64Decode }

function Base64Decode(const encoded: string; var decoded: string): boolean;
var
  decStr: TStringStream;
begin
  decStr := TStringStream.Create('');
  try
    Result := Base64Decode(encoded, decStr);
    if Result then
      decoded := decStr.DataString;
  finally FreeAndNil(decStr); end;
end; { Base64Decode }

procedure Base64Encode(decoded, encoded: TStream);
var
  alphabet: array[0..63] of byte;
  i: byte;
  inb: array [1..3] of byte;
  outb: array [1..4] of byte;
  numRead: integer;
begin
  { Setup the encoding alphabet }
  for i := 0 to 25 do begin
    alphabet[i] := i + Ord('A');
    alphabet[i+26] := i + Ord('a');
  end;
  for i := 0 to 9 do
    alphabet[i+52] := i + Ord('0');
  alphabet[62] := Ord('+');
  alphabet[63] := Ord('/');
  repeat
    numRead := decoded.Read(inb,3);
    if numRead <> 3 then
      break; //repeat
    outb[1] := alphabet[inb[1] shr 2];
    outb[2] := alphabet[((inb[1] and $03) shl 4) or (inb[2] shr 4)];
    outb[3] := alphabet[((inb[2] and $0f) shl 2) or (inb[3] shr 6)];
    outb[4] := alphabet[inb[3] and $3f];
    encoded.Write(outb,4);
  until false;
  if numRead = 1 then begin
    outb[1] := alphabet[inb[1] shr 2];
    outb[2] := alphabet[(inb[1] and $03) shl 4];
    outb[3] := Ord('=');
    outb[4] := Ord('=');
    encoded.Write(outb,4);
  end
  else if numRead = 2 then begin
    outb[1] := alphabet[inb[1] shr 2];