mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 00:23:53 +02:00
757 lines
22 KiB
ObjectPascal
757 lines
22 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
This unit defines various base classes for loading and saving of configs.
|
|
}
|
|
unit LazConfigStorage;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, AvgLvlTree, LCLProc;
|
|
|
|
type
|
|
{ TConfigStorage }
|
|
|
|
TConfigStorage = class
|
|
private
|
|
FPathStack: TStrings;
|
|
FCurrentBasePath: string;
|
|
protected
|
|
function GetFullPathValue(const APath, ADefault: String): String; virtual; abstract;
|
|
function GetFullPathValue(const APath: String; ADefault: Integer): Integer; virtual; abstract;
|
|
function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; virtual; abstract;
|
|
procedure SetFullPathValue(const APath, AValue: String); virtual; abstract;
|
|
procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); virtual; abstract;
|
|
procedure SetFullPathValue(const APath: String; AValue: Integer); virtual; abstract;
|
|
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); virtual; abstract;
|
|
procedure SetFullPathValue(const APath: String; AValue: Boolean); virtual; abstract;
|
|
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); virtual; abstract;
|
|
procedure DeleteFullPath(const APath: string); virtual; abstract;
|
|
procedure DeleteFullPathValue(const APath: string); virtual; abstract;
|
|
public
|
|
constructor Create(const Filename: string; LoadFromDisk: Boolean); virtual;
|
|
destructor Destroy; override;
|
|
procedure Clear; virtual; abstract;
|
|
function GetValue(const APath, ADefault: String): String;
|
|
function GetValue(const APath: String; ADefault: Integer): Integer;
|
|
function GetValue(const APath: String; ADefault: Boolean): Boolean;
|
|
procedure GetValue(const APath: String; out ARect: TRect;
|
|
const ADefault: TRect);
|
|
procedure GetValue(const APath: String; out APoint: TPoint;
|
|
const ADefault: TPoint);
|
|
procedure GetValue(const APath: String; const List: TStrings);
|
|
procedure SetValue(const APath, AValue: String);
|
|
procedure SetDeleteValue(const APath, AValue, DefValue: String);
|
|
procedure SetValue(const APath: String; AValue: Integer);
|
|
procedure SetDeleteValue(const APath: String; AValue, DefValue: Integer);
|
|
procedure SetValue(const APath: String; AValue: Boolean);
|
|
procedure SetDeleteValue(const APath: String; AValue, DefValue: Boolean);
|
|
procedure SetValue(const APath: String; const AValue: TRect);
|
|
procedure SetDeleteValue(const APath: String; const AValue, DefValue: TRect);
|
|
procedure SetValue(const APath: String; const AValue: TPoint);
|
|
procedure SetDeleteValue(const APath: String; const AValue, DefValue: TPoint);
|
|
procedure SetValue(const APath: String; const AValue: TStrings);
|
|
procedure DeletePath(const APath: string);
|
|
procedure DeleteValue(const APath: string);
|
|
property CurrentBasePath: string read FCurrentBasePath;
|
|
function ExtendPath(const APath: string): string;
|
|
procedure AppendBasePath(const Path: string);
|
|
procedure UndoAppendBasePath;
|
|
procedure WriteToDisk; virtual; abstract;
|
|
function GetFilename: string; virtual; abstract;
|
|
end;
|
|
|
|
TConfigStorageClass = class of TConfigStorage;
|
|
|
|
|
|
{ TConfigMemStorageNode }
|
|
|
|
TConfigMemStorageNode = class
|
|
public
|
|
Name: string;
|
|
Value: string;
|
|
Parent: TConfigMemStorageNode;
|
|
Children: TAvgLvlTree; // tree of TConfigMemStorageNode
|
|
procedure ClearChilds;
|
|
constructor Create(AParent: TConfigMemStorageNode; const AName: string);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TConfigMemStorageModification = (cmsmSet, cmsmGet, cmsmDelete, cmsmDeleteValue);
|
|
|
|
const
|
|
ConfigMemStorageFormatVersion = 2; // change this when format changes
|
|
type
|
|
{ TConfigMemStorage }
|
|
|
|
TConfigMemStorage = class(TConfigStorage)
|
|
private
|
|
procedure CreateRoot;
|
|
procedure CreateChilds(Node: TConfigMemStorageNode);
|
|
procedure Modify(const APath: string; Mode: TConfigMemStorageModification;
|
|
var AValue: string);
|
|
protected
|
|
procedure DeleteFullPath(const APath: string); override;
|
|
procedure DeleteFullPathValue(const APath: string); override;
|
|
function GetFullPathValue(const APath, ADefault: String): String; override;
|
|
function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean;
|
|
override;
|
|
function GetFullPathValue(const APath: String; ADefault: Integer): Integer;
|
|
override;
|
|
procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String);
|
|
override;
|
|
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue:
|
|
Boolean); override;
|
|
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue:
|
|
Integer); override;
|
|
procedure SetFullPathValue(const APath, AValue: String); override;
|
|
procedure SetFullPathValue(const APath: String; AValue: Boolean); override;
|
|
procedure SetFullPathValue(const APath: String; AValue: Integer); override;
|
|
public
|
|
Root: TConfigMemStorageNode;
|
|
function GetFilename: string; override;
|
|
procedure WriteToDisk; override;
|
|
destructor Destroy; override;
|
|
procedure Clear; override;
|
|
procedure SaveToConfig(Config: TConfigStorage; const APath: string);
|
|
procedure LoadFromConfig(Config: TConfigStorage; const APath: string);
|
|
procedure WriteDebugReport;
|
|
end;
|
|
|
|
procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string;
|
|
Tree: TStringToStringTree);
|
|
procedure SaveStringToStringTree(Config: TConfigStorage; const Path: string;
|
|
Tree: TStringToStringTree);
|
|
|
|
function CompareConfigMemStorageNames(p1, p2: PChar): integer;
|
|
function CompareConfigMemStorageNodes(Node1, Node2: Pointer): integer;
|
|
function ComparePCharWithConfigMemStorageNode(aPChar, ANode: Pointer): integer;
|
|
|
|
implementation
|
|
|
|
procedure LoadStringToStringTree(Config: TConfigStorage; const Path: string;
|
|
Tree: TStringToStringTree);
|
|
var
|
|
Cnt: LongInt;
|
|
SubPath: String;
|
|
CurName: String;
|
|
CurValue: String;
|
|
i: Integer;
|
|
begin
|
|
Tree.Clear;
|
|
Cnt:=Config.GetValue(Path+'Count',0);
|
|
for i:=0 to Cnt-1 do begin
|
|
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
|
CurName:=Config.GetValue(SubPath+'Name','');
|
|
CurValue:=Config.GetValue(SubPath+'Value','');
|
|
Tree.Values[CurName]:=CurValue;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveStringToStringTree(Config: TConfigStorage; const Path: string;
|
|
Tree: TStringToStringTree);
|
|
var
|
|
Node: TAvgLvlTreeNode;
|
|
Item: PStringToStringItem;
|
|
i: Integer;
|
|
SubPath: String;
|
|
begin
|
|
Config.SetDeleteValue(Path+'Count',Tree.Tree.Count,0);
|
|
Node:=Tree.Tree.FindLowest;
|
|
i:=0;
|
|
while Node<>nil do begin
|
|
Item:=PStringToStringItem(Node.Data);
|
|
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
|
Config.SetDeleteValue(SubPath+'Name',Item^.Name,'');
|
|
Config.SetDeleteValue(SubPath+'Value',Item^.Value,'');
|
|
Node:=Tree.Tree.FindSuccessor(Node);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
function CompareConfigMemStorageNames(p1, p2: PChar): integer;
|
|
// compare strings till / or #0
|
|
begin
|
|
if (p1=nil) then begin
|
|
if (p2=nil) or (p2^ in ['/',#0]) then begin
|
|
// both empty
|
|
Result:=0;
|
|
end else begin
|
|
// p1 shorter
|
|
Result:=-1;
|
|
end;
|
|
end else begin
|
|
if p2=nil then begin
|
|
// p2 shorter
|
|
Result:=1;
|
|
end else begin
|
|
repeat
|
|
if p1^ in ['/',#0] then begin
|
|
if p2^ in ['/',#0] then begin
|
|
// same
|
|
exit(0);
|
|
end else begin
|
|
// p1 shorter
|
|
exit(-1);
|
|
end;
|
|
end else begin
|
|
if p2^ in ['/',#0] then begin
|
|
// p2 shorter
|
|
exit(1);
|
|
end else if p1^=p2^ then begin
|
|
// continue
|
|
end else begin
|
|
// differ
|
|
exit(ord(p1^)-ord(p2^));
|
|
end;
|
|
end;
|
|
inc(p1);
|
|
inc(p2);
|
|
until false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CompareConfigMemStorageNodes(Node1, Node2: Pointer): integer;
|
|
var
|
|
CfgNode1: TConfigMemStorageNode absolute Node1;
|
|
CfgNode2: TConfigMemStorageNode absolute Node2;
|
|
begin
|
|
Result:=CompareConfigMemStorageNames(PChar(CfgNode1.Name),PChar(CfgNode2.Name));
|
|
end;
|
|
|
|
function ComparePCharWithConfigMemStorageNode(aPChar, ANode: Pointer): integer;
|
|
begin
|
|
Result:=CompareConfigMemStorageNames(PChar(aPChar),
|
|
PChar(TConfigMemStorageNode(ANode).Name));
|
|
end;
|
|
|
|
{ TConfigStorage }
|
|
|
|
constructor TConfigStorage.Create(const Filename: string; LoadFromDisk: Boolean
|
|
);
|
|
begin
|
|
|
|
end;
|
|
|
|
destructor TConfigStorage.Destroy;
|
|
begin
|
|
FPathStack.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TConfigStorage.GetValue(const APath, ADefault: String): String;
|
|
begin
|
|
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
|
|
end;
|
|
|
|
function TConfigStorage.GetValue(const APath: String; ADefault: Integer
|
|
): Integer;
|
|
begin
|
|
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
|
|
end;
|
|
|
|
function TConfigStorage.GetValue(const APath: String; ADefault: Boolean
|
|
): Boolean;
|
|
begin
|
|
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
|
|
end;
|
|
|
|
procedure TConfigStorage.GetValue(const APath: String; out ARect: TRect;
|
|
const ADefault: TRect);
|
|
begin
|
|
ARect.Left:=GetValue(APath+'Left',ADefault.Left);
|
|
ARect.Top:=GetValue(APath+'Top',ADefault.Top);
|
|
ARect.Right:=GetValue(APath+'Right',ADefault.Right);
|
|
ARect.Bottom:=GetValue(APath+'Bottom',ADefault.Bottom);
|
|
end;
|
|
|
|
procedure TConfigStorage.GetValue(const APath: String; out APoint: TPoint;
|
|
const ADefault: TPoint);
|
|
begin
|
|
APoint.X:=GetValue(APath+'X',ADefault.X);
|
|
APoint.Y:=GetValue(APath+'Y',ADefault.Y);
|
|
end;
|
|
|
|
procedure TConfigStorage.GetValue(const APath: String; const List: TStrings);
|
|
var
|
|
NewCount: LongInt;
|
|
i: Integer;
|
|
NewLine: String;
|
|
begin
|
|
NewCount:=GetValue(APath+'Count',0);
|
|
for i:=0 to NewCount-1 do begin
|
|
NewLine:=GetValue(APath+'Item'+IntToStr(i+1)+'/Value','');
|
|
if List.Count>i then
|
|
List[i]:=NewLine
|
|
else
|
|
List.Add(NewLine);
|
|
end;
|
|
while List.Count>NewCount do List.Delete(List.Count-1);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath, AValue: String);
|
|
begin
|
|
SetFullPathValue(ExtendPath(APath),AValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetDeleteValue(const APath, AValue, DefValue: String);
|
|
begin
|
|
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath: String; AValue: Integer);
|
|
begin
|
|
SetFullPathValue(ExtendPath(APath),AValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetDeleteValue(const APath: String; AValue,
|
|
DefValue: Integer);
|
|
begin
|
|
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath: String; AValue: Boolean);
|
|
begin
|
|
SetFullPathValue(ExtendPath(APath),AValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetDeleteValue(const APath: String; AValue,
|
|
DefValue: Boolean);
|
|
begin
|
|
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath: String; const AValue: TRect);
|
|
begin
|
|
SetValue(APath+'Left',AValue.Left);
|
|
SetValue(APath+'Top',AValue.Top);
|
|
SetValue(APath+'Right',AValue.Right);
|
|
SetValue(APath+'Bottom',AValue.Bottom);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetDeleteValue(const APath: String; const AValue,
|
|
DefValue: TRect);
|
|
begin
|
|
SetDeleteValue(APath+'Left',AValue.Left,DefValue.Left);
|
|
SetDeleteValue(APath+'Top',AValue.Top,DefValue.Top);
|
|
SetDeleteValue(APath+'Right',AValue.Right,DefValue.Right);
|
|
SetDeleteValue(APath+'Bottom',AValue.Bottom,DefValue.Bottom);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath: String; const AValue: TPoint);
|
|
begin
|
|
SetValue(APath+'X',AValue.X);
|
|
SetValue(APath+'Y',AValue.Y);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetDeleteValue(const APath: String; const AValue,
|
|
DefValue: TPoint);
|
|
begin
|
|
SetDeleteValue(APath+'X',AValue.X,DefValue.X);
|
|
SetDeleteValue(APath+'Y',AValue.Y,DefValue.Y);
|
|
end;
|
|
|
|
procedure TConfigStorage.SetValue(const APath: String; const AValue: TStrings);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetDeleteValue(APath+'Count',AValue.Count,0);
|
|
for i:=0 to AValue.Count-1 do
|
|
SetDeleteValue(APath+'Item'+IntToStr(i+1)+'/Value',AValue[i],'');
|
|
end;
|
|
|
|
procedure TConfigStorage.DeletePath(const APath: string);
|
|
begin
|
|
DeleteFullPath(ExtendPath(APath));
|
|
end;
|
|
|
|
procedure TConfigStorage.DeleteValue(const APath: string);
|
|
begin
|
|
DeleteFullPathValue(ExtendPath(APath));
|
|
end;
|
|
|
|
function TConfigStorage.ExtendPath(const APath: string): string;
|
|
begin
|
|
Result:=FCurrentBasePath+APath;
|
|
end;
|
|
|
|
procedure TConfigStorage.AppendBasePath(const Path: string);
|
|
begin
|
|
if FPathStack=nil then FPathStack:=TStringList.Create;
|
|
FPathStack.Add(FCurrentBasePath);
|
|
FCurrentBasePath:=FCurrentBasePath+Path;
|
|
if (FCurrentBasePath<>'')
|
|
and (FCurrentBasePath[length(FCurrentBasePath)]<>'/') then
|
|
FCurrentBasePath:=FCurrentBasePath+'/';
|
|
end;
|
|
|
|
procedure TConfigStorage.UndoAppendBasePath;
|
|
begin
|
|
if (FPathStack=nil) or (FPathStack.Count=0) then
|
|
raise Exception.Create('TConfigStorage.UndoAppendBasePath');
|
|
FCurrentBasePath:=FPathStack[FPathStack.Count-1];
|
|
FPathStack.Delete(FPathStack.Count-1);
|
|
end;
|
|
|
|
{ TConfigMemStorage }
|
|
|
|
procedure TConfigMemStorage.CreateRoot;
|
|
begin
|
|
Root:=TConfigMemStorageNode.Create(nil,'');
|
|
end;
|
|
|
|
procedure TConfigMemStorage.CreateChilds(Node: TConfigMemStorageNode);
|
|
begin
|
|
Node.Children:=TAvgLvlTree.Create(@CompareConfigMemStorageNodes);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.Modify(const APath: string;
|
|
Mode: TConfigMemStorageModification; var AValue: string);
|
|
var
|
|
Node: TConfigMemStorageNode;
|
|
p: PChar;
|
|
StartPos: PChar;
|
|
ChildNode: TAvgLvlTreeNode;
|
|
Child: TConfigMemStorageNode;
|
|
NewName: string;
|
|
begin
|
|
//DebugLn(['TConfigMemStorage.Modify APath="',APath,'" Mode=',ord(Mode),' AValue="',AValue,'"']);
|
|
p:=PChar(APath);
|
|
if p=nil then begin
|
|
if Root<>nil then begin
|
|
if Mode in [cmsmDelete,cmsmDeleteValue] then
|
|
Root.Value:='';
|
|
if Mode=cmsmDelete then
|
|
Root.ClearChilds;
|
|
end;
|
|
end else begin
|
|
if Root=nil then begin
|
|
if Mode in [cmsmDelete,cmsmDeleteValue] then exit;
|
|
CreateRoot;
|
|
end;
|
|
Node:=Root;
|
|
repeat
|
|
StartPos:=p;
|
|
while (not (p^ in ['/',#0])) do inc(p);
|
|
//DebugLn(['TConfigMemStorage.Modify Node="',Node.Name,'" StartPos="',StartPos,'"']);
|
|
// child node
|
|
if Node.Children=nil then begin
|
|
if Mode in [cmsmDelete,cmsmDeleteValue] then exit;
|
|
CreateChilds(Node);
|
|
end;
|
|
ChildNode:=Node.Children.FindKey(StartPos,@ComparePCharWithConfigMemStorageNode);
|
|
if ChildNode=nil then begin
|
|
if Mode in [cmsmDelete,cmsmDeleteValue] then exit;
|
|
NewName:='';
|
|
SetLength(NewName,p-StartPos);
|
|
if NewName<>'' then
|
|
System.Move(StartPos^,NewName[1],p-StartPos);
|
|
//DebugLn(['TConfigMemStorage.Modify Adding "',NewName,'"']);
|
|
Child:=TConfigMemStorageNode.Create(Node,NewName);
|
|
Node.Children.Add(Child);
|
|
end else
|
|
Child:=TConfigMemStorageNode(ChildNode.Data);
|
|
Node:=Child;
|
|
if p^='/' then begin
|
|
// next level
|
|
while (p^='/') do inc(p);
|
|
end else begin
|
|
// end of path
|
|
case Mode of
|
|
cmsmSet: Node.Value:=AValue;
|
|
cmsmGet: AValue:=Node.Value;
|
|
cmsmDelete,cmsmDeleteValue:
|
|
begin
|
|
Node.Value:='';
|
|
if Mode=cmsmDelete then
|
|
Node.ClearChilds;
|
|
while (Node<>nil) and ((Node.Children=nil) or (Node.Children.Count=0))
|
|
do begin
|
|
Child:=Node;
|
|
Node:=Node.Parent;
|
|
if Root=Child then Root:=nil;
|
|
Child.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
exit;
|
|
end;
|
|
until false;
|
|
end;
|
|
end;
|
|
|
|
procedure TConfigMemStorage.DeleteFullPath(const APath: string);
|
|
var
|
|
V: string;
|
|
begin
|
|
V:='';
|
|
Modify(APath,cmsmDelete,V);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.DeleteFullPathValue(const APath: string);
|
|
var
|
|
V: string;
|
|
begin
|
|
V:='';
|
|
Modify(APath,cmsmDeleteValue,V);
|
|
end;
|
|
|
|
function TConfigMemStorage.GetFullPathValue(const APath, ADefault: String
|
|
): String;
|
|
begin
|
|
Result:=ADefault;
|
|
Modify(APath,cmsmGet,Result);
|
|
end;
|
|
|
|
function TConfigMemStorage.GetFullPathValue(const APath: String; ADefault:
|
|
Boolean): Boolean;
|
|
var
|
|
s: string;
|
|
begin
|
|
if ADefault then
|
|
s := 'True'
|
|
else
|
|
s := 'False';
|
|
|
|
s := GetFullPathValue(APath, s);
|
|
|
|
if CompareText(s,'TRUE')=0 then
|
|
Result := True
|
|
else if CompareText(s,'FALSE')=0 then
|
|
Result := False
|
|
else
|
|
Result := ADefault;
|
|
end;
|
|
|
|
function TConfigMemStorage.GetFullPathValue(const APath: String; ADefault:
|
|
Integer): Integer;
|
|
begin
|
|
Result := StrToIntDef(GetFullPathValue(APath, IntToStr(ADefault)),ADefault);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetDeleteFullPathValue(const APath, AValue, DefValue
|
|
: String);
|
|
begin
|
|
if AValue=DefValue then
|
|
DeleteFullPathValue(APath)
|
|
else
|
|
SetFullPathValue(APath,AValue);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetDeleteFullPathValue(const APath: String; AValue,
|
|
DefValue: Boolean);
|
|
begin
|
|
if AValue=DefValue then
|
|
DeleteFullPath(APath)
|
|
else
|
|
SetFullPathValue(APath,AValue);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetDeleteFullPathValue(const APath: String; AValue,
|
|
DefValue: Integer);
|
|
begin
|
|
if AValue=DefValue then
|
|
DeleteFullPath(APath)
|
|
else
|
|
SetFullPathValue(APath,AValue);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetFullPathValue(const APath, AValue: String);
|
|
var
|
|
V: String;
|
|
begin
|
|
V:=AValue;
|
|
Modify(APath,cmsmSet,V);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetFullPathValue(const APath: String; AValue:
|
|
Boolean);
|
|
begin
|
|
if AValue then
|
|
SetFullPathValue(APath, 'True')
|
|
else
|
|
SetFullPathValue(APath, 'False');
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SetFullPathValue(const APath: String; AValue:
|
|
Integer);
|
|
begin
|
|
SetFullPathValue(APath,IntToStr(AValue));
|
|
end;
|
|
|
|
function TConfigMemStorage.GetFilename: string;
|
|
begin
|
|
Result:='';
|
|
end;
|
|
|
|
procedure TConfigMemStorage.WriteToDisk;
|
|
begin
|
|
raise Exception.Create('TConfigMemStorage.WriteToDisk invalid operation');
|
|
end;
|
|
|
|
destructor TConfigMemStorage.Destroy;
|
|
begin
|
|
FreeAndNil(Root);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TConfigMemStorage.Clear;
|
|
begin
|
|
FreeAndNil(Root);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.SaveToConfig(Config: TConfigStorage;
|
|
const APath: string);
|
|
|
|
procedure Save(Node: TConfigMemStorageNode; SubPath: string);
|
|
var
|
|
ChildNode: TAvgLvlTreeNode;
|
|
Child: TConfigMemStorageNode;
|
|
Names: String;
|
|
begin
|
|
if Node=nil then exit;
|
|
if (Node<>Root) then
|
|
SubPath:=SubPath+'_'+Node.Name+'/';
|
|
Config.SetDeleteValue(SubPath+'Value',Node.Value,'');
|
|
Names:='';
|
|
if Node.Children<>nil then begin
|
|
ChildNode:=Node.Children.FindLowest;
|
|
while ChildNode<>nil do begin
|
|
Child:=TConfigMemStorageNode(ChildNode.Data);
|
|
if Names<>'' then Names:=Names+'/';
|
|
Names:=Names+Child.Name;
|
|
Save(Child,SubPath);
|
|
ChildNode:=Node.Children.FindSuccessor(ChildNode);
|
|
end;
|
|
end;
|
|
Config.SetDeleteValue(SubPath+'Items',Names,'');
|
|
end;
|
|
|
|
begin
|
|
Save(Root,APath);
|
|
if (Root<>nil) and ((Root.Value<>'') or (Root.Children<>nil)) then
|
|
Config.SetValue(APath+'Version',ConfigMemStorageFormatVersion);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.LoadFromConfig(Config: TConfigStorage;
|
|
const APath: string);
|
|
var
|
|
StorageVersion: LongInt;
|
|
|
|
procedure Load(Node: TConfigMemStorageNode; SubPath: string);
|
|
var
|
|
ChildNames: string;
|
|
ChildName: string;
|
|
p: PChar;
|
|
StartPos: PChar;
|
|
Child: TConfigMemStorageNode;
|
|
begin
|
|
if Node=nil then exit;
|
|
if (Node<>Root) then
|
|
SubPath:=SubPath+'_'+Node.Name+'/';
|
|
Node.Value:=Config.GetValue(SubPath+'Value','');
|
|
if StorageVersion<2 then
|
|
ChildNames:=Config.GetValue(SubPath+'Childs','')
|
|
else
|
|
ChildNames:=Config.GetValue(SubPath+'Items','');
|
|
//DebugLn(['Load SubPath="',SubPath,'" Value="',Node.Value,'" ChildNames="',ChildNames,'"']);
|
|
if ChildNames<>'' then begin
|
|
p:=PChar(ChildNames);
|
|
repeat
|
|
StartPos:=p;
|
|
while not (p^ in ['/',#0]) do inc(p);
|
|
ChildName:='';
|
|
SetLength(ChildName,p-StartPos);
|
|
if ChildName<>'' then
|
|
System.Move(StartPos^,ChildName[1],p-StartPos);
|
|
Child:=TConfigMemStorageNode.Create(Node,ChildName);
|
|
if Node.Children=nil then
|
|
CreateChilds(Node);
|
|
Node.Children.Add(Child);
|
|
Load(Child,SubPath);
|
|
if p^=#0 then break;
|
|
inc(p);
|
|
until false;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
//DebugLn(['TConfigMemStorage.LoadFromConfig ']);
|
|
Clear;
|
|
if Root=nil then
|
|
CreateRoot;
|
|
StorageVersion:=Config.GetValue(APath+'Version',0);
|
|
//debugln(['TConfigMemStorage.LoadFromConfig ',APath,' Version=',StorageVersion]);
|
|
Load(Root,APath);
|
|
end;
|
|
|
|
procedure TConfigMemStorage.WriteDebugReport;
|
|
|
|
procedure w(Node: TConfigMemStorageNode; Prefix: string);
|
|
var
|
|
AVLNode: TAvgLvlTreeNode;
|
|
begin
|
|
if Node=nil then exit;
|
|
DebugLn(['TConfigMemStorage.WriteDebugReport ',Prefix,'Name="',Node.Name,'" Value="',Node.Value,'"']);
|
|
if Node.Children<>nil then begin
|
|
AVLNode:=Node.Children.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
w(TConfigMemStorageNode(AVLNode.Data),Prefix+' ');
|
|
AVLNode:=Node.Children.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
DebugLn(['TConfigMemStorage.WriteDebugReport ']);
|
|
w(Root,'');
|
|
end;
|
|
|
|
{ TConfigMemStorageNode }
|
|
|
|
procedure TConfigMemStorageNode.ClearChilds;
|
|
var
|
|
OldChilds: TAvgLvlTree;
|
|
begin
|
|
if Children<>nil then begin
|
|
OldChilds:=Children;
|
|
Children:=nil;
|
|
OldChilds.FreeAndClear;
|
|
OldChilds.Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TConfigMemStorageNode.Create(AParent: TConfigMemStorageNode;
|
|
const AName: string);
|
|
begin
|
|
Parent:=AParent;
|
|
Name:=AName;
|
|
end;
|
|
|
|
destructor TConfigMemStorageNode.Destroy;
|
|
begin
|
|
ClearChilds;
|
|
if (Parent<>nil) and (Parent.Children<>nil) then
|
|
Parent.Children.Remove(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|
|
|