propstorageeh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{               EhLib v4.2 (Build 4.2.02)               }
{                                                       }
{   TPropStorageManagerEh, TIniPropStorageManEh,        }
{   TRegPropStorageManEh,  TPropStorageEh components    }
{                                                       }
{   Copyright (c) 2002-2006 by Dmitry V. Bolshakov      }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}
//{$I EhLibClx.Inc}

{$IFDEF EH_LIB_VCL}
unit PropStorageEh {$IFDEF CIL} platform {$ENDIF};
{$ELSE}
unit QPropStorageEh;
{$ENDIF}

interface

uses
{$IFDEF EH_LIB_VCL}
  Windows, Forms, Controls, Registry, PropFilerEh, Dialogs, SysUtils,
{$IFDEF CIL}
  EhLibVCLNET,
{$ELSE}
  EhLibVCL,
{$ENDIF}

{$ELSE}
  QForms, QControls, QPropFilerEh,
{$ENDIF}
  Classes, IniFiles, TypInfo;

type

  TPropStorageEh = class;
  TPropertyNamesEh = class;

{ TPropStorageManagerEh }

  TPropStorageManagerEh = class(TComponent)
  private
    FWriteAsText: Boolean;
  protected
    property WriteAsText: Boolean read FWriteAsText write FWriteAsText default True;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ReadProperties(PropStorage: TPropStorageEh); virtual;
    procedure ReadPropertiesStream(Stream: TStream; PropStorage: TPropStorageEh); virtual;
    procedure WriteProperties(PropStorage: TPropStorageEh); virtual;
    procedure WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream); virtual;
    procedure WritePropertiesText(PropStorage: TPropStorageEh; Text: String); virtual;
  end;

{ TIniPropStorageManEh }

  TIniPropStorageManEh = class(TPropStorageManagerEh)
  private
    FIniFileName: String;
  public
    procedure ReadProperties(PropStorage: TPropStorageEh); override;
    procedure WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream); override;
    procedure WritePropertiesText(PropStorage: TPropStorageEh; Text: String); override;
  published
    property IniFileName: String read FIniFileName write FIniFileName;
    property WriteAsText;
  end;

{$IFDEF EH_LIB_VCL}

{ TRegPropStorageManEh }

  TRegistryKeyEh = (rkClassesRootEh, rkCurrentUserEh,
      rkLocalMachineEh, rkUsersEh, rkPerformanceDataEh,
      rkCurrentConfigEh, rkDynDataEh, rkCustomRegistryKeyEh);

  TRegPropStorageManEh = class(TPropStorageManagerEh)
  private
    FKey: HKEY;
    FPath: String;
    FRegistryKey: TRegistryKeyEh;
    procedure SerRegistryKey(const Value: TRegistryKeyEh);
    procedure SetKey(const Value: HKEY);
    procedure ReadPropertiesOld(PropStorage: TPropStorageEh);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReadProperties(PropStorage: TPropStorageEh); override;
    procedure WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream); override;
    procedure WritePropertiesText(PropStorage: TPropStorageEh; Text: String); override;
    property Key: HKEY read FKey write SetKey default HKEY_CURRENT_USER;
  published
    property RegistryKey: TRegistryKeyEh read FRegistryKey write SerRegistryKey default rkCurrentUserEh;
    property Path: String read FPath write FPath;
    property WriteAsText;
  end;

{$ENDIF}

