Core/DBDReaderXML.pas - master - YakuninAV/Convertors

Core/DBDReaderXML.pas
539 строк18 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit DBDReaderXML;

{$I mormot.defines.inc}

interface

uses
  SysUtils, Classes, TypInfo, StrUtils, DateUtils, Variants,
{$IFDEF ISDELPHIXE2}
  Character,
{$ENDIF}
{$IFDEF FPC}
  DOM, xmlUtils, xmlRead,
{$ELSE}
  XMLIntf, XMLDoc, XMLdom,
{$ENDIF}
  mormot.core.base, mormot.core.buffers, mormot.core.zip, mormot.core.unicode,
  DBDStrUtils;

type
{$IFDEF FPC}

  { TDBDReaderXML }

  TDBDReaderXML = class(TObject)
  private
    FSchemeRef: string;
    FXMLDoc: TXMLDocument;
    FNode: TDOMNode;
    FActive: Boolean;
    function GetActive: Boolean;
    function GetRootNode: TDOMNode;
    function GetXMLDocument: TXMLDocument;
    procedure SetSchemeRef(const Value: string);
  public
    property RootNode: TDOMNode read GetRootNode;
    property XMLDocument: TXMLDocument read GetXMLDocument;
    property Active: Boolean read GetActive;
    property SchemeRef: string read FSchemeRef write SetSchemeRef;
    function GetChildNode(Name: string; const Move: Boolean=False): TDOMNode; overload;
    function GetChildNode(Idx: Word; const Move: Boolean=False): TDOMNode; overload;
    class function GetChildNode(Node: TDOMNode; const Name: string): TDOMNode; overload;
    class function GetChildNode(Node: TDOMNode; const Idx: Word): TDOMNode; overload;
    /// Функция считывает атрибут элемента
    class function ReadAttribute(Node: TDOMNode; const Name: string; out Attr: string): Boolean; overload;
    /// Функция считывает атрибут элемента
    class function ReadAttribute(Node: TDOMNode; const Name: string): string; overload;
    /// Функция считывает логическое значение из простого элемента
    class function ReadElemBoolean(Node: TDOMNode; const Name: string; out B: Boolean): Boolean; overload;
    /// Функция считывает логическое значение из простого элемента
    class function ReadElemBoolean(Node: TDOMNode; const Name: string): Boolean; overload;
    /// Функция считывает числовое значение из простого элемента
    class function ReadElemDouble(Node: TDOMNode; const Name: string; out D: Double): Boolean; overload;
    /// Функция считывает числовое значение из простого элемента
    class function ReadElemDouble(Node: TDOMNode; const Name: string): Double; overload;
    /// Функция считывает целое значение из простого элемента
    class function ReadElemInteger(Node: TDOMNode; const Name: string; out I: Integer): Boolean; overload;
    /// Функция считывает целое значение из простого элемента
    class function ReadElemInteger(Node: TDOMNode; const Name: string): Integer; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemString(Node: TDOMNode; const Name: string; out S: string): Boolean; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemString(Node: TDOMNode; const Name: string): String; overload;
    /// функция осуществляет проверку файла XML на соответствие схеме
    class function Validate(const XMLFile: TFileName; const SchemaFile: TFileName = ''): Boolean;
    class function XMLTextFromFile(const FileName: TFilename): string;
    constructor Create(Doc: TXMLDocument); overload;
    constructor Create(const FileName: TFileName); overload;
    destructor Destroy; override;
  end;
{$ELSE}
  TDBDReaderXML = class(TObject)
  private
    FSchemeRef: string;
    FXMLDoc: IXMLDocument;
    FNode: IXMLNode;
    FActive: Boolean;
    function GetActive: Boolean;
    function GetRootNode: IXMLNode;
    function GetXMLDocument: IXMLDocument;
    procedure SetSchemeRef(const Value: string);
  public
    property RootNode: IXMLNode read GetRootNode;
    property XMLDocument: IXMLDocument read GetXMLDocument;
    property Active: Boolean read GetActive;
    property SchemeRef: string read FSchemeRef write SetSchemeRef;
    function GetChildNode(Name: string; const Move: Boolean=False): IXMLNode; overload;
    function GetChildNode(Idx: Word; const Move: Boolean=False): IXMLNode; overload;
    class function GetChildNode(Node: IXMLNode; const Name: string): IXMLNode; overload;
    class function GetChildNode(Node: IXMLNode; const Idx: Word): IXMLNode; overload;
    class function NodeAsDouble(Node: IXMLNode; out D: Double): Boolean;
    class function NodeAsDoubleDef(Node: IXMLNode; const Def:Double=0.0): Double;
    class function NodeAsInteger(Node: IXMLNode; out I: Integer): Boolean;
    class function NodeAsIntegerDef(Node: IXMLNode; const Def:Integer=0): Integer;
    class function NodeAsString(Node: IXMLNode; out S: string): Boolean;
    class function NodeAsStringDef(Node: IXMLNode; const Def: string=''): string;
    /// Функция считывает атрибут элемента
    class function ReadAttribute(Node: IXMLNode; const Name: string; out Attr: string): Boolean; overload;
    class function ReadAttributeAsDouble(Node: IXMLNode; const Name: string; out Value: Double): Boolean; overload;
    /// Функция считывает атрибут элемента
    class function ReadAttribute(Node: IXMLNode; const Name: string): string; overload;
    /// Функция считывает логическое значение из простого элемента
    class function ReadElemBoolean(Node: IXMLNode; const Name: string; out B: Boolean): Boolean; overload;
    /// Функция считывает логическое значение из простого элемента
    class function ReadElemBoolean(Node: IXMLNode; const Name: string): Boolean; overload;
    /// Функция считывает числовое значение из простого элемента
    class function ReadElemDouble(Node: IXMLNode; const Name: string; out D: Double): Boolean; overload;
    /// Функция считывает числовое значение из простого элемента
    class function ReadElemDouble(Node: IXMLNode; const Name: string): Double; overload;
    /// Функция считывает целое значение из простого элемента
    class function ReadElemInteger(Node: IXMLNode; const Name: string; out I: Integer): Boolean; overload;
    /// Функция считывает целое значение из простого элемента
    class function ReadElemInteger(Node: IXMLNode; const Name: string): Integer; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemString(Node: IXMLNode; const Name: string; out S: string): Boolean; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemString(Node: IXMLNode; const Name: string): String; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemUtf8(Node: IXMLNode; const Name: string; out U: RawUtf8): Boolean; overload;
    /// Функция считывает строковое значение из простого элемента
    class function ReadElemUtf8(Node: IXMLNode; const Name: string): RawUtf8; overload;
    /// функция осуществляет проверку файла XML на соответствие схеме
    class function Validate(const XMLFile: TFileName; const SchemaFile: TFileName = ''): Boolean;
    class function XMLTextFromFile(const FileName: TFilename): string;
    constructor Create(Doc: IXMLDocument); overload;
    constructor Create(const FileName: TFileName); overload;
    destructor Destroy; override;
  end;
{$ENDIF}
implementation

