Jump to content
Sign in to follow this  
Andrzej

XML DOM

Recommended Posts

Delphi has standard xml component available in old Delphi7?

Is any non standard xml component? My xml are small, no need Sax. Btw, are good free json components?

Share this post


Link to post

If compile for Windows you can use MSXML directly to load/get/set/DOM and save.

Here you can find how I use MSXML with Delphi implementing a light version of the Memento pattern:

https://github.com/shineworld/memento

Example of use in a system to load/save recently opened files:

unit osMRUManager;

interface

uses
  osIMemento;

type
  TMRUManager = class
  private
    FBackupPath: string;
    FCount: Integer;
    FItems: array of string;
    FMaxItems: Integer;
  private
    function GetItems(Index: Integer): string;
    procedure SetMaxItems(Value: Integer);
  public
    procedure Clear;
    procedure Delete(Index: Integer);
    function LoadFromFile(const FileName: string): Boolean;
    function LoadFromMemento(Memento: IMemento): Boolean;
    procedure Push(const Item: string);
    function SaveToFile(const FileName: string): Boolean;
    function SaveToMemento(Memento: IMemento): Boolean;
    procedure ValidateItems;
  public
    constructor Create;
  public
    property BackupPath: string read FBackupPath write FBackupPath;
    property Count: Integer read FCount;
    property Items[Index: Integer]: string read GetItems;
    property MaxItems: Integer read FMaxItems write SetMaxItems;
  end;

implementation

uses
  System.SysUtils,

  osIPersistable,

  osXMLMemento,
  osExceptionUtils;

const
  DEF_MAX_ITEMS = 8;

constructor TMRUManager.Create;
begin
  // sets default members values
  FBackupPath := '';
  FCount := 0;
  FItems := nil;
  FMaxItems := 0;

  // sets initial max items
  MaxItems := DEF_MAX_ITEMS;
end;

procedure TMRUManager.Delete(Index: Integer);
var
  I: Integer;
begin
  if (Index < 0) or (Index >= FMaxItems) then Exit;
  if (Index >= FCount) then Exit;
  for I := Index to FCount - 2 do
    FItems[I] := FItems[I + 1];
  FItems[FCount - 1] := '';
  Dec(FCount);
end;

procedure TMRUManager.Clear;
begin
  FCount := 0;
end;

function TMRUManager.GetItems(Index: Integer): string;
begin
  if (Index < 0) or (Index >= Count) then
    Result := ''
  else
    Result := FItems[Index];
end;

function TMRUManager.LoadFromFile(const FileName: string): Boolean;
var
  Memento: IMemento;
  BackupFileName: string;

  function GetBackupFileName: string;
  begin
    try
      if FBackupPath = '' then AbortFast;
      if not DirectoryExists(FBackupPath) then AbortFast;
      Result := FBackupPath + ExtractFileName(FileName);
    except
      Result := '';
    end;
  end;

  function InternalLoadFromFile(const FileName: string): Boolean;
  begin
    try
      Memento := CreateReadRoot(FileName);
      if Memento = nil then AbortFast;
      if Memento.GetName <> 'mru_root' then AbortFast;
      if not LoadFromMemento(Memento) then AbortFast;
      Result := True;
    except
      Result := False;
    end;
  end;

begin
  Clear;
  try
    BackupFileName := GetBackupFileName;
    Result := InternalLoadFromFile(FileName);
    if Result then
    begin
      if BackupFileName <> '' then SaveToFile(BackupFileName);
      Exit;
    end;
    Result := InternalLoadFromFile(BackupFileName);
    if not Result then AbortFast;
    SaveToFile(FileName);
    Result := True;
  except
    Clear;
    Result := False;
  end;
end;

function TMRUManager.LoadFromMemento(Memento: IMemento): Boolean;
var
  I: Integer;
  W: TXMLString;
  MainNode: IMemento;
  FileNodes: IMementoArray;
begin
  Clear;
  try
    MainNode := Memento.GetChild('mru');
    if MainNode = nil then AbortFast;
    FileNodes := MainNode.GetChildren('file');
    if FileNodes = nil then AbortFast;
    if Length(FileNodes) > MaxItems then AbortFast;
    FCount := Length(FileNodes);
    for I := 0 to FCount - 1 do
    begin
      if not FileNodes[I].GetString('name', W) then AbortFast;
      FItems[I] := W;
    end;
    Result := True;
  except
    Clear;
    Result := False;
  end;
