Config-files in Delphi without problems

Somehow there was a case and I thought about how the most convenient way to configure a user somewhere locally, quickly write and forget this business. I decided to keep this file in an xml file. What could be without them.
The main thing in this method is that when adding any new parameters or changing old ones, it will not be necessary to rewrite the code for saving data and loading it. Everything will be done automatically. All we need is to create a base class that will do everything for us, and we will store the data in the objects of the inheriting classes.


In general, in order not to powder the brain, I will immediately cite the code of the base class:

  unit tlXMLClass; 
 
 interface 
 
 uses 
   Classes, XMLIntf, 
   // it is important!!!  the module allows you to work with the properties of the object 
   TypInfo; 
 
 type 
   TXMLClass = class (TPersistent) 
   private 
     // here we will have the name of the file with the settings 
     FXMLFilePath: string;
     // and here is the name of the application for identification 
     FApplicationName: string; 
     // name of the root file branch
     FRootNodeName: string; 
     // version
     FVersion: byte; 
   protected 
     procedure SaveClass (oObject: TObject; Node: IXMLNode); 
     procedure LoadClass (oObject: TObject; Node: IXMLNode); 
   public 
     constructor Create (const AppName, XMLFilePath: string; RootNodeName: string = 'config');  
 
     procedure Initialize;  abstract; 
 
     // load values ​​from file
     procedure Load; 
     // and save them
     procedure Save; 

     // virtual method, we will write it in the heir 
     procedure LoadDefaults;  virtual; 
 
     property ApplicationName: string read FApplicationName write FApplicationName; 
     property RootNodeName: string read FRootNodeName; 
     property Version: byte read FVersion write FVersion default 1; 
   end; 
 
 implementation 
 
 uses 
   // about XMLDoc and XMLIntf - these two modules appeared in Delphi not so long ago, 
   // as long as I remember.  if you don’t have them, you’ll have to do it in a different way. 
   XMLDoc, SysUtils, Windows, 
   resConfig; 
 
 {TXMLConfig} 
 
 {$ REGION 'Initialization'} 
 constructor TXMLClass.Create (const AppName, XMLFilePath: string; RootNodeName: string = 'config'); 
 begin 
   Initialize; 
 
   FApplicationName: = AppName; 
   FXMLFilePath: = XMLFilePath; 
   FRootNodeName: = RootNodeName; 
 
   // set default settings 
   LoadDefaults; 
 end; 

 procedure TXMLClass.LoadDefaults; 
 begin 
 
 end; 
 {$ ENDREGION} 
 
 {$ REGION 'Loading'} 
 procedure TXMLClass.LoadClass (oObject: TObject; Node: IXMLNode); 
 
   // here we try to find the property and set its value 
   procedure GetProperty (PropInfo: PPropInfo); 
   var 
     sValue: string; 
     TempNode: IXMLNode; 
     LObject: TObject; 
   begin 
     // try to find a branch with the name of the property 
     TempNode: = Node.ChildNodes.FindNode (PropInfo ^ .Name); 
     // if not found, then exit the function.  property value will remain the default value 
     if TempNode = nil then 
       exit; 
 
     // if the property is not an object, then we get the value from the branch
     if PropInfo ^ .PropType ^ .Kind <> tkClass then 
       sValue: = TempNode.Text; 
 
     // analyze the type of the property and give it a value according to it
     case PropInfo ^ .PropType ^ .Kind of 
       tkEnumeration: 
         if GetTypeData (PropInfo ^ .PropType ^) ^. BaseType ^ = TypeInfo (Boolean) 
           then SetPropValue (oObject, PropInfo, Boolean (StrToBool (sValue))) 
           else SetPropValue (oObject, PropInfo, StrToInt (sValue)); 
       tkInteger, tkChar, tkWChar, tkSet: 
         SetPropValue (oObject, PropInfo, StrToInt (sValue)); 
       tkFloat: 
         SetPropValue (oObject, PropInfo, StrToFloat (sValue)); 
       tkString, tkLString, tkWString: 
         SetPropValue (oObject, PropInfo, sValue); 
       // but if the property is an object, then recursively execute the procedure
       // LoadClass, but for the found branch
       tkClass: 
         begin 
           LObject: = GetObjectProp (oObject, PropInfo); 
           if LObject <> nil then 
             LoadClass (LObject, TempNode); 
         end; 
     end; 
   end; 
 
 var 
   i, iCount: integer; 
   PropInfo: PPropInfo; 
   PropList: PPropList;   
 begin 
   // get the number of public properties of the object 
   iCount: = GetTypeData (oObject.ClassInfo) ^. PropCount; 
 
   if iCount> 0 then 
   begin 
     // request a piece of memory for storage 
     // property list 
     GetMem (PropList, iCount * SizeOf (Pointer)); 
 
     // and get them in PropList 
     GetPropInfos (oObject.ClassInfo, PropList); 
     try 
       // go through the list of properties 
       for i: = 0 to iCount - 1 do 
       begin 
         PropInfo: = PropList ^ [i]; 
         if PropInfo = nil then 
           break; 
 
         // and for each property we execute GetProperty (see above) 
         GetProperty (PropInfo); 
       end; 
     finally 
       // and at the very end we release the memory occupied by the list 
       FreeMem (PropList, iCount * SizeOf (Pointer)); 
     end; 
   end; 
 end; 
 
 procedure TXMLClass.Load;
 // procedure for reading from file 
 var 
   XMLRoot: IXMLNode; 
   XML: IXMLDocument; 
 begin 
   LoadDefaults; 
   if not FileExists (FXMLFilePath) then 
     exit; 
 
   try 
     // xml file with settings
     XML: = LoadXMLDocument (FXMLFilePath); 
     // root branch of the xml document 
     XMLRoot: = XML.DocumentElement; 
 
     // check if this file is ours
     if (XMLRoot.NodeName <> FRootNodeName) or 
        (XMLRoot.Attributes [rsApplication] <> FApplicationName) then 
       exit; 
 
     FVersion: = XMLRoot.Attributes [rsFormat]; 
 
     // let's go download
     LoadClass (Self, XMLRoot); 
   except 
     // an exception occurred?  load default values
     LoadDefaults; 
   end; 
 end; 
 {$ ENDREGION} 
 
 {$ REGION 'Saving'} 
 procedure TXMLClass.SaveClass (oObject: TObject; Node: IXMLNode); 
 // here we save the values ​​and this procedure is very 
 // much like the download procedure, so comment 
 // I'll be here only what is not in that procedure 
 
   procedure WriteProperty (PropInfo: PPropInfo); 
   var 
     sValue: string; 
     LObject: TObject; 
     TempNode: IXMLNode; 
   begin 
     case PropInfo ^ .PropType ^ .Kind of 
       tkEnumeration: 
         if GetTypeData (PropInfo ^ .PropType ^) ^. BaseType ^ = TypeInfo (Boolean) 
           then sValue: = BoolToStr (Boolean (GetOrdProp (oObject, PropInfo)), true) 
           else sValue: = IntToStr (GetOrdProp (oObject, PropInfo)); 
       tkInteger, tkChar, tkWChar, tkSet: 
         sValue: = IntToStr (GetOrdProp (oObject, PropInfo)); 
       tkFloat: 
         sValue: = FloatToStr (GetFloatProp (oObject, PropInfo)); 
       tkString, tkLString, tkWString: 
 
         sValue: = GetWideStrProp (oObject, PropInfo); 
       tkClass: 
         if Assigned (PropInfo ^ .GetProc) and Assigned (PropInfo ^ .SetProc) then 
         begin 
           LObject: = GetObjectProp (oObject, PropInfo); 
           if LObject <> nil then 
           begin 
             TempNode: = Node.AddChild (PropInfo ^ .Name); 
 
             SaveClass (LObject, TempNode); 
           end; 
         end; 
     end; 
 
     // here we create a new branch in the root of the document 
     // and write the property value to it 
     if PropInfo ^ .PropType ^ .Kind <> tkClass then 
       with Node.AddChild (PropInfo ^ .Name) do 
         Text: = sValue; 
   end; 
 
 var 
   PropInfo: PPropInfo; 
   PropList: PPropList; 
   i, iCount: integer; 
 begin 
   iCount: = GetTypeData (oObject.ClassInfo) ^. PropCount; 
 
   if iCount> 0 then 
   begin 
     GetMem (PropList, iCount * SizeOf (Pointer)); 
     try 
       GetPropInfos (oObject.ClassInfo, PropList); 
 
       for i: = 0 to iCount - 1 do 
       begin 
         PropInfo: = PropList ^ [i]; 
         if PropInfo = nil then 
           Break; 
 
         WriteProperty (PropInfo); 
       end; 
     finally 
       FreeMem (PropList, iCount * SizeOf (Pointer)); 
     end; 
   end; 
 end; 
 
 procedure TXMLClass.Save; 
 var 
   FRootNode: IXMLNode; 
   FBackFileName: string; 
   XML: IXMLDocument; 
 begin 
   // so far without backup.  just in case it does not hurt 
   FBackFileName: = ChangeFileExt (FXMLFilePath, '.bak'); 
   try 
     // original is deleted 
     if FileExists (FXMLFilePath) then 
       DeleteFile (PChar (FXMLFilePath)); 
 
     try 
       // create a new XML document 
       XML: = NewXMLDocument; 
 
       // ask him the encoding and version 
       with XML do 
       begin 
         Encoding: = 'UTF-8'; 
         Version: = '1.0'; 
       end; 
 
       // add root branch FRootNodeName
       FRootNode: = XML.AddChild (FRootNodeName); 
       FRootNode.Attributes [rsApplication]: = FApplicationName; 
       FRootNode.Attributes [rsFormat]: = FVersion; 
 
       SaveClass (Self, FRootNode); 
 
       // save the document 
       XML.SaveToFile (FXMLFilePath); 
     except 
       // but if an error occurred, then we try 
       // restore the file from the created backup 
       if FileExists (FBackFileName) then 
         RenameFile (FBackFileName, FXMLFilePath); 
     end; 
   finally 
     // and at the very end delete the backup 
     if FileExists (FBackFileName) then 
       DeleteFile (PChar (FBackFileName)); 
   end; 
 end; 
 {$ ENDREGION} 
 
 end. 