{ TDBDReaderXML }
{$IFDEF FPC}
constructor TDBDReaderXML.Create(Doc: TXMLDocument);
begin
  FXMLDoc:=Doc;
end;

destructor TDBDReaderXML.Destroy;
begin
  inherited Destroy;
end;

constructor TDBDReaderXML.Create(const FileName: TFileName);
begin
  try
    ReadXMLFile(FXMLDoc, FileName);
//    FXMLDoc.Options := FXMLDoc.Options - [doNodeAutoCreate];
  except
    FXMLDoc := nil;
  end;
  FActive := FXMLDoc<>nil;
  if Active then FNode:=FXMLDoc.DocumentElement;
end;

function TDBDReaderXML.GetActive: Boolean;
begin
  Result := FActive;
end;

function TDBDReaderXML.GetChildNode(Name: string; const Move: Boolean): TDOMNode;
begin

end;

class function TDBDReaderXML.GetChildNode(Node: TDOMNode; const Name: string): TDOMNode;
begin

end;

class function TDBDReaderXML.GetChildNode(Node: TDOMNode; const Idx: Word): TDOMNode;
begin
  if (Node=nil) or (Idx>=Node.ChildNodes.Count) then Result:=nil
  else begin
    Result:=Node.ChildNodes[Idx];
  end;
