unit IniObjStore;
interface
uses
Classes, IniFiles;
procedure StoreObj(
const Instance : TObject;
const Ini : TCustomIniFile;
const Section :
string );
procedure LoadObj(
const Instance : TObject;
const Ini : TCustomIniFile;
const Section :
string );
implementation
uses
SysUtils,
TypInfo;
const
C_Sec_Delim = '
\';
procedure StoreObj(
const Instance : TObject;
const Ini : TCustomIniFile;
const Section :
string );
procedure EraseSection;
var
LSubSections : TStrings;
LIdx : Integer;
begin
LSubSections := TStringList.Create;
try
Ini.ReadSubSections( Section, LSubSections, True );
for LIdx := 0
to Pred( LSubSections.Count )
do
Ini.EraseSection( Section + C_Sec_Delim + LSubSections[LIdx] );
finally
LSubSections.Free;
end;
Ini.EraseSection( Section );
end;
var
LPropName, LPropValue :
string;
LPropInfo : PPropInfo;
LPropCount : Integer;
LPropList : PPropList;
LPropType : PPTypeInfo;
LIdx : Integer;
LObj : TObject;
LItem : TCollectionItem;
begin
EraseSection;
if not Assigned( Instance )
then
Exit;
// TCollection-Handling
if Instance
is TCollection
then
for LItem
in ( Instance
as TCollection )
do
// recursive call
StoreObj( LItem, Ini, Section + C_Sec_Delim + IntToStr( LItem.
Index ) );
if Instance
is TStrings
then
with ( Instance
as TStrings )
do
for LIdx := 0
to Pred( Count )
do
Ini.WriteString( Section + C_Sec_Delim + '
Strings', IntToStr( LIdx ), Strings[LIdx] );
// examine all published properties
LPropCount := GetPropList( PTypeInfo( Instance.ClassInfo ), LPropList );
if LPropCount > 0
then
try
for LIdx := 0
to Pred( LPropCount )
do
begin
LPropInfo := LPropList^[LIdx];
LPropType := LPropInfo^.PropType;
if LPropType^.Kind = tkMethod
then
Continue;
// WriteOnly-Property
if ( LPropInfo.GetProc =
nil )
then
Continue;
LPropName :=
string( LPropInfo.
Name );
case LPropType^.Kind
of
tkClass :
begin
LObj := GetObjectProp( Instance, LPropName );
// recursive call
StoreObj( LObj, Ini, Section + C_Sec_Delim + LPropName );
end;
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkInt64, tkUString :
begin
// ReadOnly-Property
if ( LPropInfo.SetProc =
nil )
then
Continue;
LPropValue := GetPropValue( Instance, LPropName );
Ini.WriteString( Section, LPropName, LPropValue );
end;
end;
end;
finally
FreeMem( LPropList );
end;
end;
procedure LoadObj(
const Instance : TObject;
const Ini : TCustomIniFile;
const Section :
string );
var
LPropName, LPropValue :
string;
LPropInfo : PPropInfo;
LPropCount : Integer;
LPropList : PPropList;
LPropType : PPTypeInfo;
LIdx : Integer;
LObj : TObject;
begin
if not Assigned( Instance )
then
Exit;
// TCollection-Handling
if Instance
is TCollection
then
with Instance
as TCollection
do
begin
Clear;
LIdx := 0;
while Ini.SectionExists( Section + C_Sec_Delim + IntToStr( LIdx ) )
do
begin
// recursive call
LoadObj( Add, Ini, Section + C_Sec_Delim + IntToStr( LIdx ) );
Inc( LIdx );
end;
end;
if Instance
is TStrings
then
with Instance
as TStrings
do
begin
BeginUpdate;
try
Clear;
LIdx := 0;
while Ini.ValueExists( Section + C_Sec_Delim + '
Strings', IntToStr( LIdx ) )
do
begin
Add( Ini.ReadString( Section + C_Sec_Delim + '
Strings', IntToStr( LIdx ) ) );
Inc( LIdx );
end;
finally
EndUpdate;
end;
end;
// examine all published properties
LPropCount := GetPropList( PTypeInfo( Instance.ClassInfo ), LPropList );
if LPropCount > 0
then
try
for LIdx := 0
to Pred( LPropCount )
do
begin
LPropInfo := LPropList^[LIdx];
LPropType := LPropInfo^.PropType;
if LPropType^.Kind = tkMethod
then
Continue;
LPropName :=
string( LPropInfo.
Name );
case LPropType^.Kind
of
tkClass :
begin
LObj := GetObjectProp( Instance, LPropName );
// recursive call
LoadObj( LObj, Ini, Section + C_Sec_Delim + LPropName );
end;
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkInt64, tkUString :
begin
// ReadOnly-Property
if LPropInfo.SetProc =
nil
then
Continue;
LPropValue := GetPropValue( Instance, LPropName );
LPropValue := Ini.ReadString( Section, LPropName, LPropValue );
SetPropValue( Instance, LPropName, LPropValue );
end;
end;
end;
finally
FreeMem( LPropList );
end;
end;
end.