{ TPropStorageEh }

  TWriteCustomPropsEventEh = procedure(Sender: TObject; Writer: TPropWriterEh) of object;
  TReadPropEventEh = procedure(Sender: TObject; Reader: TPropReaderEh;
    PropName: String; var Processed: Boolean) of object;

  TPropStorageEh = class(TComponent)
  private
    FActive: Boolean;
    FAfterLoadProps: TNotifyEvent;
    FAfterSaveProps: TNotifyEvent;
    FBeforeLoadProps: TNotifyEvent;
    FBeforeSaveProps: TNotifyEvent;
    FDestroying: Boolean;
    FOnReadProp: TReadPropEventEh;
    FOnWriteCustomProps: TWriteCustomPropsEventEh;
    FOnSavePlacement: TNotifyEvent;
    FSaved: Boolean;
    FSaveFormCloseQuery: TCloseQueryEvent;
    FSaveFormDestroy: TNotifyEvent;
    FSaveFormShow: TNotifyEvent;
    FSection: String;
    FStorageManager: TPropStorageManagerEh;
    FStoredProps: TPropertyNamesEh;
    function GetForm: TForm;
    function GetSection: String;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RestoreEvents;
    procedure SetEvents;
    procedure SetSection(const Value: String);
    procedure SetStorageManager(const Value: TPropStorageManagerEh);
    procedure SetStoredProps(const Value: TPropertyNamesEh);
  protected
    procedure Loaded; override;
    procedure Save; dynamic;
    property Form: TForm read GetForm;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ReadProp(Reader: TPropReaderEh; PropName: String; var Processed: Boolean);
    procedure WriteCustomProps(Writer: TPropWriterEh);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadProperties;
    procedure ReadPropValues(Stream: TStream);
    procedure SaveProperties;
    procedure WritePropValues(Stream: TStream);
  published
    property Active: Boolean read FActive write FActive default True;
    property Section: String read GetSection write SetSection;
    property StorageManager: TPropStorageManagerEh read FStorageManager write SetStorageManager;
    property StoredProps: TPropertyNamesEh read FStoredProps write SetStoredProps;
    property AfterLoadProps: TNotifyEvent read FAfterLoadProps write FAfterLoadProps;
    property AfterSaveProps: TNotifyEvent read FAfterSaveProps write FAfterSaveProps;
    property BeforeLoadProps: TNotifyEvent read FBeforeLoadProps write FBeforeLoadProps;
    property BeforeSaveProps: TNotifyEvent read FBeforeSaveProps write FBeforeSaveProps;
    property OnWriteCustomProps: TWriteCustomPropsEventEh read FOnWriteCustomProps write FOnWriteCustomProps;
    property OnReadProp: TReadPropEventEh read FOnReadProp write FOnReadProp;
  end;

{ TPropertyNamesEh }

  TPropertyNamesEh = class(TStringList)
  private
    FRoot: TComponent;
    procedure SetRoot(const Value: TComponent);
  protected
    function CompareStrings(const S1, S2: string): Integer; {$IFDEF EH_LIB_6} override; {$ENDIF}
    function CheckPropertyPath(Path: String): Boolean;
    function CheckObjectPropertyPath(Instance: TObject; PropPath: String): Boolean;
    procedure CheckPropertyNames;
  public
    function Add(const S: string): Integer; override;
    property Root: TComponent read FRoot write SetRoot;
  end;

  procedure GetDefinePropertyList(AObject: TPersistent; sl: TStrings);

  function DefaultPropStorageManager: TPropStorageManagerEh;
  function SetDefaultPropStorageManager(NewStorageManager: TPropStorageManagerEh): TPropStorageManagerEh;

{$IFDEF EH_LIB_VCL}

function RegistryKeyToIdent(RootKey: Longint; var Ident: string): Boolean;
function IdentToRegistryKey(const Ident: string; var RootKey: Longint): Boolean;
procedure GetRegistryKeyValues(Proc: TGetStrProc);

{$ENDIF}

implementation

function GetDefaultSection(Component: TComponent): String;
var
  F: TCustomForm;
  Owner: TComponent;
begin
  if Component <> nil then
  begin
    if Component is TCustomForm then
      Result := Component.ClassName
    else
    begin
      Result := Component.Name;
      if Component is TControl then
      begin
        F := GetParentForm(TControl(Component));
        if F <> nil then
          Result := F.ClassName + Result
        else
        begin
          if TControl(Component).Parent <> nil then
            Result := TControl(Component).Parent.Name + Result;
        end;
      end else
      begin
        Owner := Component.Owner;
        if Owner is TForm then
          Result := Format('%s.%s', [Owner.ClassName, Result]);
      end;
    end;
  end
  else Result := '';
end;

function GetDefaultIniName: string;
begin
  Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.INI'));
end;

function GetDefaultRegKey: string;
begin
  if Application.Title <> '' then
    Result := Application.Title
  else Result := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
  Result := 'Software\' + Result;
end;

{$IFNDEF EH_LIB_5}

type
  TStreamOriginalFormat = (sofUnknown, sofBinary, sofText);

const
  FilerSignature: array[1..4] of Char = 'TPF0';

function TestStreamFormat(Stream: TStream): TStreamOriginalFormat;
var
  Pos: Integer;
  Signature: Integer;