end;

function TDBDReaderXML.GetChildNode(Idx: Word; const Move: Boolean): TDOMNode;
begin

end;

function TDBDReaderXML.GetRootNode: TDOMNode;
begin
  Result:=FXMLDoc.DocumentElement;
  FNode:=Result;
end;

function TDBDReaderXML.GetXMLDocument: TXMLDocument;
begin
  Result := FXMLDoc;
end;

class function TDBDReaderXML.ReadAttribute(Node: TDOMNode; const Name: string): string;
var e:TDOMElement;
begin
  e:=(Node as TDomElement);
  Result:=e.AttribStrings[Name];
end;

class function TDBDReaderXML.ReadAttribute(Node: TDOMNode; const Name: string; out Attr: string): Boolean;
begin

end;

class function TDBDReaderXML.ReadElemBoolean(Node: TDOMNode; const Name: string): Boolean;
begin

end;

class function TDBDReaderXML.ReadElemBoolean(Node: TDOMNode; const Name: string; out B: Boolean): Boolean;
begin

end;

class function TDBDReaderXML.ReadElemDouble(Node: TDOMNode; const Name: string): Double;
begin

end;

class function TDBDReaderXML.ReadElemDouble(Node: TDOMNode; const Name: string; out D: Double): Boolean;
begin

end;

class function TDBDReaderXML.ReadElemInteger(Node: TDOMNode; const Name: string): Integer;
begin

end;

class function TDBDReaderXML.ReadElemInteger(Node: TDOMNode; const Name: string; out I: Integer): Boolean;
begin

end;

class function TDBDReaderXML.ReadElemString(Node: TDOMNode; const Name: string): String;
begin

end;

class function TDBDReaderXML.ReadElemString(Node: TDOMNode; const Name: string; out S: string): Boolean;
begin

end;

procedure TDBDReaderXML.SetSchemeRef(const Value: string);
begin
  FSchemeRef := Value;
end;

class function TDBDReaderXML.Validate(const XMLFile: TFileName; const SchemaFile: TFileName): Boolean;
begin

end;

class function TDBDReaderXML.XMLTextFromFile(const FileName: TFilename): string;
begin

end;

{$ELSE}
constructor TDBDReaderXML.Create(Doc: IXMLDocument);
begin
  FXMLDoc:=Doc;
end;

constructor TDBDReaderXML.Create(const FileName: TFileName);
begin
  try
    FXMLdoc := LoadXMLDocument(FileName);
    FXMLDoc.Options := FXMLDoc.Options - [doNodeAutoCreate];
  except
    FXMLDoc := nil;
  end;
  FActive := FXMLDoc<>nil;
  if Active then FNode:=FXMLDoc.DocumentElement;
end;

destructor TDBDReaderXML.Destroy;
begin

end;

function TDBDReaderXML.GetActive: Boolean;
begin
  Result := FActive;
end;

class function TDBDReaderXML.GetChildNode(Node: IXMLNode; const Idx: Word): IXMLNode;
begin
  if (Node=nil) or (Idx>=Node.ChildNodes.Count) then Result:=nil
  else begin
    Result:=Node.ChildNodes[Idx];
  end;
end;

