Anonymous avatar Anonymous committed 4e59186

Src\ASConfig.IniFileEx.pas: Added searchpath
Src\ASConfig.pas: finer control over what gets saved/loaded. support for collections and strings.
Src\ASConfigInterface.pas: searchpath
Test\TestASConfig.pas: test collection strings and include/exclude.
Test\ascfgTests.res

Comments (0)

Files changed (5)

Src/ASConfig.IniFileEx.pas

     FIni: TCustomIniFile;
     FParentFile: IASConfigFile;
     FSkipWriteIfNotModified: Boolean;
+    FSearchPath: TStringList;
 
     function GetIniFile: TCustomIniFile;
     function GetParentFile: IASConfigFile;
     procedure SetParentFile(const Value: IASConfigFile);
 
   protected
+    function GetSearchPath: TStrings;
+    procedure SetSearchPath(const Value: TStrings);
+
     procedure MergeStrings(Dest: TStrings; const Src: TStrings);
     function GetFileName: string;
 
     property IniFile: TCustomIniFile read GetIniFile;
     property ParentFile: IASConfigFile read GetParentFile write SetParentFile;
     property SkipWriteIfNotModified: Boolean read GetSkipWriteIfNotModified write SetSkipWriteIfNotModified;
+    property SearchPath: TStrings read GetSearchPath write SetSearchPath;
   end;
 
 implementation
 
 uses
-  SysUtils, Windows, Registry, ASStringsHelper, ASDebug;
+  SysUtils, StrUtils, Windows, Registry, ASStringsHelper, ASDebug;
 
 { TASConfigIniFileEx }
 
   I: TCustomIniFile;
   Root: IASConfigFile;
 begin
-  Root := Self;
-
   if (AtDepth <> 0) and Assigned(ParentFile) then begin
     Result := ParentFile.AddDefaultSection(Section, AtDepth - 1, AsRoot);
+
   end else begin
+    I := nil;
     S := Section;
