Componentes.Terceros.jvcl/official/3.32/run/JvPropertyStore.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvPropertyStore.pas, released on 2003-11-13.

The Initial Developer of the Original Code is Jens Fudickar
Portions created by Marcel Bestebroer are Copyright (C) 2003 Jens Fudickar
All Rights Reserved.

Contributor(s):
  Marcel Bestebroer

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvPropertyStore.pas 11164 2007-01-25 23:29:17Z jfudickar $

unit JvPropertyStore;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes,
  JvAppStorage, JvComponentBase;

type
  TJvIgnorePropertiesStringList = class(TStringList)
  public
    procedure AddDelete(AItem: string; ADelete: Boolean);
  end;

  TJvCustomPropertyStore = class(TJvComponent)
  private
    FAppStoragePath: string;
    FAppStorage: TJvCustomAppStorage;
    FEnabled: Boolean;
    FReadOnly: Boolean;
    FDeleteBeforeStore: Boolean;
    FClearBeforeLoad: Boolean;
    FIntIgnoreProperties: TStringList;
    FIgnoreProperties: TJvIgnorePropertiesStringList;
    FAutoLoad: Boolean;
    FLastLoadTime: TDateTime;
    FIgnoreLastLoadTime: Boolean;
    FCombinedIgnoreProperties: TStringList;
    FOnBeforeLoadProperties: TNotifyEvent;
    FOnAfterLoadProperties: TNotifyEvent;
    FOnBeforeStoreProperties: TNotifyEvent;
    FOnAfterStoreProperties: TNotifyEvent;
    FSynchronizeStoreProperties: Boolean;
    FSynchronizeLoadProperties: Boolean;
    procedure SetAutoLoad(Value: Boolean);
    function GetIgnoreProperties: TJvIgnorePropertiesStringList;
    procedure SetIgnoreProperties(Value: TJvIgnorePropertiesStringList);
    function GetPropCount(Instance: TPersistent): Integer;
    function GetPropName(Instance: TPersistent; Index: Integer): string;
    procedure CloneClass(Src, Dest: TPersistent);
    function GetLastSaveTime: TDateTime;
  protected
    procedure UpdateChildPaths(OldPath: string = ''); virtual;
    procedure SetPath(Value: string); virtual;
    procedure SetAppStorage(Value: TJvCustomAppStorage); virtual;
    procedure Loaded; override;
    procedure DisableAutoLoadDown;
    procedure LoadData; virtual;
    procedure StoreData; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetCombinedIgnoreProperties: TStringList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure StoreProperties; virtual;
    procedure LoadProperties; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; virtual;
    function TranslatePropertyName(AName: string): string; virtual;
    property AppStorage: TJvCustomAppStorage read FAppStorage write SetAppStorage;
    property CombinedIgnoreProperties: TStringList read GetCombinedIgnoreProperties;
    property IgnoreProperties: TJvIgnorePropertiesStringList read GetIgnoreProperties write SetIgnoreProperties;
    property AutoLoad: Boolean read FAutoLoad write SetAutoLoad;
    property AppStoragePath: string read FAppStoragePath write SetPath;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property DeleteBeforeStore: Boolean read FDeleteBeforeStore write FDeleteBeforeStore default False;
    property ClearBeforeLoad: Boolean read FClearBeforeLoad write FClearBeforeLoad default False;
    property IgnoreLastLoadTime: Boolean read FIgnoreLastLoadTime write FIgnoreLastLoadTime default False;
    property OnBeforeLoadProperties: TNotifyEvent read FOnBeforeLoadProperties write FOnBeforeLoadProperties;
    property OnAfterLoadProperties: TNotifyEvent read FOnAfterLoadProperties write FOnAfterLoadProperties;
    property OnBeforeStoreProperties: TNotifyEvent read FOnBeforeStoreProperties write FOnBeforeStoreProperties;
    property OnAfterStoreProperties: TNotifyEvent read FOnAfterStoreProperties write FOnAfterStoreProperties;
    //1 Synchronize the StoreProperties procedure
    /// Defines if the execution of the StoreProperties procedure for the current
    /// AppStoragePath should be synchronized via a global mutex
    property SynchronizeStoreProperties: Boolean read FSynchronizeStoreProperties
        write FSynchronizeStoreProperties default False;
    //1 Synchronize the LoadProperties procedure
    /// Defines if the execution of the LoadProperties procedure for the current
    /// AppStoragePath should be synchronized via a global mutex
    property SynchronizeLoadProperties: Boolean read FSynchronizeLoadProperties
        write FSynchronizeLoadProperties default False;
    property Tag;
  end;

  TJvCustomPropertyListStore = class(TJvCustomPropertyStore)
  private
    FItems: TStringList;
    FFreeObjects: Boolean;
    FCreateListEntries: Boolean;
    FItemName: string;
    function GetItems: TStringList;
  protected
    function GetString(Index: Integer): string;
    function GetObject(Index: Integer): TObject;
    procedure SetString(Index: Integer; Value: string);
    procedure SetObject(Index: Integer; Value: TObject);
    function GetCount: Integer;
    procedure ReadSLOItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject;const Index: Integer; const ItemName: string);
    procedure WriteSLOItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const Index: Integer; const ItemName: string);
    procedure DeleteSLOItems(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const First, Last: Integer; const ItemName: string);
    function CreateItemList: TStringList; virtual;
    function CreateObject: TObject; virtual;
    function GetSorted: Boolean;
    procedure SetSorted(Value: Boolean);
    function GetDuplicates: TDuplicates;
    procedure SetDuplicates(Value: TDuplicates);
    procedure StoreData; override;
    procedure LoadData; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    property Strings[Index: Integer]: string read GetString write SetString;
    property Objects[Index: Integer]: TObject read GetObject write SetObject;
    property Items: TStringList read GetItems;
    property Count: Integer read GetCount;
    { Defines if the Items.Objects- Objects will be freed inside the clear procedure }
    property FreeObjects: Boolean read FFreeObjects write FFreeObjects default True;
    { Defines if new List entries will be created if there are stored entries, which
      are not in the current object }
    property CreateListEntries: Boolean read FCreateListEntries write FCreateListEntries default True;
    property ItemName: string read FItemName write FItemName;
    property Sorted: Boolean read GetSorted write SetSorted;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvPropertyStore.pas $';
    Revision: '$Revision: 11164 $';
    Date: '$Date: 2007-01-26 00:29:17 +0100 (ven., 26 janv. 2007) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  Consts, SysUtils, TypInfo,
  JclSynch,
  JvStrings, JvResources;