')
Here are the things here. The code is not very small, but, if you look, it is not complicated at all. I hope also useful. For someone :)
Yes, the code works on D2007, but there will be no problems on the version earlier. On those versions where there is support for XML.

An example of a config generated by a class:

  <? xml version = "1.0" encoding = "UTF-8"?> 
 <config application = "test" format = "0">
	 <Main>
		 <HistoryDepth> 40 </ HistoryDepth> 
	 </ Main>
	 <LookAndFeel>
		 <WindowWidth> 200 </ WindowWidth> 
		 <AlwaysOnTop> True </ AlwaysOnTop> 
		 <AlphaBlending> False </ AlphaBlending> 
		 <AlphaBlendValue> 245 </ AlphaBlendValue> 
		 <AnimateWithAlpha> False </ AnimateWithAlpha> 
		 <Elements>
			 <ItemDefault>
				 <Font>
					 <Name> Tahoma </ Name> 
					 <Size> 8 </ Size> 
					 <Color> 0 </ Color> 
					 <Bold> False </ Bold> 
					 <Italic> False </ Italic> 
					 <Strikeout> False </ Strikeout> 
					 <Underline> False </ Underline> 
				 </ Font>
			 </ ItemDefault>
			 <ItemChecked>
				 <Font>
					 <Name> Tahoma </ Name> 
					 <Size> 8 </ Size> 
					 <Color> 9079434 </ Color> 
					 <Bold> False </ Bold> 
					 <Italic> False </ Italic> 
					 <Strikeout> True </ Strikeout> 
					 <Underline> False </ Underline> 
				 </ Font>
			 </ ItemChecked>
		 </ Elements>
	 </ LookAndFeel>
	 <Confirmation>
		 <DeleteElement> True </ DeleteElement> 
	 </ Confirmation>
	 <Windows>
		 <HelpWindow>
			 <Top> 182 </ Top> 
			 <Left> 73 </ Left> 
			 <Width> 1135 </ Width> 
			 <Height> 642 </ Height> 
			 <WindowState> 0 </ WindowState> 
			 <SplitterLeft> 156 </ SplitterLeft> 
		 </ HelpWindow>
	 </ Windows>
 </ config> 

PS All this business supports the grouping of properties into separate objects inherited from TPersistent.

project page on GoogleCode.