-    if (S[1] <> '\') then begin
-      S := IniFile.FileName + '\' + S;
-      S := ExpandFileName('\\.' + S);
-      S := Copy(S, 4, Length(S));
+
+    if IniFile is TIniFile then begin
+
+       // TODO
+
+    end else if IniFile is TRegistryIniFile then begin
+      if (S[1] <> '\') then begin
+        S := IniFile.FileName + '\' + S;
+        S := ExpandFileName('\\.' + S);
+        S := Copy(S, 4, Length(S));
+      end;
+
+      I := TRegistryIniFile.Create(S);
+      Root := Self;
     end;
 
-    I := nil;
-    if IniFile is TRegistryIniFile then
-      I := TRegistryIniFile.Create(S);
-
     Assert(Assigned(I), 'Ini class not supported: ' + IniFile.ClassName);
 
     if AsRoot or (AtDepth <> 0) then
   inherited Create(FileName);
   FParentFile := ParentFile;
   FIni := IniFile;
+  FSearchPath := TStringList.Create;
 
 {$IFDEF DEBUG_INIFILE}
   if ParentFile = nil then
 
   FreeAndNil(FIni);
   FParentFile := nil;
+  FreeAndNil(FSearchPath);
 
   inherited;
 end;
   Result := IniFile.FileName;
 end;
 
+function TASConfigIniFileEx.GetSearchPath: TStrings;
+begin
+  Result := FSearchPath;
+end;
+
 function TASConfigIniFileEx.GetSkipWriteIfNotModified: Boolean;
 begin
   Result := FSkipWriteIfNotModified;
 end;
 
 function TASConfigIniFileEx.ReadString(const Section, Ident, Default: string): string;
+var
+  S: string;
+  I: Integer;
 begin
-  if Assigned(ParentFile) then
-    Result := ParentFile.ReadString(Section, Ident, Default)
-  else
-    Result := Default;
+  for I := 0 to SearchPath.Count do begin
+    if I < SearchPath.Count then
+      S := SearchPath.ValueFromIndex[I]
+    else
+      S := '';
 
-  Result := IniFile.ReadString(Section, Ident, Result);
+    if Assigned(ParentFile) then
+      Result := ParentFile.ReadString(S + Section, Ident, Default)
+    else
+      Result := Default;
+
+    Result := IniFile.ReadString(S + Section, Ident, Result);
+
+    if Result <> Default then
+      Break;
+
+    S := '';
+  end;
 
 {$IFDEF DEBUG_INIFILE}
-    TASDebug.OutputDebugStringFmt('Read String %s/%s = "%s" [%s]'#13#10, [Section, Ident, Result, ToString]);
+    TASDebug.OutputDebugStringFmt('Read String %s|%s/%s = "%s" [%s]'#13#10, [S, Section, Ident, Result, ToString]);
 {$ENDIF}
 end;
 
   FParentFile := Value;
 end;
 
+procedure TASConfigIniFileEx.SetSearchPath(const Value: TStrings);
+begin
+  FSearchPath.Assign(Value);
+end;
+
 procedure TASConfigIniFileEx.SetSkipWriteIfNotModified(const Value: Boolean);
 begin
   FSkipWriteIfNotModified := Value;
 end;
 
 procedure TASConfigIniFileEx.WriteString(const Section, Ident, Value: String);
+var
+  S: string;
 begin
 {$IFDEF DEBUG_INIFILE}
   TASDebug.OutputDebugStringFmt('Write String %s/%s = "%s" [%s]'#13#10, [Section, Ident, Value, ToString]);
 {$ENDIF}
 
+  if (IniFile is TIniFile) and (LeftStr(Value, 1) = '"') and (RightStr(Value, 1) = '"') then
+    S := '"' + Value + '"'
+  else
+    S := Value;
+
   if not (SkipWriteIfNotModified and (Value = ReadString(Section, Ident, ''))) then
-    IniFile.WriteString(Section, Ident, Value);
+    IniFile.WriteString(Section, Ident, S);
 end;
 
 function TASConfigIniFileEx._AddRef: Integer;
 interface
 
 uses
-  Windows, Classes, SysUtils, Rtti, TypInfo, IniFiles, ASConfig.IniFileEx, ASConfigInterface;
+  Windows, Classes, SysUtils, Rtti, TypInfo, IniFiles, ASConfig.IniFileEx, ASConfigInterface,
+  RegularExpressions, RegularExpressionsCore;
 
 type
-  TSavePropMethod = procedure(const Name: string; const Value: TValue) of object;
-  TSavePropMethodMap = array[TTypeKind] of TSavePropMethod;
+  TStringsClass = class of TStrings;
 
-  TLoadPropMethod = function(const Name: string; const Default: TValue): TValue of object;
-  TLoadPropMethodMap = array[TTypeKind] of TLoadPropMethod;
+  TSaveMethod = procedure(const Name: string; const Value: TValue) of object;
+  TSaveMethodMap = array[TTypeKind] of TSaveMethod;
+
+  TLoadMethod = function(const Name: string; const Default: TValue): TValue of object;
+  TLoadMethodMap = array[TTypeKind] of TLoadMethod;
 
   TStoreProperty = TMemberVisibility;
   TStoreProperties = set of TStoreProperty;
 
   TASCustomConfig = class(TComponent)
   private
-    FIniFile: IASConfigFile;
     FParentConfig: TASCustomConfig;
-    FSavePropMethodMap: TSavePropMethodMap;
-    FLoadPropMethodMap: TLoadPropMethodMap;
+    FSaveMethodMap: TSaveMethodMap;
+    FLoadMethodMap: TLoadMethodMap;
     FStoreProperties: TStoreProperties;
     FDeclaredOnly: Boolean;
-    procedure SetParentConfig(const Value: TASCustomConfig);
+    FSearchPath: TStrings;
+    FIncludePropertyNames: TStrings;
+    FExcludePropertyNames: TStrings;
+
+    FIncludeRegExs: TPerlRegExList;
+    FExcludeRegExs: TPerlRegExList;
+
     function GetStorePublic: Boolean;
     function GetStorePublished: Boolean;
     procedure SetStorePublic(const Value: Boolean);
     procedure SetStorePublished(const Value: Boolean);
+    procedure SetSearchPath(const Value: TStrings);
+    procedure SetIncludePropertyNames(const Value: TStrings);
+    procedure SetExcludePropertyNames(const Value: TStrings);
+
+    function MatchName(const Prefix: string; const Name: string; RegEx: TPerlRegExList): Boolean;
+
+    procedure InitilizeRegExs(const Section: string);
+    procedure FinalizeRegExs;
+
+    property SaveMethodMap: TSaveMethodMap read FSaveMethodMap write FSaveMethodMap;
+    property LoadMethodMap: TLoadMethodMap read FLoadMethodMap write FLoadMethodMap;
 
   protected
-    function GetProperties(Typ: TRttiType): TArray<TRttiProperty>; virtual;
+    procedure SetParentConfig(const Value: TASCustomConfig); virtual;
+
     procedure BeforeSave(const Obj: TObject; const Path: string); virtual;
     procedure AfterSave(const Obj: TObject; const Path: string); virtual;
     procedure BeforeLoad(const Obj: TObject; const Path: string); virtual;
     procedure AfterLoad(const Obj: TObject; const Path: string); virtual;
 
-    property SavePropMethodMap: TSavePropMethodMap read FSavePropMethodMap write FSavePropMethodMap;
-    property LoadPropMethodMap: TLoadPropMethodMap read FLoadPropMethodMap write FLoadPropMethodMap;
+    function GetProperties(Typ: TRttiType): TArray<TRttiProperty>;
+
+    procedure SaveClass(const Name: string; const Value: TValue);
+    function LoadClass(const Name: string; const Default: TValue): TValue;
+
+    procedure SaveObject(const Prefix: string; const Obj: TObject);
+    procedure LoadObject(const Prefix: string; const Obj: TObject);
+
+    procedure SaveCollection(const Prefix: string; const Collection: TCollection);
+    procedure LoadCollection(const Prefix: string; const Collection: TCollection);
+
+    procedure SaveStrings(const Prefix: string; const Strings: TStrings);
+    procedure LoadStrings(const Prefix: string; const Strings: TStrings);
+
+    procedure RegisterSaveMethod(TypeKind: TTypeKind; SaveMethod: TSaveMethod);
+    procedure RegisterLoadMethod(TypeKind: TTypeKind; LoadMethod: TLoadMethod);
 
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     procedure Save(const Obj: TObject; const Path: string = 'Default');
     procedure Load(const Obj: TObject; const Path: string = 'Default');
     procedure Clear(ClearParents: Boolean = False); virtual;
 
-    property DeclaredOnly: Boolean read FDeclaredOnly write FDeclaredOnly;
-    property IniFile: IASConfigFile read FIniFile;
+
+    property DeclaredOnly: Boolean read FDeclaredOnly write FDeclaredOnly default True;
+    property IncludePropertyNames: TStrings read FIncludePropertyNames write SetIncludePropertyNames;
+    property ExcludePropertyNames: TStrings read FExcludePropertyNames write SetExcludePropertyNames;
     property ParentConfig: TASCustomConfig read FParentConfig write SetParentConfig;
+    property SearchPath: TStrings read FSearchPath write SetSearchPath;
     property StoreProperties: TStoreProperties read FStoreProperties write FStoreProperties default [mvPublished];
     property StorePublic: Boolean read GetStorePublic write SetStorePublic;
     property StorePublished: Boolean read GetStorePublished write SetStorePublished;
 
   TASCustomConfigIniFile = class(TASCustomConfig)
   private
+    FIniFile: IASConfigFile;
     FFileName: string;
     FSection: string;
     FSkipWriteIfNotModified: Boolean;
 
   protected
+    procedure SetParentConfig(const Value: TASCustomConfig); override;
+
     procedure SaveInteger(const Name: string; const Value: TValue);
     function LoadInteger(const Name: string; const Default: TValue): TValue;
 
   public
     constructor Create(AOwner: TComponent); override;
     procedure Clear(ClearParents: Boolean = False); override;
+    property IniFile: IASConfigFile read FIniFile;
     property FileName: string read FFileName write FFileName;
     property SkipWriteIfNotModified: Boolean read FSkipWriteIfNotModified write FSkipWriteIfNotModified default True;
   end;
   TASConfigIniFile = class(TASCustomConfigIniFile)
   published
     property DeclaredOnly;
+    property IncludePropertyNames;
+    property ExcludePropertyNames;
     property FileName;
     property ParentConfig;
+    property SearchPath;
     property SkipWriteIfNotModified;
     property StoreProperties;
   end;
     function GetRootKeyNameStored: Boolean;
   published
     property DeclaredOnly;
+    property IncludePropertyNames;
+    property ExcludePropertyNames;
     property ParentConfig;
     property Path;
     property RootKeyName: string read GetRootKeyName write SetRootKeyName stored GetRootKeyNameStored;
+    property SearchPath;
     property SkipWriteIfNotModified;
     property StoreProperties;
   end;
   TASConfigStore = class(TComponent)
   private
     FConfig: TASCustomConfig;
+    FOnConfigChange: TNotifyEvent;
+    FIncludePropertyNames: TStrings;
+    FExcludePropertyNames: TStrings;
+    procedure DoOnConfigChange;
+    procedure SetConfig(const Value: TASCustomConfig);
+    procedure SetExcludePropertyNames(const Value: TStrings);
+    procedure SetIncludePropertyNames(const Value: TStrings);
   public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
     procedure Save(const Obj: TComponent); overload;
     procedure Save(const Obj: TObject; const Path: string = 'Default'); overload;
 
     procedure Load(const Obj: TObject; const Path: string = 'Default'); overload;
 
   published
-    property Config: TASCustomConfig read FConfig write FConfig;
+    property Config: TASCustomConfig read FConfig write SetConfig;
+    property OnConfigChange: TNotifyEvent read FOnConfigChange write FOnConfigChange;
+    property IncludePropertyNames: TStrings read FIncludePropertyNames write SetIncludePropertyNames;
+    property ExcludePropertyNames: TStrings read FExcludePropertyNames write SetExcludePropertyNames;
   end;
 
 procedure Register;
 
+var
+  StringsClass: TStringsClass = TStringList;
+
 implementation
 
 uses
-  Registry, StrUtils, Math;
+  Registry, StrUtils, Math, ASDebug;
 
 const
   KeyNames: array[HKEY_CLASSES_ROOT..HKEY_DYN_DATA] of string = (
 
 procedure TASCustomConfig.AfterLoad(const Obj: TObject; const Path: string);
 begin
+  FinalizeRegExs;
 end;
 
 procedure TASCustomConfig.AfterSave(const Obj: TObject; const Path: string);
 begin
+  FinalizeRegExs;
 end;
 
 procedure TASCustomConfig.BeforeLoad(const Obj: TObject; const Path: string);
 begin
+  InitilizeRegExs(Path);
 end;
 
 procedure TASCustomConfig.BeforeSave(const Obj: TObject; const Path: string);
 begin
+  InitilizeRegExs(Path);
 end;
 
 procedure TASCustomConfig.Clear(ClearParents: Boolean);
 constructor TASCustomConfig.Create(AOwner: TComponent);
 begin
   inherited;
+  FIncludePropertyNames := StringsClass.Create;
+  FExcludePropertyNames := StringsClass.Create;
+  FSearchPath := StringsClass.Create;
+  FDeclaredOnly := True;
   FStoreProperties := [mvPublished];
+  RegisterSaveMethod(tkClass, SaveClass);
+  RegisterLoadMethod(tkClass, LoadClass);
+end;
+
+destructor TASCustomConfig.Destroy;
+begin
+  FreeAndNil(FIncludePropertyNames);
+  FreeAndNil(FExcludePropertyNames);
+  FreeAndNil(FSearchPath);
+  inherited;
+end;
+
+procedure TASCustomConfig.FinalizeRegExs;
+  procedure FinalizeList(var L: TPerlRegExList);
+  begin
+    if L = nil then
+      Exit;
+
+    while L.Count > 0 do begin
+      L.RegEx[0].Free;
+      L.Delete(0);
+    end;
+
+    FreeAndNil(L);
+  end;
+begin
+  FinalizeList(FIncludeRegExs);
+  FinalizeList(FExcludeRegExs);
+end;
+
+function TASCustomConfig.MatchName(const Prefix: string; const Name: string; RegEx: TPerlRegExList): Boolean;
+  function IsMatch(const S: string): Boolean;
+  begin
+    RegEx.Subject := UTF8String(S);
+    Result := RegEx.Match;
+
+{$IFDEF DEBUG}
+    if Result then
+      TASDebug.OutputDebugStringFmt('"%s" was matched against expression: "%s"', [S, RegEx.MatchedRegEx.RegEx]);
+{$ENDIF}
+  end;
+
+begin
+  if RegEx = nil then
+    Exit(False);
+
+  if IsMatch(Name) then
+    Exit(True);
+
+  Result := (Length(Prefix) > 0) and IsMatch(Prefix + Name);
 end;
 
 function TASCustomConfig.GetProperties(Typ: TRttiType): TArray<TRttiProperty>;
   Result := mvPublished in StoreProperties;
 end;
 
+procedure TASCustomConfig.InitilizeRegExs(const Section: string);
+  procedure InitializeList(var L: TPerlRegExList; R: TStrings);
+  var
+    S: string;
+  begin
+    if R.Count = 0 then
+      Exit;
+
+    L := TPerlRegExList.Create;
+
+    while R.Count > 0 do begin
+      S := R.ValueFromIndex[0];
+      if Length(S) = 0 then
+        S := R[0]
+      else if not TRegEx.IsMatch(Section, R.Names[0]) then
+        S := '';
+
+      if Length(S) > 0 then
+        L.RegEx[
+          L.Add(
+            TPerlRegEx.Create
+          )
+        ].RegEx := UTF8String(S);
+
+      R.Delete(0);
+    end;
+  end;
+begin
+  InitializeList(FIncludeRegExs, IncludePropertyNames);
+  InitializeList(FExcludeRegExs, ExcludePropertyNames);
+end;
+
 procedure TASCustomConfig.Load(const Obj: TObject; const Path: string);
+begin
+  BeforeLoad(Obj, Path);
+  try
+    LoadClass('', TValue.From(Obj));
+  finally
+    AfterLoad(Obj, Path);
+  end;
+end;
+
+function TASCustomConfig.LoadClass(const Name: string; const Default: TValue): TValue;
+var
+  Obj: TObject;
+  Prefix: string;
+begin
+  Prefix := Name + IfThen(Length(Name) > 0, '.', '');
+
+  Obj := Default.AsObject;
+  if Obj = nil then
+    Exit;
+
+  LoadObject(Prefix, Obj);
+
+  if Obj.InheritsFrom(TCollection) then
+    LoadCollection(Prefix, Obj as TCollection)
+  else if Obj.InheritsFrom(TStrings) then
+    LoadStrings(Prefix, Obj as TStrings);
+
+end;
+
+procedure TASCustomConfig.LoadCollection(const Prefix: string; const Collection: TCollection);
+var
+  I, Count: Integer;
+begin
+  Count := LoadMethodMap[tkInteger](Prefix + 'Count', TValue.From(0)).AsInteger;
+  for I := 0 to Count - 1 do
+    LoadObject(Prefix + IntToStr(I) + '.', Collection.Add);
+end;
+
+procedure TASCustomConfig.LoadObject(const Prefix: string; const Obj: TObject);
 var
   Ctx: TRttiContext;
   T: TRttiType;
   P: TRttiProperty;
-  L: TLoadPropMethod;
+  L: TLoadMethod;
+
 begin
-  BeforeLoad(Obj, Path);
-
   Ctx := TRttiContext.Create;
   try
     T := Ctx.GetType(Obj.ClassType);
     for P in GetProperties(T) do begin
-      if not ((P.Visibility in StoreProperties) and P.IsWritable) then
+      if not (P.IsReadable and (P.IsWritable or (P.PropertyType.TypeKind = tkClass))) then
         Continue;
 
-      L := LoadPropMethodMap[P.PropertyType.TypeKind];
-      if Assigned(L) then
-        P.SetValue(Obj, L(P.Name, P.GetValue(Obj)));
+      if not MatchName(Prefix, P.Name, FIncludeRegExs) then begin
+        if MatchName(Prefix, P.Name, FExcludeRegExs) then
+          Continue;
+
+        if not (P.Visibility in StoreProperties) then
+          Continue;
+      end;
+
+      L := LoadMethodMap[P.PropertyType.TypeKind];
+      if Assigned(L) then begin
+        if P.PropertyType.TypeKind = tkClass then
+          L(Prefix + P.Name, P.GetValue(Obj))
+        else
+          P.SetValue(Obj, L(Prefix + P.Name, P.GetValue(Obj)));
+      end;
     end;
   finally
     Ctx.Free;
   end;
+end;
 
-  AfterLoad(Obj, Path);
+procedure TASCustomConfig.LoadStrings(const Prefix: string; const Strings: TStrings);
+begin
+  Strings.CommaText := LoadMethodMap[tkString](Prefix + 'CommaText', TValue.From('')).AsString;
+end;
+
+procedure TASCustomConfig.RegisterLoadMethod(TypeKind: TTypeKind; LoadMethod: TLoadMethod);
+begin
+  FLoadMethodMap[TypeKind] := LoadMethod;
+end;
+
+procedure TASCustomConfig.RegisterSaveMethod(TypeKind: TTypeKind; SaveMethod: TSaveMethod);
+begin
+  FSaveMethodMap[TypeKind] := SaveMethod;
 end;
 
 procedure TASCustomConfig.Save(const Obj: TObject; const Path: string);
+begin
+  BeforeSave(Obj, Path);
+  try
+    SaveClass('', TValue.From(Obj));
+  finally
+    AfterSave(Obj, Path);
+  end;
+end;
+
+procedure TASCustomConfig.SaveClass(const Name: string; const Value: TValue);
+var
+  Obj: TObject;
+  Prefix: string;
+begin
+  Prefix := Name + IfThen(Length(Name) > 0, '.', '');
+
+  Obj := Value.AsObject;
+  if Obj = nil then
+    Exit;
+
+  SaveObject(Prefix, Obj);
+
+  if Obj.InheritsFrom(TCollection) then
+    SaveCollection(Prefix, Obj as TCollection)
+  else if Obj.InheritsFrom(TStrings) then
+    SaveStrings(Prefix, Obj as TStrings);
+
+end;
+
+procedure TASCustomConfig.SaveCollection(const Prefix: string; const Collection: TCollection);
+var
+  I: TCollectionItem;
+begin
+  if Collection.Count <> LoadMethodMap[tkInteger](Prefix + 'Count', TValue.From(0)).AsInteger then
+    SaveMethodMap[tkInteger](Prefix + 'Count', TValue.From(Collection.Count));
+
+  for I in Collection do
+    SaveObject(Prefix + IntToStr(I.Index) + '.', I);
+end;
+
+procedure TASCustomConfig.SaveObject(const Prefix: string; const Obj: TObject);
 var
   Ctx: TRttiContext;
   T: TRttiType;
   P: TRttiProperty;
-  S: TSavePropMethod;
+  S: TSaveMethod;
+
 begin
-  BeforeSave(Obj, Path);
-
   Ctx := TRttiContext.Create;
   try
     T := Ctx.GetType(Obj.ClassType);
     for P in GetProperties(T) do begin
-      if not ((P.Visibility in StoreProperties) and P.IsReadable) then
+      if not P.IsReadable then
         Continue;
 
-      S := SavePropMethodMap[P.PropertyType.TypeKind];
+      if not MatchName(Prefix, P.Name, FIncludeRegExs) then begin
+        if MatchName(Prefix, P.Name, FExcludeRegExs) then
+          Continue;
+
+        if not (P.Visibility in StoreProperties) then
+          Continue;
+      end;
+
+      S := SaveMethodMap[P.PropertyType.TypeKind];
       if Assigned(S) then
-        S(P.Name, P.GetValue(Obj));
+        S(Prefix + P.Name, P.GetValue(Obj));
     end;
   finally
     Ctx.Free;
   end;
+end;
 
-  AfterSave(Obj, Path);
+procedure TASCustomConfig.SaveStrings(const Prefix: string; const Strings: TStrings);
+begin
+  SaveMethodMap[tkString](Prefix + 'CommaText', TValue.From(Strings.CommaText));
+end;
+
+procedure TASCustomConfig.SetExcludePropertyNames(const Value: TStrings);
+begin
+  FExcludePropertyNames.Assign(Value);
+  if Assigned(ParentConfig) then
+    ParentConfig.ExcludePropertyNames := Value;
+end;
+
+procedure TASCustomConfig.SetIncludePropertyNames(const Value: TStrings);
+begin
+  FIncludePropertyNames.Assign(Value);
+  if Assigned(ParentConfig) then
+    ParentConfig.IncludePropertyNames := Value;
 end;
 
 procedure TASCustomConfig.SetParentConfig(const Value: TASCustomConfig);
     I := I.ParentConfig;
   end;
 
-  if Value <> Self then
-    FParentConfig := Value;
+  FParentConfig := Value;
+end;
 
-  if Assigned(FIniFile) then begin
-    if Assigned(Value) then
-      IniFile.ParentFile := Value.IniFile
-    else
-      IniFile.ParentFile := nil;
-  end;
+procedure TASCustomConfig.SetSearchPath(const Value: TStrings);
+begin
+  FSearchPath.Assign(Value);
 end;
 
 procedure TASCustomConfig.SetStorePublic(const Value: Boolean);
 
 procedure TASCustomConfigIniFile.AfterLoad(const Obj: TObject; const Path: string);
 begin
+  inherited;
+
   CloseIniFile;
 
   if Assigned(FParentConfig) then
 
 procedure TASCustomConfigIniFile.AfterSave(const Obj: TObject; const Path: string);
 begin
+  inherited;
+
   CloseIniFile;
 
   if Assigned(FParentConfig) then
 
 procedure TASCustomConfigIniFile.BeforeLoad(const Obj: TObject; const Path: string);
 begin
+  inherited;
+
   if Assigned(FParentConfig) then
     ParentConfig.BeforeLoad(Obj, Path);
 
 
 procedure TASCustomConfigIniFile.BeforeSave(const Obj: TObject; const Path: string);
 begin
+  inherited;
+
   if Assigned(FParentConfig) then
     ParentConfig.BeforeSave(Obj, Path);
 
 end;
 
 constructor TASCustomConfigIniFile.Create(AOwner: TComponent);
-var
-  SaveMap: TSavePropMethodMap;
-  LoadMap: TLoadPropMethodMap;
 begin
   inherited Create(AOwner);
 
   FSkipWriteIfNotModified := True;
 
-  SaveMap[tkUnknown     ] := nil;
-  SaveMap[tkInteger     ] := SaveInteger;
-  SaveMap[tkChar        ] := nil;
-  SaveMap[tkEnumeration ] := SaveEnum;
-  SaveMap[tkFloat       ] := SaveFloat;
-  SaveMap[tkString      ] := SaveString;
-  SaveMap[tkSet         ] := nil;
-  SaveMap[tkClass       ] := nil;
-  SaveMap[tkMethod      ] := nil;
-  SaveMap[tkWChar       ] := nil;
-  SaveMap[tkLString     ] := SaveString;
-  SaveMap[tkWString     ] := SaveString;
-  SaveMap[tkVariant     ] := nil;
-  SaveMap[tkArray       ] := nil;
-  SaveMap[tkRecord      ] := nil;
-  SaveMap[tkInterface   ] := nil;
-  SaveMap[tkInt64       ] := nil;
-  SaveMap[tkDynArray    ] := nil;
-  SaveMap[tkUString     ] := SaveString;
-  SaveMap[tkClassRef    ] := nil;
-  SaveMap[tkPointer     ] := nil;
-  SaveMap[tkProcedure   ] := nil;
-  SavePropMethodMap := SaveMap;
+//  RegisterSaveMethod(tkUnknown     , nil);
+  RegisterSaveMethod(tkInteger     , SaveInteger);
+//  RegisterSaveMethod(tkChar        , nil);
+  RegisterSaveMethod(tkEnumeration , SaveEnum);
+  RegisterSaveMethod(tkFloat       , SaveFloat);
+  RegisterSaveMethod(tkString      , SaveString);
+//  RegisterSaveMethod(tkSet         , nil);
+//  RegisterSaveMethod(tkClass       , nil);
+//  RegisterSaveMethod(tkMethod      , nil);
+//  RegisterSaveMethod(tkWChar       , nil);
+  RegisterSaveMethod(tkLString     , SaveString);
+  RegisterSaveMethod(tkWString     , SaveString);
+//  RegisterSaveMethod(tkVariant     , nil);
+//  RegisterSaveMethod(tkArray       , nil);
+//  RegisterSaveMethod(tkRecord      , nil);
+//  RegisterSaveMethod(tkInterface   , nil);
+//  RegisterSaveMethod(tkInt64       , nil);
+//  RegisterSaveMethod(tkDynArray    , nil);
+  RegisterSaveMethod(tkUString     , SaveString);
+//  RegisterSaveMethod(tkClassRef    , nil);
+//  RegisterSaveMethod(tkPointer     , nil);
+//  RegisterSaveMethod(tkProcedure   , nil);
 
-  LoadMap[tkUnknown     ] := nil;
-  LoadMap[tkInteger     ] := LoadInteger;
-  LoadMap[tkChar        ] := nil;
-  LoadMap[tkEnumeration ] := LoadEnum;
-  LoadMap[tkFloat       ] := LoadFloat;
-  LoadMap[tkString      ] := LoadString;
-  LoadMap[tkSet         ] := nil;
-  LoadMap[tkClass       ] := nil;
-  LoadMap[tkMethod      ] := nil;
-  LoadMap[tkWChar       ] := nil;
-  LoadMap[tkLString     ] := LoadString;
-  LoadMap[tkWString     ] := LoadString;
-  LoadMap[tkVariant     ] := nil;
-  LoadMap[tkArray       ] := nil;
-  LoadMap[tkRecord      ] := nil;
-  LoadMap[tkInterface   ] := nil;
-  LoadMap[tkInt64       ] := nil;
-  LoadMap[tkDynArray    ] := nil;
-  LoadMap[tkUString     ] := LoadString;
-  LoadMap[tkClassRef    ] := nil;
-  LoadMap[tkPointer     ] := nil;
-  LoadMap[tkProcedure   ] := nil;
-  LoadPropMethodMap := LoadMap;
+//  RegisterLoadMethod(tkUnknown     , nil);
+  RegisterLoadMethod(tkInteger     , LoadInteger);
+//  RegisterLoadMethod(tkChar        , nil);
+  RegisterLoadMethod(tkEnumeration , LoadEnum);
+  RegisterLoadMethod(tkFloat       , LoadFloat);
+  RegisterLoadMethod(tkString      , LoadString);
+//  RegisterLoadMethod(tkSet         , nil);
+//  RegisterLoadMethod(tkClass       , nil);
+//  RegisterLoadMethod(tkMethod      , nil);
+//  RegisterLoadMethod(tkWChar       , nil);
+  RegisterLoadMethod(tkLString     , LoadString);
+  RegisterLoadMethod(tkWString     , LoadString);
+//  RegisterLoadMethod(tkVariant     , nil);
+//  RegisterLoadMethod(tkArray       , nil);
+//  RegisterLoadMethod(tkRecord      , nil);
+//  RegisterLoadMethod(tkInterface   , nil);
+//  RegisterLoadMethod(tkInt64       , nil);
+//  RegisterLoadMethod(tkDynArray    , nil);
+  RegisterLoadMethod(tkUString     , LoadString);
+//  RegisterLoadMethod(tkClassRef    , nil);
+//  RegisterLoadMethod(tkPointer     , nil);
+//  RegisterLoadMethod(tkProcedure   , nil);
 end;
 
 function TASCustomConfigIniFile.CreateIniFile: TCustomIniFile;
   if Assigned(FIniFile) then
     CloseIniFile;
 
-  if Assigned(FParentConfig) then
-    Parent := ParentConfig.IniFile;
+  if Assigned(FParentConfig) and (ParentConfig is TASCustomConfigIniFile) then
+    Parent := TASCustomConfigIniFile(ParentConfig).IniFile;
 
   Self.Section := Section;
   FIniFile := TASConfigIniFileEx.Create(Name, CreateIniFile, Parent);
   IniFile.SkipWriteIfNotModified := SkipWriteIfNotModified;
+  IniFile.SearchPath := SearchPath;
 end;
 
 procedure TASCustomConfigIniFile.SaveEnum(const Name: string; const Value: TValue);
   IniFile.WriteString(Section, Name, Value.AsString);
 end;
 
+procedure TASCustomConfigIniFile.SetParentConfig(const Value: TASCustomConfig);
+begin
+  inherited;
+
+  if Assigned(FIniFile) then begin
+    if Assigned(Value) and (Value is TASCustomConfigIniFile) then
+      IniFile.ParentFile := TASCustomConfigIniFile(Value).IniFile
+    else
+      IniFile.ParentFile := nil;
+  end;
+end;
+
 { TASConfigStore }
 
+constructor TASConfigStore.Create(AOwner: TComponent);
+begin
+  inherited;
+
+  FIncludePropertyNames := StringsClass.Create;
+  FExcludePropertyNames := StringsClass.Create;
+end;
+
+destructor TASConfigStore.Destroy;
+begin
+  FreeAndNil(FIncludePropertyNames);
+  FreeAndNil(FExcludePropertyNames);
+  inherited;
+end;
+
+procedure TASConfigStore.DoOnConfigChange;
+begin
+  if Assigned(FOnConfigChange) then
+    FOnConfigChange(Self);
+end;
+
 procedure TASConfigStore.Load(const Obj: TObject; const Path: string);
 begin
-  Config.Load(Obj, Path);
+  with Config do begin
+    IncludePropertyNames := Self.IncludePropertyNames;
+    ExcludePropertyNames := Self.ExcludePropertyNames;
+    Load(Obj, Path);
+  end;
 end;
 
 procedure TASConfigStore.Load(const Obj: TComponent);
 
 procedure TASConfigStore.Save(const Obj: TObject; const Path: string);
 begin
-  Config.Save(Obj, Path);
+  with Config do begin
+    IncludePropertyNames := Self.IncludePropertyNames;
+    ExcludePropertyNames := Self.ExcludePropertyNames;
+    Save(Obj, Path);
+  end;
+end;
+
+procedure TASConfigStore.SetConfig(const Value: TASCustomConfig);
+begin
+  if FConfig <> Value then begin
+    FConfig := Value;
+    DoOnConfigChange;
+  end;
+end;
+
+procedure TASConfigStore.SetExcludePropertyNames(const Value: TStrings);
+begin
+  FExcludePropertyNames.Assign(Value);
+end;
+
+procedure TASConfigStore.SetIncludePropertyNames(const Value: TStrings);
+begin
+  FIncludePropertyNames.Assign(Value);
 end;
 
 { TASCustomConfigRegistry }

Src/ASConfigInterface.pas

     function AddDefaultSection(const Section: string; AtDepth: Integer = 0; AsRoot: Boolean = False): IASConfigFile;
     function GetSaveFileName: string;
 
+    function GetSearchPath: TStrings;
+    procedure SetSearchPath(const Value: TStrings);
+    property SearchPath: TStrings read GetSearchPath write SetSearchPath;
+
     function GetIniFile: TCustomIniFile;
     property IniFile: TCustomIniFile read GetIniFile;
 

Test/TestASConfig.pas

     function CreateIniFile: IASConfigFile; virtual; abstract;
 
   public
+    procedure SetUp; override;
     procedure TearDown; override;
 
   published
     procedure TestSaveBool;
     procedure TestSaveEnum;
     procedure TestLoadEnum;
+    procedure TestSaveCollection;
+    procedure TestLoadCollection;
+    procedure TestSearchPath;
+    procedure TestLoadInclude;
+    procedure TestLoadExclude;
+    procedure TestSaveStringList;
+    procedure TestLoadStringList;
   end;
 
   TestTASConfigIniFile = class(TestTASCustomConfig)
   end;
 
   TMyEnum = (meOther, meFoo, meTest, meBar, meLast);
+  {$M+}
   TTestDescendent = class(TTestObject)
   private
     FAnotherProp: Boolean;
     property AnotherProp: Boolean read FAnotherProp write FAnotherProp;
   end;
 
+  TTestCollectionItem = class(TCollectionItem)
+  private
+    FSomeVal: string;
+    FMyBool: Boolean;
+  public
+    property SomeVal: string read FSomeVal write FSomeVal;
+    property MyBool: Boolean read FMyBool write FMyBool;
+  end;
+
+  TTestCollection = class
+  private
+    FFoo: integer;
+    FBar: TCollection;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Foo: integer read FFoo write FFoo;
+    property Bar: TCollection read FBar;
+  end;
+
 implementation
 
 uses
   Result := (Config as TASCustomConfigIniFile).FileName;
 end;
 
+procedure TestTASCustomConfig.SetUp;
+begin
+  inherited;
+  Config.Clear;
+end;
+
 procedure TestTASCustomConfig.TearDown;
 begin
   FreeAndNil(FASCustomConfig);
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Ini := CreateIniFile;
   Ini.WriteString('Default', 'Astring', 'My string');
   Ini.WriteInteger('Default', 'Aint', 44);
   end;
 end;
 
+procedure TestTASCustomConfig.TestLoadExclude;
+var
+  Obj: TTestDescendent;
+  Ini: IASConfigFile;
+begin
+  Ini := CreateIniFile;
+  Ini.WriteString('Default', 'Astring', 'My string');
+  Ini.WriteInteger('Default', 'Aint', 44);
+  Ini.WriteBool('Default', 'AnotherProp', True);
+  Ini := nil;
+
+  Obj := TTestDescendent.Create;
+  try
+    Config.DeclaredOnly := False;
+    Config.StorePublic := True;
+    Config.StorePublished := True;
+    Config.ExcludePropertyNames.Add('Astring');
+    Config.ExcludePropertyNames.Add('Aint');
+    Config.Load(Obj);
+
+    CheckEqualsString('', Obj.Astring, '[Default]');
+    CheckEquals(0, Obj.Aint, '[Default]');
+    CheckEquals(True, Obj.AnotherProp, '[Default]');
+  finally
+    Obj.Free;
+  end;
+end;
+
+procedure TestTASCustomConfig.TestLoadInclude;
+var
+  Obj: TTestDescendent;
+  Ini: IASConfigFile;
+begin
+  Ini := CreateIniFile;
+  Ini.WriteString('Default', 'Astring', 'My string');
+  Ini.WriteInteger('Default', 'Aint', 44);
+  Ini.WriteBool('Default', 'AnotherProp', True);
+  Ini := nil;
+
+  Obj := TTestDescendent.Create;
+  try
+    Config.DeclaredOnly := False;
+    Config.StoreProperties := [];
+    Config.IncludePropertyNames.Add('Astring');
+    Config.IncludePropertyNames.Add('Aint');
+    Config.Load(Obj);
+
+    CheckEqualsString('My string', Obj.Astring, '[Default]');
+    CheckEquals(44, Obj.Aint, '[Default]');
+    CheckEquals(False, Obj.AnotherProp, '[Default]');
+  finally
+    Obj.Free;
+  end;
+end;
+
+procedure TestTASCustomConfig.TestLoadStringList;
+var
+  S: TStringList;
+begin
+  Config.Clear;
+
+  S := TStringList.Create;
+  try
+    with CreateIniFile do begin
+      WriteString('S', 'CommaText', '"First line","Second line...","And last line."');
+      Config.Load(S, 'S');
+      CheckEquals('"First line","Second line...","And last line."', S.CommaText);
+    end;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TestTASCustomConfig.TestLoadCollection;
+var
+  C: TTestCollection;
+  Ini: IASConfigFile;
+begin
+  Ini := CreateIniFile;
+  Ini.WriteInteger('Collection', 'Foo', 45);
+  Ini.WriteInteger('Collection', 'Bar.Count', 2);
+  Ini.WriteString('Collection', 'Bar.0.SomeVal', 'Item 1');
+  Ini.WriteBool('Collection', 'Bar.0.MyBool', False);
+  Ini.WriteString('Collection', 'Bar.1.SomeVal', 'Item 2');
+  Ini.WriteBool('Collection', 'Bar.1.MyBool', True);
+  Ini := nil;
+
+  C := TTestCollection.Create;
+  try
+    Config.DeclaredOnly := True;
+    Config.StorePublic := True;
+    Config.Load(C, 'Collection');
+
+    CheckEquals(45, C.Foo, 'C.Foo');
+    CheckEquals(2, C.Bar.Count, 'Collection count');
+    CheckEquals('Item 1', TTestCollectionItem(C.Bar.Items[0]).SomeVal);
+    CheckEquals(False, TTestCollectionItem(C.Bar.Items[0]).MyBool);
+    CheckEquals('Item 2', TTestCollectionItem(C.Bar.Items[1]).SomeVal);
+    CheckEquals(True, TTestCollectionItem(C.Bar.Items[1]).MyBool);
+  finally
+    C.Free;
+  end;
+end;
+
 procedure TestTASCustomConfig.TestLoadEnum;
 var
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Ini := CreateIniFile;
   Ini.WriteString('Default', 'MyEnum', 'meFoo');
   Ini := nil;
   Obj: TTestObject;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Ini := CreateIniFile;
   Ini.WriteString('Default', 'Astring', 'My string');
   Ini.WriteInteger('Default', 'Aint', 44);
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Ini := CreateIniFile;
   Ini.WriteString('Default', 'Astring', 'My string');
   Ini.WriteInteger('Default', 'Aint', 44);
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Ini := CreateIniFile;
   Ini.WriteString('Default', 'Astring', 'My string');
   Ini.WriteInteger('Default', 'Aint', 44);
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Obj := TTestDescendent.Create;
   try
     Obj.AnotherProp := True;
   CheckTrue(Ini.ReadBool('Default', 'AnotherProp', False));
 end;
 
+procedure TestTASCustomConfig.TestSaveCollection;
+var
+  C: TTestCollection;
+  Ini: IASConfigFile;
+begin
+  C := TTestCollection.Create;
+  try
+    C.Foo := 54;
+    with C.Bar.Add as TTestCollectionItem do begin
+      SomeVal := 'First val';
+      MyBool := True;
+    end;
+    with C.Bar.Add as TTestCollectionItem do begin
+      SomeVal := 'Second val';
+      MyBool := False;
+    end;
+
+    Config.DeclaredOnly := True;
+    Config.StorePublic := True;
+    Config.Save(C, 'Collection');
+  finally
+    C.Free;
+  end;
+
+  Ini := CreateIniFile;
+  CheckEquals(54, Ini.ReadInteger('Collection', 'Foo', 54));
+  CheckEquals(2, Ini.ReadInteger('Collection', 'Bar.Count', 0));
+  CheckEquals('First val', Ini.ReadString('Collection', 'Bar.0.SomeVal', ''));
+  CheckEquals(True, Ini.ReadBool('Collection', 'Bar.0.MyBool', False));
+  CheckEquals('Second val', Ini.ReadString('Collection', 'Bar.1.SomeVal', ''));
+  CheckEquals(False, Ini.ReadBool('Collection', 'Bar.1.MyBool', True));
+end;
+
 procedure TestTASCustomConfig.TestSaveEnum;
 var
   Obj: TTestDescendent;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Obj := TTestDescendent.Create;
   try
     Obj.MyEnum := meBar;
   CheckEqualsString('meBar', Ini.ReadString('Default', 'MyEnum', ''));
 end;
 
+procedure TestTASCustomConfig.TestSaveStringList;
+var
+  S: TStringList;
+begin
+  Config.Clear;
+
+  S := TStringList.Create;
+  try
+    S.Add('First line');
+    S.Add('Second line...');
+    S.Add('--');
+    S.Add('And last (fourth) line.');
+    Config.Save(S, 'S');
+
+    with CreateIniFile do begin
+      CheckEquals(S.CommaText, ReadString('S', 'CommaText', ''));
+    end;
+  finally
+    S.Free;
+  end;
+end;
+
 procedure TestTASCustomConfig.TestSaveToIniFile;
 var
   Obj: TTestObject;
   Ini: IASConfigFile;
 begin
-  Config.Clear;
-
   Obj := TTestObject.Create;
   try
     Obj.Astring := 'A string';
   CheckEquals(55, Ini.ReadInteger('Default', 'Aint', 0), '[Default]');
 end;
 
+procedure TestTASCustomConfig.TestSearchPath;
+var
+  Obj: TTestObject;
+  Ini: IASConfigFile;
+
+type
+  TRec = record
+    Section: string;
+    IsInt: Boolean;
+    Aint: Integer;
+    Astring: string;
+  end;
+
+const
+  T1: array[0..2] of TRec = (
+    (Section: 'Default'; IsInt: False; Astring: 'def string'),
+    (Section: 'Default'; IsInt: True; Aint: 123),
+    (Section: 'Up1/Default'; IsInt: True; Aint: 231)
+  );
+
+  T2: array[0..1] of TRec = (
+    (Section: 'Up1/Default'; IsInt: False; Astring: 'up1 string'),
+    (Section: 'Up2/Default'; IsInt: True; Aint: 312)
+  );
+
+  T3: array[0..2] of TRec = (
+    (Section: 'Up2/Default'; IsInt: False; Astring: 'up2 string'),
+    (Section: 'Up1/Default'; IsInt: True; Aint: 231),
+    (Section: 'Up2/Default'; IsInt: True; Aint: 312)
+  );
+
+  procedure SetupIni(const Data: array of TRec);
+  var
+    R: TRec;
+  begin
+    Config.Clear;
+    Ini := CreateIniFile;
+    try
+      for R in Data do
+        if R.IsInt then
+          Ini.WriteInteger(R.Section, 'Aint', R.Aint)
+        else
+          Ini.WriteString(R.Section, 'Astring', R.Astring);
+    finally
+      Ini := nil;
+    end;
+  end;
+
+  procedure CheckObj(const Astring: string; Aint: Integer; const Msg: string);
+  begin
+    CheckEquals(Astring, Obj.Astring, Msg);
+    CheckEquals(Aint, Obj.Aint, Msg);
+  end;
+
+  procedure TestRec(const T: array of TRec; const ExpectString: string; ExpectInt: Integer; const Msg: string);
+  begin
+    SetupIni(T);
+    Config.Load(Obj);
+    CheckObj(ExpectString, ExpectInt, Msg);
+  end;
+
+begin
+
+  Obj := TTestObject.Create;
+  try
+    Config.SearchPath.Add('Root=');
+    Config.SearchPath.Add('My Up=Up1/');
+    Config.SearchPath.Add('My other up=Up2/');
+    Config.StorePublic := True;
+
+    TestRec(T1, 'def string', 123, 'T1');
+    TestRec(T2, 'up1 string', 312, 'T2');
+    TestRec(T3, 'up2 string', 231, 'T3');
+
+  finally
+    Obj.Free;
+  end;
+end;
+
 { TestTASConfigIniFile }
 
 function TestTASConfigIniFile.CreateIniFile: IASConfigFile;
   end;
 end;
 
+{ TTestCollection }
+
+constructor TTestCollection.Create;
+begin
+  FBar := TCollection.Create(TTestCollectionItem);
+end;
+
+destructor TTestCollection.Destroy;
+begin
+  FreeAndNil(FBar);
+  inherited;
+end;
+
 initialization
   // Register any test cases with the test runner
   RegisterTest(TestTASConfigIniFile.Suite);

Binary file modified.

Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.