const
  cLastSaveTime = 'Last Save Time';
  cObject = 'Object';
  cItem = 'Item';

//=== { TCombinedStrings } ===================================================

type
  // Read-only TStrings combining multiple TStrings instances in a single list
  TCombinedStrings = class(TStringList)
  private
    FList: TList;
  protected
    function Get(Index: Integer): string; override;
    function GetObject(Index: Integer): TObject; override;
    function GetCount: Integer; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddStrings(Strings: TStrings); override;
//    procedure DeleteStrings(Strings: TStrings);
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;

constructor TCombinedStrings.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TCombinedStrings.Destroy;
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

function TCombinedStrings.Get(Index: Integer): string;
var
  OrgIndex: Integer;
  I: Integer;
begin
  OrgIndex := Index;
  I := 0;
  if Index < 0 then
    Error(SListIndexError, Index);
  while (I < FList.Count) and (Index >= TStrings(FList[I]).Count) do
  begin
    Dec(Index, TStrings(FList[I]).Count);
    Inc(I);
  end;
  if I >= FList.Count then
    Error(SListIndexError, OrgIndex);
  Result := TStrings(FList[I])[Index];
end;

function TCombinedStrings.GetObject(Index: Integer): TObject;
var
  OrgIndex: Integer;
  I: Integer;
begin
  OrgIndex := Index;
  I := 0;
  if Index < 0 then
    Error(SListIndexError, Index);
  while (Index < TStrings(FList[I]).Count) and (I < FList.Count) do
  begin
    Dec(Index, TStrings(FList[I]).Count);
    Inc(I);
  end;
  if I >= FList.Count then
    Error(SListIndexError, OrgIndex);
  Result := TStrings(FList[I]).Objects[Index];
