jvqappstorage.pas

East make Tray Icon in delphi

  published
    property StorageOptions: TJvCustomAppStorageOptions read FStorageOptions write SetStorageOptions;
    property OnTranslatePropertyName: TJvAppStoragePropTranslateEvent read FOnTranslatePropertyName
      write FOnTranslatePropertyName;
    property OnEncryptPropertyValue: TJvAppStorageCryptEvent read FOnEncryptPropertyValue
      write FOnEncryptPropertyValue;
    property OnDecryptPropertyValue: TJvAppStorageCryptEvent read FOnDecryptPropertyValue
      write FOnDecryptPropertyValue;
  end;

  { Generic store that can only be used to combine various other storages (only storages in the
    SubStorages collection are usable; any references to paths not specified in this collection
    will raise an exception). Can be used for example to provide access to the entire registry
    hive from a single app store component by adding a number of TJvAppRegistryStorage storages,
    each referencing a specific root key and link them to a suitable root key path:

    RootPath              Store
    ========              =====
    HKCR                  asRegStoreHKCR
    HKEY_CLASSES_ROOT     asRegStoreHKCR
    HKCU                  asRegStoreHKCU
    HKEY_CURRENT_USER     asRegStoreHKCU
    HKLM                  asRegStoreHKLM
    HKEY_LOCAL_MACHINE    asRegStoreHKLM

    In the above scheme, both 'HKCU\<path>' as well as 'HKEY_CURRENT_USER'<path>' will link to
    asRegStoreHKCU, ie. HKCU and HKEY_CURRENT_USER are aliases of each other. }
  TJvAppStorage = class(TJvCustomAppStorage)
  protected
    function IsFolderInt(const Path: string; ListIsValue: Boolean = True): Boolean; override;
    function PathExistsInt(const Path: string): Boolean; override;
    function ValueStoredInt(const Path: string): Boolean; override;
    procedure DeleteValueInt(const Path: string); override;
    procedure DeleteSubTreeInt(const Path: string); override;
    function ReadIntegerInt(const Path: string; Default: Integer = 0): Integer; override;
    procedure WriteIntegerInt(const Path: string; Value: Integer); override;
    function ReadFloatInt(const Path: string; Default: Extended = 0): Extended; override;
    procedure WriteFloatInt(const Path: string; Value: Extended); override;
    function ReadStringInt(const Path: string; const Default: string = ''): string; override;
    procedure WriteStringInt(const Path: string; const Value: string); override;
    function ReadBinaryInt(const Path: string; Buf: Pointer; BufSize: Integer): Integer; override;
    procedure WriteBinaryInt(const Path: string; Buf: Pointer; BufSize: Integer); override;
    function ReadDateTimeInt(const Path: string; Default: TDateTime): TDateTime; override;
    procedure WriteDateTimeInt(const Path: string; Value: TDateTime); override;
    function ReadBooleanInt(const Path: string; Default: Boolean): Boolean; override;
    procedure WriteBooleanInt(const Path: string; Value: Boolean); override;
    procedure ReadEnumerationInt(const Path: string; TypeInfo: PTypeInfo; const Default; out Value); override;
    procedure WriteEnumerationInt(const Path: string; TypeInfo: PTypeInfo; const Value); override;
    procedure ReadSetInt(const Path: string; ATypeInfo: PTypeInfo; const Default; out Value); override;
    procedure WriteSetInt(const Path: string; ATypeInfo: PTypeInfo; const Value); override;
    property ReadOnly;
  published
    property SubStorages;
  end;

  TJvCustomAppStorageOptions = class(TPersistent)
  private
    FBooleanAsString: Boolean;
    FBooleanStringTrueValues: string;
    FBooleanStringFalseValues: string;
    FEnumAsStr: Boolean;
    FIntAsStr: Boolean;
    FSetAsStr: Boolean;
    FDateTimeAsString: Boolean;
    FFloatAsString: Boolean;
    FDefaultIfReadConvertError: Boolean;
    FDefaultIfValueNotExists: Boolean;
  protected
    procedure SetBooleanAsString(Value: Boolean); virtual;
    procedure SetBooleanStringTrueValues(Value: string); virtual;
    procedure SetBooleanStringFalseValues(Value: string); virtual;
    procedure SetEnumAsStr(Value: Boolean); virtual;
    procedure SetIntAsStr(Value: Boolean); virtual;
    procedure SetSetAsStr(Value: Boolean); virtual;
    procedure SetDateTimeAsStr(Value: Boolean); virtual;
    procedure SetFloatAsStr(Value: Boolean); virtual;
    procedure SetDefaultIfReadConvertError(Value: Boolean); virtual;
    procedure SetDefaultIfValueNotExists(Value: Boolean); virtual;
    function IsValueListString(const AValue, AList: string): Boolean; virtual;
  public
    constructor Create; virtual;
    function DefaultTrueString: string;
    function DefaultFalseString: string;
    function IsValueTrueString(Value: string): Boolean;
    function IsValueFalseString(Value: string): Boolean;

    property BooleanStringTrueValues: string read FBooleanStringTrueValues
      write SetBooleanStringTrueValues;
    property BooleanStringFalseValues: string read FBooleanStringFalseValues
      write SetBooleanStringFalseValues;
    property BooleanAsString: Boolean read FBooleanAsString write SetBooleanAsString default True;
    property EnumerationAsString: Boolean read FEnumAsStr write SetEnumAsStr default True;
    property TypedIntegerAsString: Boolean read FIntAsStr write SetIntAsStr default True;
    property SetAsString: Boolean read FSetAsStr write SetSetAsStr default False;
    property DateTimeAsString: Boolean read FDateTimeAsString write SetDateTimeAsStr default True;
    property FloatAsString: Boolean read FFloatAsString write SetFloatAsStr default False;
    property DefaultIfReadConvertError: Boolean read FDefaultIfReadConvertError
      write SetDefaultIfReadConvertError default False;
    property DefaultIfValueNotExists: Boolean read FDefaultIfValueNotExists
      write SetDefaultIfValueNotExists default True;
  end;

  TJvAppStorageOptions = class(TJvCustomAppStorageOptions)
  published
    property BooleanStringTrueValues;
    property BooleanStringFalseValues;
    property BooleanAsString;
    property EnumerationAsString;
    property TypedIntegerAsString;
    property SetAsString;
    property DateTimeAsString;
    property FloatAsString;
    property DefaultIfReadConvertError;
    property DefaultIfValueNotExists;
  end;

  TJvAppSubStorages = class(TOwnedCollection)
  private
    function GetRootStorage: TJvCustomAppStorage;
    function GetItem(I: Integer): TJvAppSubStorage;
    procedure SetItem(I: Integer; Value: TJvAppSubStorage);
  protected
    { Notify sub storages of a change in the options of the root storage. This allows sub storage
      to be kept in sync with the root storage. }
    procedure RootOptionsChanged;
    { Check if the given root path is unique, optionally ignoring a specific sub storage (eg. when
      modifying the root path of a storage, that storage's RootPath is irrelavant in determining
      if the new name will be unique). }
    function CheckUniqueBase(const APath: string; IgnoreIndex: Integer): Boolean;
    { Retrieves the sub storage for the given root path, optionally ignoring a specific sub storage.
      The specified path is assumed to be at root level (regardless whether the paths starts with
      a backslash (\) or not) and leading and trailing backslashes are removed automatically.
      The last element in the path string is ignored to avoid returning a sub storage for the root
      path itself. To search for a sub store for a root path, simply add '\*' at the end of the
      path. }
    function MatchFor(APath: string; IgnoreIndex: Integer = -1): TJvAppSubStorage;

    property RootStorage: TJvCustomAppStorage read GetRootStorage;
  public
    constructor Create(AOwner: TJvCustomAppStorage);
    procedure Add(RootPath: string; AppStorage: TJvCustomAppStorage);
    procedure Delete(Index: Integer); overload;
    procedure Delete(RootPath: string; const IncludeSubPaths: Boolean = False); overload;
    procedure Delete(AppStorage: TJvCustomAppStorage); overload;

    property Items[I: Integer]: TJvAppSubStorage read GetItem write SetItem; default;
  end;

  TJvAppSubStorage = class(TCollectionItem)
  private
    FRootPath: string;
    FAppStorage: TJvCustomAppStorage;
  protected
    function GetOwnerStore: TJvCustomAppStorage;
    function GetDisplayName: string; override;
    procedure SetRootPath(Value: string);
    procedure SetAppStorage(Value: TJvCustomAppStorage);

    property OwnerStore: TJvCustomAppStorage read GetOwnerStore;
  published
    property RootPath: string read FRootPath write SetRootPath;
    property AppStorage: TJvCustomAppStorage read FAppStorage write SetAppStorage;
  end;

  // Base class for all in memory file storage classes.
  // All descendents implement a file storage, but all changes
  // are left in memory until the Flush method is called.
  // Flush is automatically called by the destructor, but
  // you can override Flush to write the file on a support
  // different from a disk, such as database record.
  // Please note that in the derived class, if you use an object
  // to represent the file in memory, this object MUST be freed
  // AFTER the call to inherited in the destructor of your
  // derived class or Flush would access a deleted object
  TJvCustomAppMemoryFileStorage = class(TJvCustomAppStorage)
  protected
    FFileName: TFileName;
    FLocation: TFileLocation;
    FLoadedFinished: Boolean;
    FOnGetFileName: TJvAppStorageGetFileNameEvent;
    FPhysicalReadOnly: Boolean;

    function GetAsString: string; virtual; abstract;
    procedure SetAsString(const Value: string); virtual; abstract;

    procedure SetFileName(const Value: TFileName);
    procedure SetLocation(const Value: TFileLocation);
    function DefaultExtension: string; virtual;

    function DoGetFileName: TFileName; virtual;
    function GetFullFileName: TFileName;

    property AsString: string read GetAsString write SetAsString;
    property FileName: TFileName read FFileName write SetFileName;
    property Location: TFileLocation read FLocation write SetLocation default flExeFile;

    property OnGetFileName: TJvAppStorageGetFileNameEvent
      read FOnGetFileName write FOnGetFileName;
      // OnGetFileName triggered on Location = flCustom

    function GetPhysicalReadOnly: Boolean; override;

    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;

    procedure Reload; override;

    property FullFileName: TFileName read GetFullFileName;
  published
    property ReadOnly;
  end;

  { This Engine implements the possibility to implement special property handlers
    for TObject-based properties for storing/restoring them with the
    functions read/writeproperty.
    New engines could be registered using the method RegisterAppStoragePropertyEngine
  }
  TJvAppStoragePropertyBaseEngine = class(TObject)
  public
    function Supports(AObject: TObject; AProperty: TObject): Boolean; virtual;
    procedure ReadProperty(AStorage: TJvCustomAppStorage; const APath: string;
      AObject: TObject; AProperty: TObject; const Recursive, ClearFirst: Boolean); virtual;
    procedure WriteProperty(AStorage: TJvCustomAppStorage; const APath: string;
      AObject: TObject; AProperty: TObject; const Recursive: Boolean); virtual;
  end;

  TJvAppStoragePropertyBaseEngineClass = class of TJvAppStoragePropertyBaseEngine;