end;

procedure TMRUManager.Push(const Item: string);
var
  I: Integer;
  J: Integer;
begin
  for I := 0 to FCount - 1 do
  begin
    if FItems[I] = Item then
    begin
      if I = 0 then Exit;
      for J := I downto 1 do
        FItems[J] := FItems[J - 1];
      FItems[0] := Item;
      Exit;
    end;
  end;
  if FCount < FMaxItems then
    Inc(FCount);
  for I := FCount - 1 downto 1 do
    FItems[I] := FItems[I - 1];
  FItems[0] := Item;
end;

function TMRUManager.SaveToFile(const FileName: string): Boolean;
var
  Memento: IMemento;
  BackupFileName: string;

  function GetBackupFileName: string;
  begin
    try
      if FBackupPath = '' then AbortFast;
      if not DirectoryExists(FBackupPath) then AbortFast;
      Result := FBackupPath + ExtractFileName(FileName);
    except
      Result := '';
    end;
  end;

  function InternalSaveToFile(const FileName: string): Boolean;
  begin
    try
      Memento := CreateWriteRoot('mru_root');
      if not SaveToMemento(Memento) then AbortFast;
      if not (Memento as IPersistable).SaveToFile(FileName, nrmd_UTF8, False) then AbortFast;
      Result := True;
    except
      Result := False;
    end;
  end;

begin
  try
    BackupFileName := GetBackupFileName;
    if not InternalSaveToFile(FileName) then AbortFast;
    if BackupFileName <> '' then InternalSaveToFile(BackupFileName);
    Result := True;
  except
    Result := False;
  end;
end;

function TMRUManager.SaveToMemento(Memento: IMemento): Boolean;
var
  I: Integer;
  Node: IMemento;
  MainNode: IMemento;
begin
  try
    MainNode := Memento.CreateChildSmart('mru');
    for I := 0 to Count - 1 do
    begin
      Node := MainNode.CreateChild('file');
      Node.PutString('name', FItems[I]);
    end;
    Result := True;
  except
    Result := False;
  end;
end;

procedure TMRUManager.SetMaxItems(Value: Integer);
var
  I: Integer;
begin
  if FMaxItems = Value then Exit;
  SetLength(FItems, Value);
  for I := FMaxItems to Value - 1 do
    FItems[I] := '';
  FMaxItems := Value;
  if FCount > FMaxItems then
    FCount := FMaxItems;
end;

procedure TMRUManager.ValidateItems;
var
  I: Integer;
begin
  I := FCount - 1;
  while I >= 0 do
  begin
    if not FileExists(FItems[I]) then
      Delete(I);
    Dec(I);
  end;
end;

end.

 

Share this post


Link to post

What is difference between CreateChild and CreateChildSmart?

Share this post


Link to post
Posted (edited)

CreateChild creates a new child empty node overwriting the eventual existent node.
CreateChildSmart at first check if the child already exists and return it, maintaining contents otherwise it creates a new one.

PS: I've missed a unit in git:
osExceptionUtils.pas

osExceptionsUtils add a new fast Abort (AbortFast) that I use often, but in source, you can replace any AbortFast with a native Abort.

Edited by shineworld

Share this post


Link to post
3 hours ago, Andrzej said:

Is any non standard xml component? My xml are small, no need Sax. Btw, are good free json components?

Check the list in my signature

Share this post


Link to post
Posted (edited)

I try use osMemento;

I have problems with other because I need library for both: old a new Delphi.

osMemento is OK, I have already converted binary->xml for files of report definition

Edited by Andrzej

Share this post


Link to post
Posted (edited)
7 hours ago, Andrzej said:

I try use osMemento;

I have problems with other because I need library for both: old a new Delphi.

osMemento is OK, I have already converted binary->xml for files of report definition

Usually, I use osMemento with BDS2006 (which is IDENTICAL to Delphi7) and Sydney.
MSXML DOM is also very fast.

With latest software, however, I'm migrating my settings files to JSON so I can open them
in Python, where I've another implementation of Memento very close to Delphi version but for JSON.

Edited by shineworld

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×