Пример работы с XML для хранения конфигов

Демонстрация работы с 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.
Структура классов ArcheAngel бота
  • Классы
    • TGameControl
    • TPaxEngine
    • TGameObject
      • TItem
        • TAucItem
      • TZoneItem
      • TSpawn
        • TLive
          • TNpc
            • TMount
          • TDoodad
          • TPlayer
            • TUser
      • TMailItem
      • TEffect
        • TBuff
        • TSkill
          • TCast
    • TGameList
      • TSpawnList
        • TPlayers
        • TMobs
        • TMounts
        • TDoodads
        • TNpcs
      • TInventory
      • TSkills
      • TSlotList
      • TZoneList
      • TBuffs
      • TMail
      • TAuction
    • TChatMessage
    • TAccount
    • TAccounts
    • THistoryMessage
    • TMessages