procedure RegisterAppStoragePropertyEngine(AEngineClass: TJvAppStoragePropertyBaseEngineClass);
procedure UnregisterAppStoragePropertyEngine(AEngineClass: TJvAppStoragePropertyBaseEngineClass);

// (marcelb) moved back; the constants are useful to the outside world after a call to GetStoredValues
// (rom) give it better names and delete these comments :-)
const
  aptFolder = 1;
  aptValue  = 2;



implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING} 
  JclFileUtils, JclStrings, JclSysInfo, JclRTTI, JclMime,
  JvQPropertyStore, JvQConsts, JvQResources;

type
  TJvAppStoragePropertyEngineList = class(TList)
  public
    destructor Destroy; override;
    procedure RegisterEngine(AEngineClass: TJvAppStoragePropertyBaseEngineClass);
    procedure UnregisterEngine(AEngineClass: TJvAppStoragePropertyBaseEngineClass);
    function GetEngine(AObject: TObject; AProperty: TObject): TJvAppStoragePropertyBaseEngine;
    function ReadProperty(AStorage: TJvCustomAppStorage; const APath: string;
      AObject: TObject; AProperty: TObject; const Recursive, ClearFirst: Boolean): Boolean;
    function WriteProperty(AStorage: TJvCustomAppStorage; const APath: string;
      AObject: TObject; AProperty: TObject; const Recursive: Boolean): Boolean;
  end;

var
  RegisteredAppStoragePropertyEngineList: TJvAppStoragePropertyEngineList;

const
  // (rom) this name is shared in several units and should be made global
  cCount = 'Count';
  cObject = 'Object';
  cItemName = 'Itemname';
  cClassName = 'Classname';
  cInvalidIdentifier = ' #!@not known@!# ';
  // (rom) should this be PathDelim + '*' as implemented before i changed it
  // (rom) or \* as comments say?
  cSubStorePath = '\*';



procedure UpdateGlobalPath(GlobalPaths, NewPaths: TStrings);
var
  I: Integer;
  J: Integer;
begin
  for I := 0 to NewPaths.Count - 1 do