end;

function TCombinedStrings.GetCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to FList.Count - 1 do
    Inc(Result, TStrings(FList[I]).Count);
end;

procedure TCombinedStrings.AddStrings(Strings: TStrings);
begin
  if FList.IndexOf(Strings) = -1 then
    FList.Add(Strings);
end;

(*
procedure TCombinedStrings.DeleteStrings(Strings: TStrings);
begin
  FList.Remove(Strings);
end;
*)

procedure TCombinedStrings.Clear;
begin
  FList.Clear;
end;

procedure TCombinedStrings.Delete(Index: Integer);
begin
end;

procedure TCombinedStrings.Insert(Index: Integer; const S: string);
begin
end;

//=== { TJvIgnorePropertiesStringList } ======================================

procedure TJvIgnorePropertiesStringList.AddDelete(AItem: string; ADelete: Boolean);
begin
  if ADelete then
  begin
    if IndexOf(AItem) >= 0 then
      Delete(IndexOf(AItem));
  end
  else
  begin
    if IndexOf(AItem) < 0 then
     Add(AItem);
  end;
end;

//=== { TJvCustomPropertyStore } =============================================

constructor TJvCustomPropertyStore.Create(AOwner: TComponent);
const
  IgnorePropertyList: array [1..18] of string =
   (
    'AboutJVCL',
    'AppStorage',
    'AppStoragePath',
    'AutoLoad',
    'ClearBeforeLoad',
    'Name',
    'Tag',
    'Enabled',
    'ReadOnly',
    'DeleteBeforeStore',
    'IgnoreLastLoadTime',
    'IgnoreProperties',
    'OnBeforeLoadProperties',
    'OnAfterLoadProperties',
    'OnBeforeStoreProperties',
    'OnAfterStoreProperties',
    'SynchronizeLoadProperties',
    'SynchronizeStoreProperties'
   );
var
  I: Integer;
begin
  inherited Create(AOwner);
  FLastLoadTime := Now;
  FAppStorage := nil;
  FEnabled := True;
  FReadOnly := False;
  FDeleteBeforeStore := False;
  FAutoLoad := False;
  FIntIgnoreProperties := TStringList.Create;
  FIgnoreProperties := TJvIgnorePropertiesStringList.Create;
  FIgnoreLastLoadTime := False;
  FCombinedIgnoreProperties := TCombinedStrings.Create;
  for I := Low(IgnorePropertyList) to High(IgnorePropertyList) do
    FIntIgnoreProperties.Add(IgnorePropertyList[I]);
  FSynchronizeStoreProperties := False;
  FSynchronizeLoadProperties := False;
end;

destructor TJvCustomPropertyStore.Destroy;
begin
  if not (csDesigning in ComponentState) then
    if AutoLoad then
      StoreProperties;
  FreeAndNil(FCombinedIgnoreProperties);
  FreeAndNil(FIntIgnoreProperties);
  FreeAndNil(FIgnoreProperties);
  Clear;
  inherited Destroy;
end;

procedure TJvCustomPropertyStore.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FAppStorage) then
    FAppStorage := nil;
end;

function TJvCustomPropertyStore.GetCombinedIgnoreProperties: TStringList;
begin
  FCombinedIgnoreProperties.Assign(FIntIgnoreProperties);
  FCombinedIgnoreProperties.AddStrings(FIgnoreProperties);
  Result := FCombinedIgnoreProperties;
end;

function TJvCustomPropertyStore.GetPropCount(Instance: TPersistent): Integer;
var
  Data: PTypeData;
begin
  Data := GetTypeData(Instance.ClassInfo);
  Result := Data.PropCount;
end;

function TJvCustomPropertyStore.GetPropName(Instance: TPersistent; Index: Integer): string;
var
  PropList: PPropList;
  PropInfo: PPropInfo;
  Data: PTypeData;