begin
  Pos := Stream.Position;
  Signature := 0;
  Stream.Read(Signature, sizeof(Signature));
  Stream.Position := Pos;
  if (Byte(Signature) = $FF) or (Signature = Integer(FilerSignature)) then
    Result := sofBinary
    // text format may begin with "object", "inherited", or whitespace
  else if Char(Signature) in ['o','O','i','I',' ',#13,#11,#9] then
    Result := sofText
  else
    Result := sofUnknown;
end;

{$ENDIF}

type
  TDefinePropertyFiler = class(TFiler)
  private
    fsl: TStrings;
  public
    procedure FlushBuffer; override;
    procedure DefineProperty(const Name: String; ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean); override;
    procedure DefineBinaryProperty(const Name: String; ReadData, WriteData: TStreamProc; HasData: Boolean); override;
    procedure GetDefinedObjectPropertyNames(AObject: TPersistent; sl: TStrings);
  end;

procedure GetDefinePropertyList(AObject: TPersistent; sl: TStrings);
var
  dpf: TDefinePropertyFiler;
begin
  dpf := TDefinePropertyFiler.Create(nil,0);
  dpf.GetDefinedObjectPropertyNames(AObject, sl);
  dpf.Free;
end;

{ TDefinePropertyFiler }

procedure TDefinePropertyFiler.DefineBinaryProperty(const Name: String;
  ReadData, WriteData: TStreamProc; HasData: Boolean);
begin
  fsl.Add(Name);
end;

procedure TDefinePropertyFiler.DefineProperty(const Name: String;
  ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
begin
  fsl.Add(Name);
end;

procedure TDefinePropertyFiler.FlushBuffer;
begin

end;

procedure TDefinePropertyFiler.GetDefinedObjectPropertyNames(
  AObject: TPersistent; sl: TStrings);
var
  FilerAccess: TFilerAccess;
begin
  fsl := sl;
  FilerAccess := TFilerAccess.Create(AObject);
  FilerAccess.DefineProperties(Self);
  FilerAccess.Free;
end;

var
  FDefaultStorageManager: TPropStorageManagerEh;

function DefaultPropStorageManager: TPropStorageManagerEh;
begin
  Result := FDefaultStorageManager;
end;

function SetDefaultPropStorageManager(NewStorageManager: TPropStorageManagerEh): TPropStorageManagerEh;
begin
  Result := FDefaultStorageManager;
  FDefaultStorageManager := NewStorageManager;
end;

{ TPropStorageManagerEh }

constructor TPropStorageManagerEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWriteAsText := True;
end;

procedure TPropStorageManagerEh.WriteProperties(PropStorage: TPropStorageEh);
var
  ss: TStringStream;
  st: TMemoryStream;
begin
  st := nil;
  ss := nil;
  try
    st := TMemoryStream.Create;
    PropStorage.WritePropValues(st);
    st.Position := 0;
    if WriteAsText then
    begin
      ss := TStringStream.Create('');
      ObjectBinaryToText(st, ss);
      WritePropertiesText(PropStorage, ss.DataString);
    end else
      WritePropertiesStream(PropStorage, st);
  finally
    st.Free;
    ss.Free;
  end;
end;

procedure TPropStorageManagerEh.WritePropertiesText(PropStorage: TPropStorageEh; Text: String);
begin
end;

procedure TPropStorageManagerEh.WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream);
begin
end;

procedure TPropStorageManagerEh.ReadProperties(PropStorage: TPropStorageEh);
begin
end;

procedure TPropStorageManagerEh.ReadPropertiesStream(Stream: TStream; PropStorage: TPropStorageEh);
var
  ms: TMemoryStream;
begin
  ms := nil;
  if TestStreamFormat(Stream) = sofUnknown then
    raise Exception.Create('Invalid stream format.');
  try
    if TestStreamFormat(Stream) = sofText then
    begin
      ms := TMemoryStream.Create;
      ObjectTextToBinary(Stream, ms);
      ms.Position := 0;
      Stream := ms;
    end;
    PropStorage.ReadPropValues(Stream);
  finally
    ms.Free;
  end;  
end;

{ TIniPropStorageManEh }

procedure TIniPropStorageManEh.ReadProperties(PropStorage: TPropStorageEh);
var
  ss: TMemoryStream;
  sl: TStrings;
  ini: TCustomIniFile;
  i: Integer;
  Buffer: TBytes;
begin
  ss := nil;
  sl := nil;
  ini := nil;
  try
    ini := TIniFile.Create(IniFileName);  //TMemIniFile does't found file (if it not in current dir)
    sl := TStringList.Create;

    if not ini.SectionExists(PropStorage.Section) then
      Exit;
    ini.ReadSectionValues(PropStorage.Section, sl);
    for i := 0 to sl.Count - 1 do
      sl.Strings[i] := sl.Values['Line' + IntToStr(i)];

    ss := TMemoryStream.Create();
    StreamWriteBytes(ss, BytesOf(sl[0]));
    ss.Position := 0;
//    ss.Write(BytesOf(sl[0]));

    if TestStreamFormat(ss) <> sofText then
    begin
      ss.Seek(0, soFromEnd);
      for i := 1 to sl.Count - 1 do
//        ss.WriteString(sl[i]);