class function TDBDReaderXML.GetChildNode(Node: IXMLNode; const Name: string): IXMLNode;
begin
  if (Node=nil) or (Name='') then Result:=nil
  else begin
    Result := Node.ChildNodes.FindNode(Name);
  end;
end;

function TDBDReaderXML.GetChildNode(Idx: Word; const Move: Boolean): IXMLNode;
begin
  Result := FNode.ChildNodes[Idx];
  if Move then FNode:=Result
end;

function TDBDReaderXML.GetChildNode(Name: string; const Move: Boolean): IXMLNode;
begin
  Result := FNode.ChildNodes.FindNode(Name);
  if Move then FNode:=Result
end;

function TDBDReaderXML.GetRootNode: IXMLNode;
begin
  Result := FXMLDoc.DocumentElement;
  FNode:=Result;
end;

function TDBDReaderXML.GetXMLDocument: IXMLDocument;
begin
  Result := FXMLDoc;
end;

class function TDBDReaderXML.NodeAsDoubleDef(Node: IXMLNode; const Def: Double): Double;
begin
  if not NodeAsDouble(Node, Result) then Result:=Def
end;

class function TDBDReaderXML.NodeAsInteger(Node: IXMLNode; out I: Integer): Boolean;
var s: string; v: Variant;
begin
  I:=0;
  if (Node<>nil) then begin
    v:=Node.NodeValue;
    Result:=True;
    if VarIsNull(v) then Exit;
    if VarType(v) and varTypeMask = varInteger then I:=v
    else
      try
        s:=v;
        Result:=TryStrToInt(s,I)
      except
        Result:=False;
      end;
  end else Result:=False;
end;

class function TDBDReaderXML.NodeAsIntegerDef(Node: IXMLNode; const Def: Integer): Integer;
begin
  if not NodeAsInteger(Node, Result) then Result:=Def
end;

class function TDBDReaderXML.NodeAsString(Node: IXMLNode; out S: string): Boolean;
var v: Variant;
begin
  S:='';
  if (Node<>nil) then begin
    v:=Node.NodeValue;
    Result:=True;
    if not VarIsNull(v) then S:=v;
  end else Result:=False;
end;

class function TDBDReaderXML.NodeAsStringDef(Node: IXMLNode; const Def: string): string;
begin
  if not NodeAsString(Node, Result) then Result:= Def;
end;

class function TDBDReaderXML.NodeAsDouble(Node: IXMLNode; out D: Double): Boolean;
var s: string; v: Variant;
begin
  D:=0.0;
  if (Node<>nil) then begin
    v:=Node.NodeValue;
    Result:=True;
    if VarIsNull(v) then Exit;
    if VarType(v) and varTypeMask = varDouble then D:=v
    else
      try
        s:=v;
        Result:=DBDStringToDouble(s,D)
      except
        Result:=False;
      end;
  end else Result:=False;
end;

class function TDBDReaderXML.ReadAttribute(Node: IXMLNode; const Name: string; out Attr: string): Boolean;
var o: OleVariant;
begin
  Attr:=''; Result:=False;
  if Node<>nil then begin
    o:=Node.Attributes[Name];
    if not VarIsNull(o) then begin
      Attr:=o; Result:=True;
    end;
  end;
end;

class function TDBDReaderXML.ReadAttribute(Node: IXMLNode; const Name: string): string;
var o: OleVariant;
begin
  Result:='';
  if Node<>nil then begin
    o:=Node.Attributes[Name];
    if not VarIsNull(o) then Result:=o;
  end;
end;

class function TDBDReaderXML.ReadAttributeAsDouble(Node: IXMLNode; const Name: string; out Value: Double): Boolean;
var s: string;
begin
  Value:=0.0;
  Result:=ReadAttribute(Node, Name, s) and (s<>'');
  if Result then Result:= DBDReadDouble(s, Value);
end;

class function TDBDReaderXML.ReadElemBoolean(Node: IXMLNode; const Name: string): Boolean;
begin
  if not ReadElemBoolean(Node, Name, Result) then Result := false;