begin
  Result := '';
  Data := GetTypeData(Instance.ClassInfo);
  {$IFDEF CLR}
  PropList := GetPropInfos(Instance.ClassInfo);
  PropInfo := PropList[Index];
  Result := PropInfo.Name;
  {$ELSE}
  GetMem(PropList, Data^.PropCount * SizeOf(PPropInfo));
  try
    GetPropInfos(Instance.ClassInfo, PropList);
    PropInfo := PropList^[Index];
    Result := PropInfo^.Name;
  finally
    FreeMem(PropList, Data^.PropCount * SizeOf(PPropInfo));
  end;
  {$ENDIF CLR}
end;

procedure TJvCustomPropertyStore.CloneClass(Src, Dest: TPersistent);
var
  Index: Integer;
  SrcPropInfo: PPropInfo;
  DestPropInfo: PPropInfo;

  function GetPropKind(PropInfo: PPropInfo): TTypeKind;
  begin
    {$IFDEF CLR}
    Result := PropInfo.TypeKind;
    {$ELSE}
    Result := PropInfo.PropType^.Kind;
    {$ENDIF CLR}
  end;

begin
  for Index := 0 to GetPropCount(Src) - 1 do
    if CompareText(GetPropName(Src, Index), 'Name') <> 0 then
    begin
      SrcPropInfo  := GetPropInfo(Src.ClassInfo, GetPropName(Src, Index));
      DestPropInfo := GetPropInfo(Dest.ClassInfo, GetPropName(Src, Index));
      if (DestPropInfo <> nil) and (GetPropKind(DestPropInfo) = GetPropKind(SrcPropInfo)) then
        case GetPropKind(DestPropInfo) of
          tkLString, tkString:
            SetStrProp(Dest, DestPropInfo, GetStrProp(Src, SrcPropInfo));
          tkInteger, tkChar, tkEnumeration, tkSet:
            SetOrdProp(Dest, DestPropInfo, GetOrdProp(Src, SrcPropInfo));
          tkFloat:
            SetFloatProp(Dest, DestPropInfo, GetFloatProp(Src, SrcPropInfo));
          tkVariant:
            SetVariantProp(Dest, DestPropInfo, GetVariantProp(Src, SrcPropInfo));
          tkClass:
            TPersistent(GetObjectProp(Dest, DestPropInfo)).Assign(TPersistent(GetObjectProp(Src, SrcPropInfo)));
          tkMethod:
            SetMethodProp(Dest, DestPropInfo, GetMethodProp(Src, SrcPropInfo));
        end;
    end;
end;

procedure TJvCustomPropertyStore.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
    if AutoLoad then
      LoadProperties;
end;

procedure TJvCustomPropertyStore.Assign(Source: TPersistent);
begin
  if Source is Self.ClassType then
    CloneClass(Source, Self)
  else
    inherited Assign(Source);
end;

procedure TJvCustomPropertyStore.Clear;
begin
end;

function TJvCustomPropertyStore.TranslatePropertyName(AName: string): string;
begin
  Result := AName;
end;

procedure TJvCustomPropertyStore.SetAutoLoad(Value: Boolean);
begin
  if not Assigned(Owner) then
    Exit;
  if Owner is TJvCustomPropertyStore then
    FAutoLoad := False
  else
  if Value <> AutoLoad then
    FAutoLoad := Value;
end;

procedure TJvCustomPropertyStore.DisableAutoLoadDown;
var
  Index: Integer;
  PropName: string;
begin
  for Index := 0 to GetPropCount(Self) - 1 do
  begin
    PropName := GetPropName(Self, Index);
    if IgnoreProperties.IndexOf(PropName) < 0 then
      if FIntIgnoreProperties.IndexOf(PropName) < 0 then
        if PropType(Self, GetPropName(Self, Index)) = tkClass then
          if (TPersistent(GetObjectProp(Self, PropName)) is TJvCustomPropertyStore) then
            TJvCustomPropertyStore(TPersistent(GetObjectProp(Self, PropName))).AutoLoad := False;
  end;
end;

procedure TJvCustomPropertyStore.UpdateChildPaths(OldPath: string);
var
  Index: Integer;
  VisPropName: string;
  PropName: string;
  PropertyStore: TJvCustomPropertyStore;
