Демонстрация работы с XML файлами на примере хранения конфигов: сохранение и загрузка, заполнение и отображение.
uses
SysUtils, Classes, NativeXml;
const
clGreen = 32768;
clRed = 255;
// ----------- CUSTOM TYPES DECLARATIONS (RECORDS \ CLASSES) ------------ //
type
/// lets say, that it is main container of all settings and it have 2 sections
TConfig = record
Basic: TBasicSet;
Extra: TExtraSet;
end;
/// this sections with primitive types
TBasicSet = record
Number: Integer;
Caption: String;
Flag: Boolean;
end;
/// this sections with advanced types
TExtraSet = record
StrList: TStringList; // https://www.delphibasics.co.uk/RTL.php?Name=TStringList
RecordsList: TList; // https://www.delphibasics.co.uk/RTL.php?Name=TList
ClassesList: TList;
procedure Init();
procedure Free();
end;
/// this is some simple custom object (for example atk skills)
TRecordObj = record
ID: Integer;
Name: String;
end;
PRecordObj = ^TRecordObj; // declare type "pointer to our TRecordObj"
TClassObj = class
ID: Integer;
Name: String;
constructor Create(); overload;
constructor Create(AID: Integer; AName: String); overload;
destructor Destroy(); override;
procedure Action();
end;
var
Cfg: TConfig;
{ TExtraSet }
procedure TExtraSet.Init();
begin
Self.StrList:= TStringList.Create();
Self.RecordsList:= TList.Create();
Self.ClassesList:= TList.Create();
end;
procedure TExtraSet.Free();
var i: Integer;
begin
// free TStringList instance
Self.StrList.Free();
// free every element of RecordsList and then whole RecordsList instance
if Assigned(RecordsList) then begin
for i:= 0 to Self.RecordsList.Count-1 do
Dispose(PRecordObj(Self.RecordsList[i]));
Self.RecordsList.Free();
end;
// free every element of ClassesList and then whole ClassesList instance
if Assigned(RecordsList) then begin
for i:= 0 to Self.ClassesList.Count-1 do
TClassObj(Self.ClassesList[i]).Free();
Self.ClassesList.Free();
end;
end;
{ TClassObj }
constructor TClassObj.Create(); overload;
begin
inherited Create;
end;
constructor TClassObj.Create(AID: Integer; AName: String); overload;
begin
inherited Create;
Self.ID:= AID;
Self.Name:= AName;
end;
destructor TClassObj.Destroy(); override;
begin
inherited;
end;
procedure TClassObj.Action();
begin
Print(Format('%s [id: %d]', [Self.Name, Self.ID]));
end;
// ------------------------ INTERACTION WITH XML ------------------------ //
procedure SaveXml();
var
XML: TNativeXml;
FilePath, FileName: String;
i: Integer;
RecordObj: PRecordObj;
ClassObj: TClassObj;
begin
FileName:= 'Demo.xml';
FilePath:= Script.Path + FileName;
XML:= TNativeXML.CreateName('Config', nil);
try
try
with XML.Root.NodeNew('Basic') do begin
WriteAttributeAnsiString('Number', IntToStr(Cfg.Basic.Number), '0');
WriteAttributeAnsiString('Caption', Cfg.Basic.Caption, '');
WriteAttributeAnsiString('Flag', BoolToStr(Cfg.Basic.Flag), 'False');
end;
with XML.Root.NodeNew('Extra') do begin
with NodeNew('StrList') do begin
WriteAttributeAnsiString('Count', IntToStr(Cfg.Extra.StrList.Count), '0');
for i:= 0 to Cfg.Extra.StrList.Count-1 do begin
with NodeNew('Item') do begin
WriteAttributeAnsiString('Index', IntToStr(i), '-1');
WriteAttributeAnsiString('Value', Cfg.Extra.StrList[i], '');
end;
end;
end;
with NodeNew('RecordsList') do begin
WriteAttributeAnsiString('Count', IntToStr(Cfg.Extra.RecordsList.Count), '0');
for i:= 0 to Cfg.Extra.RecordsList.Count-1 do begin
RecordObj:= PRecordObj(Cfg.Extra.RecordsList[i]);
with NodeNew('Item') do begin
WriteAttributeAnsiString('ID', IntToStr(RecordObj.ID), '-1');
WriteAttributeAnsiString('Name', RecordObj.Name, '');
end;
end;
end;
with NodeNew('ClassesList') do begin
WriteAttributeAnsiString('Count', IntToStr(Cfg.Extra.ClassesList.Count), '0');
for i:= 0 to Cfg.Extra.ClassesList.Count-1 do begin
ClassObj:= TClassObj(Cfg.Extra.ClassesList[i]);
with NodeNew('Item') do begin
WriteAttributeAnsiString('ID', IntToStr(ClassObj.ID), '-1');
WriteAttributeAnsiString('Name', ClassObj.Name, '');
end;
end;
end;
end;
XML.XmlFormat:= xfReadable;
XML.SaveToFile(FilePath); // or you can use XML.SaveToBinaryFile()
Engine.Print(Format('File "%s" successfully saved!', [FilePath]), clGreen);
except
on E: Exception do Engine.Print(Format('[SaveXml] %s: %s', [E.ClassName, E.Message]), clRed);
end;
finally
XML.Free();
end;
end;
procedure LoadXml();
var
XML: TNativeXml;
Node, Item: TXmlNode;
List: TList;
FilePath, FileName: String;
RecordObj: PRecordObj;
ClassObj: TClassObj;
i: Integer;
begin
FileName:= 'Demo.xml';
FilePath:= Script.Path + FileName;
if (not FileExists(FilePath)) then begin
Engine.Print(Format('File "%s" not found!', [FilePath]), clRed);
Script.Stop();
end;
List:= TList.Create;
XML:= TNativeXML.CreateName('Config', nil);
try
try
try
XML.LoadFromFile(FilePath);
except
on E: Exception do Engine.Print(Format('[LoadXml -> LoadFromFile] %s: %s', [E.ClassName, E.Message]), clRed);
//Exit;
end;
Node:= XML.Root.FindNode('Basic');
if Assigned(Node) then begin
with Node do begin
Cfg.Basic.Number:= Node.ReadAttributeInteger('Number', 0);
Cfg.Basic.Caption:= Node.ReadAttributeString('Caption', '');
Cfg.Basic.Flag:= StrToBool(Node.ReadAttributeString('Flag', 'False'));
end;
end;
if Assigned(XML.Root.FindNode('Extra')) then begin
Node:= XML.Root.FindNode('Extra').FindNode('StrList');
if Assigned(Node) then begin
Node.FindNodes('Item', List);
if (List.Count > 0) then begin
Cfg.Extra.StrList.Clear();
for i:= 0 to List.Count-1 do begin
Item:= TXmlNode(List(i));
Cfg.Extra.StrList.Add(Item.ReadAttributeString('Value', ''))
end;
end;
end;
Node:= XML.Root.FindNode('Extra').FindNode('RecordsList');
if Assigned(Node) then begin
Node.FindNodes('Item', List);
if (List.Count > 0) then begin
Cfg.Extra.RecordsList.Clear();
for i:= 0 to List.Count-1 do begin
Item:= TXmlNode(List(i));
New(RecordObj);
RecordObj.ID:= Item.ReadAttributeInteger('ID', -1);
RecordObj.Name:= Item.ReadAttributeString('Name', '');
Cfg.Extra.RecordsList.Add(RecordObj)
end;
end;
end;
Node:= XML.Root.FindNode('Extra').FindNode('ClassesList');
if Assigned(Node) then begin
Node.FindNodes('Item', List);
if (List.Count > 0) then begin
Cfg.Extra.ClassesList.Clear();
for i:= 0 to List.Count-1 do begin
Item:= TXmlNode(List(i));
ClassObj:= TClassObj.Create();
ClassObj.ID:= Item.ReadAttributeInteger('ID', -1);
ClassObj.Name:= Item.ReadAttributeString('Name', '');
Cfg.Extra.ClassesList.Add(ClassObj)
end;
end;
end;
end;
Engine.Print(Format('File "%s" successfully loaded!', [FilePath]), clGreen);
except
on E: Exception do Engine.Print(Format('[LoadXml] %s: %s', [E.ClassName, E.Message]), clRed);
end;
finally
XML.Free();
List.Free();
end;
end;
// ----------------------------- SOME UTILS ----------------------------- //
function BoolToStr(const Value: Boolean): String;
begin
if (Value) then Result:= 'True' else Result:= 'False';
end;
function StrToBool(Value: String): Boolean;
begin
if (AnsiLowerCase(Value) = 'true') or (AnsiLowerCase(Value) = '1') then Result:= True;
if (AnsiLowerCase(Value) = 'false') or (AnsiLowerCase(Value) = '0') then Result:= False;
end;
function IfThen(Condition: Boolean; Yes, No: Variant): Variant;
begin
if (Condition) then Result:= Yes else Result:= No;
end;
function MakeRandomString(Len: Integer): String;
const
Alphabet = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
begin
Result:= '';
repeat Result:= Result + Alphabet[Random(Length(Alphabet))+1];
until (Length(Result) = Len)
end;
// ----------------------------- MAIN LOGIC ----------------------------- //
procedure Init();
begin
Cfg.Extra.Init();
end;
/// this method calls automatically on script stop. usefull for clearing memory
procedure OnFree();
begin
Cfg.Extra.Free();
end;
procedure GenerateRandomConfig();
var
i, n: Integer;
RecordObj: PRecordObj;
ClassObj: TClassObj;
begin
Cfg.Basic.Number:= Random(100);
Cfg.Basic.Caption:= MakeRandomString(16);
Cfg.Basic.Flag:= IfThen(Random(2)=0, True, False);
n:= 3 + Random(5);
for i:= 0 to n-1 do begin
Cfg.Extra.StrList.Add(MakeRandomString(10));
end;
n:= 3 + Random(5);
for i:= 0 to n-1 do begin
New(RecordObj);
RecordObj.ID:= i;
RecordObj.Name:= 'RecordObj_'+IntToStr(i);
Cfg.Extra.RecordsList.Add(RecordObj);
end;
n:= 3 + Random(5);
for i:= 0 to n-1 do begin
ClassObj:= TClassObj.Create(i, 'ClassObj_'+IntToStr(i));
Cfg.Extra.ClassesList.Add(ClassObj);
end;
end;
procedure PrintConfigDetails();
var
i, n: Integer;
RecordObj: PRecordObj;
ClassObj: TClassObj;
begin
with Cfg.Basic do begin
Print(Format('Cfg.Basic<Number=%d, Caption=%s, Flag=%s>', [Number, Caption, BoolToStr(Flag)]));
end;
with Cfg.Extra do begin
Print(' ');
Print('Cfg.Extra.StrList:');
for i:= 0 to StrList.Count-1 do begin
Print(Format('StrList[%d] = %s', [i, StrList[i]]));
end;
Print(' ');
Print('Cfg.Extra.RecordsList:');
for i:= 0 to RecordsList.Count-1 do begin
RecordObj:= PRecordObj(RecordsList[i]);
Print(Format('RecordsList[%d] = PRecordObj<ID=%d, Name=%s>', [i, RecordObj.ID, RecordObj.Name]));
end;
Print(' ');
Print('Cfg.Extra.ClassesList:');
for i:= 0 to ClassesList.Count-1 do begin
ClassObj:= TClassObj(ClassesList[i]);
Print(Format('ClassesList[%d] = TClassObj<ID=%d, Name=%s>', [i, ClassObj.ID, ClassObj.Name]));
end;
end;
end;
begin
Init();
GenerateRandomConfig();
SaveXml();
LoadXml();
PrintConfigDetails();
end.