end;

class function TDBDReaderXML.ReadElemBoolean(Node: IXMLNode; const Name: string; out B: Boolean): Boolean;
var n: IXMLNode;
begin
  B:=False;
  if Node=nil then Result := False
  else begin
    n := Node.ChildNodes.FindNode(Name);
    if (n = nil) or VarIsNull(n.NodeValue) then Result := False
    else begin Result := True; B:=n.NodeValue; end;
  end;
end;

class function TDBDReaderXML.ReadElemDouble(Node: IXMLNode; const Name: string; out D: Double): Boolean;
var n: IXMLNode; s: string;
begin
  D:=0.0;
  Result:= ReadElemString(Node, Name, s)
       and DBDStringToDouble(s,D);
end;

class function TDBDReaderXML.ReadElemDouble(Node: IXMLNode; const Name: string): Double;
begin
  if not ReadElemDouble(Node, Name, Result) then Result := 0;
end;

class function TDBDReaderXML.ReadElemInteger(Node: IXMLNode; const Name: string): Integer;
begin
  if not ReadElemInteger(Node, Name, Result) then Result := 0;
end;

class function TDBDReaderXML.ReadElemInteger(Node: IXMLNode; const Name: string; out I: Integer): Boolean;
var n: IXMLNode; v: Variant; s: string; t: Integer;
begin
  I:=0;
  if Node=nil then Result := False
  else begin
    n := node.ChildNodes.FindNode(Name);
    if (n = nil) or VarIsNull(n.NodeValue) then Result := False
    else begin
//*********** заглушка для Гранда
      v:=n.NodeValue;
      try
        I:=v;    //exception if not Integer
      except
        s:=v;
        t:=Pos('.', s);
        if t<1 then t:=Pos(',',s);
        if t>0 then begin
          s:=Copy(s,1,t-1);
          I:=StrToIntDef(s,0);
        end else I:=0;
      end;
//***********end;
      Result := True;
    end;
  end;
end;

class function TDBDReaderXML.ReadElemString(Node: IXMLNode; const Name: string): String;
begin
  if not ReadElemString(Node, Name, Result) then Result := '';
end;

class function TDBDReaderXML.ReadElemUtf8(Node: IXMLNode; const Name: string): RawUtf8;
begin
 if not ReadElemUtf8(Node, Name, Result) then Result:='';
end;

class function TDBDReaderXML.ReadElemUtf8(Node: IXMLNode; const Name: string; out U: RawUtf8): Boolean;
var s: string;
begin
  U:='';
  Result:=ReadElemString(Node,Name,s);
  if Result then U:=StringToUtf8(s);
end;

class function TDBDReaderXML.ReadElemString(Node: IXMLNode; const Name: string; out S: string): Boolean;
var n: IXMLNode;
begin
  S:='';
  if Node=nil then Result := False
  else begin
    n := node.ChildNodes.FindNode(Name);
    if n = nil then Result := False
    else if VarIsNull(n.NodeValue) then begin Result := True; S:=''; end
    else begin Result := True; S:=n.NodeValue; end;
  end;
end;

procedure TDBDReaderXML.SetSchemeRef(const Value: string);
begin
  FSchemeRef := Value;
end;

class function TDBDReaderXML.Validate(const XMLFile, SchemaFile: TFileName): Boolean;
begin

end;

class function TDBDReaderXML.XMLTextFromFile(const FileName: TFilename): string;
var r,r1:RawByteString;
begin
{$IFDEF DEBUG}
  Assert((FileName<>'') and (FileExists(FileName)), 'Неверный параметр FileName: "' + FileName + '"');
{$ENDIF}
  r:=AnyTextFileToString(FileName);
  r1:=Copy(r,100);
  if Pos('windows-1251',r1)>0 then Result:=r
                              else Result:=Utf8ToString(r);
end;
{$ENDIF}
end.