begin
  if Assigned(AppStorage) then
  begin
    if OldPath = '' then
      OldPath := AppStoragePath;
    for Index := 0 to GetPropCount(Self) - 1 do
    begin
      PropName := GetPropName(Self, Index);
      VisPropName := AppStorage.TranslatePropertyName(Self, PropName, False);
      // (rom) very bad style. Better stacked if chain like the other ones.
      if IgnoreProperties.IndexOf(PropName) >= 0 then
        Continue;
      if FIntIgnoreProperties.IndexOf(PropName) >= 0 then
        Continue;
      if PropType(Self, PropName) = tkClass then
        if (TPersistent(GetObjectProp(Self, PropName)) is TJvCustomPropertyStore) then
        begin
          PropertyStore := TJvCustomPropertyStore(TPersistent(GetObjectProp(Self, PropName)));
          if (PropertyStore.AppStoragePath = AppStorage.ConcatPaths([OldPath, VisPropName])) or
            (PropertyStore.AppStoragePath = '') then
            PropertyStore.AppStoragePath := AppStorage.ConcatPaths([AppStoragePath, VisPropName]);
        end;
    end;
  end;
end;

procedure TJvCustomPropertyStore.SetPath(Value: string);
var
  OldPath: string;
begin
  OldPath := FAppStoragePath;
  if Value <> AppStoragePath then
    FAppStoragePath := Value;
  UpdateChildPaths(OldPath);
end;

procedure TJvCustomPropertyStore.SetAppStorage(Value: TJvCustomAppStorage);
var
  Index: Integer;
  PropName: string;
begin
  if Value <> FAppStorage then
  begin
    for Index := 0 to GetPropCount(Self) - 1 do
    begin
      PropName := GetPropName(Self, Index);
      // (rom) very bad style. Better stacked if chain like the other ones.
      if IgnoreProperties.IndexOf(PropName) >= 0 then
        Continue;
      if FIntIgnoreProperties.IndexOf(PropName) >= 0 then
        Continue;
      if PropType(Self, PropName) = tkClass then
        if (TPersistent(GetObjectProp(Self, PropName)) is TJvCustomPropertyStore) then
          TJvCustomPropertyStore(TPersistent(GetObjectProp(Self, PropName))).AppStorage := Value;
    end;
    FAppStorage := Value;
    UpdateChildPaths;
  end;
end;

function TJvCustomPropertyStore.GetIgnoreProperties: TJvIgnorePropertiesStringList;
begin
  Result := FIgnoreProperties;
end;

procedure TJvCustomPropertyStore.SetIgnoreProperties(Value: TJvIgnorePropertiesStringList);
begin
  FIgnoreProperties.Assign(Value);
end;

function TJvCustomPropertyStore.GetLastSaveTime: TDateTime;
begin
  Result := 0;
  if not Enabled then
    Exit;
  if AppStoragePath = '' then
    Exit;
  try
    if AppStorage.ValueStored(AppStorage.ConcatPaths([AppStoragePath, cLastSaveTime])) then
      Result := AppStorage.ReadDateTime(AppStorage.ConcatPaths([AppStoragePath, cLastSaveTime]));
  except
    Result := 0;
  end;
end;

procedure TJvCustomPropertyStore.LoadProperties;
var
  JclMutex: TJclMutex;

  procedure ExecuteLoadProperties;
  begin
    AppStorage.BeginUpdate;
    try
      UpdateChildPaths;
      FLastLoadTime := Now;
      if ClearBeforeLoad then
        Clear;
      if Assigned(FOnBeforeLoadProperties) then
        FOnBeforeLoadProperties(Self);
      LoadData;
      AppStorage.ReadPersistent(AppStoragePath, Self, True, True, CombinedIgnoreProperties);
      if Assigned(FOnAfterLoadProperties) then
        FOnAfterLoadProperties(Self);
    finally
      AppStorage.EndUpdate;
    end;
  end;


begin
  if not Enabled then
    Exit;
  if not Assigned(AppStorage) then
    Exit;

  if SynchronizeLoadProperties then
  begin
    JclMutex := TJclMutex.Create(nil, False,
      B64Encode(RsJvPropertyStoreMutexLoadPropertiesProcedureName + AppStoragePath));
    try
      if JclMutex.WaitForever = wrSignaled then
      try
        ExecuteLoadProperties;
      finally
        JclMutex.Release;
      end
      else
        raise Exception.CreateResFmt(@RsJvPropertyStoreEnterMutexTimeout, [RsJvPropertyStoreMutexStorePropertiesProcedureName]);
    finally
      FreeAndNil(JclMutex);
    end;
  end
  else
    ExecuteLoadProperties;
end;

procedure TJvCustomPropertyStore.StoreProperties;
var
  SaveProperties: Boolean;
  JclMutex: TJclMutex;

  procedure ExecuteStoreProperties;
  begin
    AppStorage.BeginUpdate;
    try
      UpdateChildPaths;
      DisableAutoLoadDown;
      SaveProperties := IgnoreLastLoadTime or (GetLastSaveTime < FLastLoadTime);
      if DeleteBeforeStore then
        AppStorage.DeleteSubTree(AppStoragePath);
      if not IgnoreLastLoadTime then
        AppStorage.WriteString(AppStorage.ConcatPaths([AppStoragePath, cLastSaveTime]), DateTimeToStr(Now));
      if Assigned(FOnBeforeStoreProperties) then
        FOnBeforeStoreProperties(Self);
      if SaveProperties then
        StoreData;
      AppStorage.WritePersistent(AppStoragePath, Self, True, CombinedIgnoreProperties);
      if Assigned(FOnAfterStoreProperties) then
        FOnAfterStoreProperties(Self);
    finally
      AppStorage.EndUpdate;
    end;
  end;

begin
  if not Enabled then
    Exit;
  if ReadOnly then
    Exit;
  if not Assigned(AppStorage) then
    Exit;

  if SynchronizeStoreProperties then
  begin
    JclMutex := TJclMutex.Create(nil, False,
      B64Encode(RsJvPropertyStoreMutexStorePropertiesProcedureName + AppStoragePath));
    try
      if JclMutex.WaitForever = wrSignaled then
      try
        ExecuteStoreProperties;
      finally
        JclMutex.Release;
      end
      else
        raise Exception.CreateResFmt(@RsJvPropertyStoreEnterMutexTimeout, [RsJvPropertyStoreMutexStorePropertiesProcedureName]);
    finally
      FreeAndNil(JclMutex);
    end;
  end
  else
    ExecuteStoreProperties;
end;

procedure TJvCustomPropertyStore.LoadData;
begin
end;

procedure TJvCustomPropertyStore.StoreData;
begin
end;

//=== { TJvCustomPropertyListStore } =========================================

constructor TJvCustomPropertyListStore.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := CreateItemList;
  CreateListEntries := True;
  FreeObjects := True;
  FItemName := cItem;
  FIntIgnoreProperties.Add('ItemName');
  FIntIgnoreProperties.Add('FreeObjects');
  FIntIgnoreProperties.Add('CreateListEntries');
end;

destructor TJvCustomPropertyListStore.Destroy;
begin
  Clear;
  FreeAndNil(FItems);
  inherited Destroy;
end;

function TJvCustomPropertyListStore.GetItems: TStringList;
begin
  Result := FItems;
end;

procedure TJvCustomPropertyListStore.StoreData;
begin
  inherited StoreData;
  AppStorage.WriteList(AppStoragePath, nil, Count, WriteSLOItem, DeleteSLOItems, ItemName);
end;

procedure TJvCustomPropertyListStore.LoadData;
begin
  inherited LoadData;
  AppStorage.ReadList(AppStoragePath, nil, ReadSLOItem, ItemName);
end;

procedure TJvCustomPropertyListStore.Clear;
var
  I: Integer;
begin
  if FreeObjects then
    for I := 0 to Count - 1 do
      if Assigned(Objects[I]) then
      begin
        Objects[I].Free;
        Objects[I] := nil;
      end;
  if Assigned(Items) then
    Items.Clear;
  inherited Clear;
end;

function TJvCustomPropertyListStore.CreateItemList: TStringList;
begin
  Result := TStringList.Create;
end;

function TJvCustomPropertyListStore.CreateObject: TObject;
begin
  Result := nil;
end;

function TJvCustomPropertyListStore.GetString(Index: Integer): string;
begin
  if Assigned(Items) then
    Result := Items.Strings[Index]
  else
    Result := '';
end;

function TJvCustomPropertyListStore.GetObject(Index: Integer): TObject;
begin
  if Assigned(Items) then
    Result := Items.Objects[Index]
  else
    Result := nil;
end;

procedure TJvCustomPropertyListStore.SetString(Index: Integer; Value: string);
begin
  Items.Strings[Index] := Value;
end;

procedure TJvCustomPropertyListStore.SetObject(Index: Integer; Value: TObject);
begin
  Items.Objects[Index] := Value;
end;

function TJvCustomPropertyListStore.GetCount: Integer;
begin
  if Assigned(Items) then
    Result := Items.Count
  else
    Result := -1;
end;

function TJvCustomPropertyListStore.GetSorted: Boolean;
begin
  Result := FItems.Sorted;
end;

procedure TJvCustomPropertyListStore.SetSorted (Value: Boolean);
begin
  FItems.Sorted := Value;
end;

function TJvCustomPropertyListStore.GetDuplicates: TDuplicates;
begin
  Result := FItems.Duplicates;
end;

procedure TJvCustomPropertyListStore.SetDuplicates (Value: TDuplicates);
begin
  FItems.Duplicates := Value;
end;

procedure TJvCustomPropertyListStore.ReadSLOItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewObject: TObject;
  NewObjectName: string;
begin
  if Index >= Count then
  begin
    if not CreateListEntries then
      Exit;
    NewObject := CreateObject;
    if Assigned(NewObject) then
    begin
      if NewObject is TJvCustomPropertyStore then
      begin
        TJvCustomPropertyStore(NewObject).AppStoragePath :=
          Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
        TJvCustomPropertyStore(NewObject).AppStorage := AppStorage;
        TJvCustomPropertyStore(NewObject).LoadProperties;
      end
      else
      if NewObject is TPersistent then
        Sender.ReadPersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]),
          TPersistent(NewObject), True, True, CombinedIgnoreProperties);
      if Sender.ValueStored(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)])) then
        NewObjectName := Sender.ReadString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]))
      else
        NewObjectName := '';
      Items.AddObject(NewObjectName, NewObject);
    end
    else
      Items.Add(Sender.ReadString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)])))
  end
  else
    if Assigned(Objects[Index]) then
    begin
      if Objects[Index] is TJvCustomPropertyStore then
      begin
        TJvCustomPropertyStore(Objects[Index]).AppStoragePath :=
          Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
        TJvCustomPropertyStore(Objects[Index]).LoadProperties;
      end
      else
      if Objects[Index] is TPersistent then
        Sender.ReadPersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]),
          TPersistent(Objects[Index]), True, True, CombinedIgnoreProperties);
      if Sender.ValueStored(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)])) then
        Strings[Index] := Sender.ReadString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]))
      else
        Strings[Index] := '';
    end
  else
    Strings[Index] := Sender.ReadString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]));
end;

procedure TJvCustomPropertyListStore.WriteSLOItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if Assigned(Objects[Index]) then
  begin
    if Objects[Index] is TJvCustomPropertyStore then
    begin
      TJvCustomPropertyStore(Objects[Index]).AppStoragePath :=
        Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
      TJvCustomPropertyStore(Objects[Index]).AppStorage := AppStorage;
      TJvCustomPropertyStore(Objects[Index]).StoreProperties;
    end
    else
    if Objects[Index] is TPersistent then
      Sender.WritePersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]),
        TPersistent(Objects[Index]), True, CombinedIgnoreProperties);
    if Strings[Index] <> '' then
      Sender.WriteString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]), Strings[Index]);
  end
  else
    Sender.WriteString(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]), Strings[Index]);
end;

procedure TJvCustomPropertyListStore.DeleteSLOItems(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  for I := First to Last do
    Sender.DeleteValue(Sender.ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.