{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecPropManager;

interface

uses Windows, Classes, Controls, TypInfo, Graphics;

const
  MAX_INI_VALUE_LENGTH = 200;

type
  TecRegKey = (rkCurrentUser, rkLocalMachine, rkCurrentConfig,
                rkClassesRoot, rkUsers, rkDynData);

  TEnumPropProc = procedure(Source: TObject; PInfo: PPropInfo; const PropPath: string) of object;

  TCustomPropsManager = class(TComponent)
  private
    FList: TList;
    FTemplateObj: TObject;
    FProperties: TStrings;
    FIniSection: string;
    FUseRegistry: Boolean;
    FIniFileName: string;
    FRootKey: TecRegKey;
    FIniFileObject: TObject;
    procedure SetProperties(const Value: TStrings);
    procedure SetTemplateObj(const Value: TObject);
    function GetCount: integer;
    function GetItems(Index: integer): TObject;
    procedure CreateIniObject;
    function GetSection: string;
    procedure FreeIniObject;
    procedure SaveProp(Source: TObject; PInfo: PPropInfo; const PropPath: string);
    procedure LoadProp(Source: TObject; PInfo: PPropInfo; const PropPath: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CopyProperty(Source, Dest: TObject; PropName: string);
    procedure EnumProps(const Source: TObject; Proc: TEnumPropProc);

    property TemplateObj: TObject read FTemplateObj write SetTemplateObj;
    property Properties: TStrings read FProperties write SetProperties;
    property Count: integer read GetCount;
    property Items[Index: integer]: TObject read GetItems; default;

    property IniSection: string read FIniSection write FIniSection;
    property IniFileName: string read FIniFileName write FIniFileName;
    property UseRegistry: Boolean read FUseRegistry write FUseRegistry;
    property RootKey: TecRegKey read FRootKey write FRootKey;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Add(Obj: TObject);
    procedure Remove(Obj: TObject);

    procedure CopyFrom(Obj: TObject);
    procedure CopyTo(Obj: TObject);
    procedure CopyProps(Source, Dest: TObject);
    procedure UpdateAll;

    procedure SaveProps(RegIniObj: TObject = nil);
    procedure LoadProps(RegIniObj: TObject = nil);
  end;

  TPropsManager = class(TCustomPropsManager)
  private
    function GetTemplate: TComponent;
    procedure SetTemplate(const Value: TComponent);
  published
    property Template: TComponent read GetTemplate write SetTemplate;
    property IniSection;
    property IniFileName;
    property UseRegistry default True;
    property RootKey default rkCurrentUser;
    property Properties;
  end;

implementation

uses SysUtils, IniFiles, Registry, Forms, ecStrUtils, ecRttiUtils, Math,
     Contnrs{$IFDEF EC_DOTNET}, Variants{$ENDIF};

{ TCustomPropsManager }

constructor TCustomPropsManager.Create(AOwner: TComponent);
begin
  inherited;
  FList := TList.Create;
  FProperties := TStringList.Create;
  FUseRegistry := True;
  FRootKey := rkCurrentUser;
end;

destructor TCustomPropsManager.Destroy;
begin
  FList.Free;
  FList := nil;
  FProperties.Free;
  inherited;
end;

procedure TCustomPropsManager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (FList <> nil) then
   begin
     FList.Remove(AComponent);
     if AComponent = FTemplateObj then
       FTemplateObj := nil;
   end;
end;

procedure TCustomPropsManager.Add(Obj: TObject);
begin
  if (Obj <> nil) and (FList.IndexOf(Obj) = -1) then
   begin
     FList.Add(Obj);
     if Obj is TComponent then
       (Obj as TComponent).FreeNotification(Self);
     CopyTo(Obj);
   end;
end;

procedure TCustomPropsManager.Remove(Obj: TObject);
begin
  FList.Remove(Obj);
end;

procedure TCustomPropsManager.UpdateAll;
var i: integer;
begin
  if FTemplateObj <> nil then
  for i := 0 to FList.Count - 1 do
   CopyTo(TObject(FList[i]));
end;

procedure TCustomPropsManager.SetProperties(const Value: TStrings);
begin
  FProperties.Assign(Value);
  UpdateAll;
end;

procedure TCustomPropsManager.SetTemplateObj(const Value: TObject);
begin
  if FTemplateObj <> Value then
   begin
    FTemplateObj := Value;
    if FTemplateObj <> nil then
     begin
      if FTemplateObj is TComponent then
        (FTemplateObj as TComponent).FreeNotification(Self);
      UpdateAll;
     end;
   end;
end;

procedure TCustomPropsManager.CopyFrom(Obj: TObject);
begin
  CopyProps(Obj, FTemplateObj);
end;

procedure TCustomPropsManager.CopyTo(Obj: TObject);
begin
  CopyProps(FTemplateObj, Obj);
end;

function TCustomPropsManager.GetCount: integer;
begin
  Result := FList.Count;
end;

function TCustomPropsManager.GetItems(Index: integer): TObject;
begin
  Result := TObject(FList[Index]);
end;

// =============================================================================
// Copies properties from Source to Dest
// =============================================================================
procedure TCustomPropsManager.CopyProps(Source, Dest: TObject);
var i: integer;
begin
  if (Source = nil) or (Dest = nil) then Exit;
  for i := 0 to FProperties.Count - 1 do
   try
     CopyProperty(Source, Dest, FProperties[i]);
   except
   end;
end;

procedure TCustomPropsManager.CopyProperty(Source, Dest: TObject;
  PropName: string);
var pi1, pi2: PPropInfo;
    S: string;
begin
  if (Source = nil) or (Dest = nil) or (Source = Dest) then Exit;
  S := PropName;
  Source := ExtractObject(Source, nil, S, True);
  Dest := ExtractObject(Dest, nil, PropName, True);
  if (Source = nil) or (Dest = nil) then Exit;
  // Copy property value
  pi1 := GetPropInfo(Source, PropName);
  pi2 := GetPropInfo(Dest, PropName);
  // Check for property present and require same types

  if (pi1 <> nil) and (pi2 <> nil) and
  {$IFNDEF EC_DOTNET}
     (GetTypeData(pi1^.PropType^) = GetTypeData(pi2^.PropType^)) then
  {$ELSE}
     (GetTypeData(pi1.PropType) = GetTypeData(pi2.PropType)) then
  {$ENDIF}
   case TypeKind(pi1) of
	  tkInteger, tkChar, tkWChar, tkClass, tkEnumeration, tkSet, tkDynArray:
		SetOrdProp(Dest, pi2, GetOrdProp(Source, pi1));
	  tkFloat:
		SetFloatProp(Dest, pi2, GetFloatProp(Source, pi1));
	  tkString, tkLString:
		SetStrProp(Dest, pi2, GetStrProp(Source, pi1));
	  tkWString:
        {$IFDEF EC_VCL6_UP}
		SetWideStrProp(Dest, pi2, GetWideStrProp(Source, pi1));
        {$ELSE}
                SetPropValue(Dest, PropName, GetPropValue(Source, PropName));
        {$ENDIF}
	  tkVariant:
		SetVariantProp(Dest, pi2, GetVariantProp(Source, pi1));
	  tkInt64:
		SetInt64Prop(Dest, pi2, GetInt64Prop(Source, pi1));
   end;
end;

procedure TCustomPropsManager.EnumProps(const Source: TObject;
  Proc: TEnumPropProc);

  procedure ProcessPInfo(Instance: TObject; pInfo: PPropInfo; const PropPath: string);
  var PList: PPropList;
      i, Count, Ref: integer;
      obj: TObject;
  begin
    if (pInfo = nil) or (TypeKind(pInfo) = tkClass) then
     begin
      if pInfo = nil then obj := Instance
       else obj := TObject(GetOrdProp(Instance, pInfo));
      if obj <> nil then
       if (obj is TStrings) and (pInfo <> nil) then Proc(Instance, pInfo, PropPath) else
       begin
         Count := ecGetPropList(PTypeInfo(obj.ClassInfo),
           [tkInteger..tkSet, tkClass, tkWChar, tkLString, tkWString, tkVariant],
           PList);
         if Count > 0 then
          try
           for i := 0 to Count - 1 do
             begin
               pInfo := PList{$IFNDEF EC_DOTNET}^{$ENDIF}[i];
               if IsStoredProp(obj, pInfo) then
                 begin
                   if TypeKind(pInfo) = tkClass then
                     begin
                       Ref := GetOrdProp(Obj, pInfo);
                       if (Ref = 0) or (TObject(Ref) is TComponent) then
                         Continue; // Do not process component references
                     end;
                   ProcessPInfo(obj, pInfo, PropPath + '.' + PropName(pInfo));
                 end;
             end;
          finally
           {$IFNDEF EC_DOTNET}
           FreeMem(PList);
           {$ENDIF}
          end;
       end;
     end else Proc(Instance, pInfo, PropPath);
  end;

var src: TObject;
    i: integer;
    S: string;
    pInfo: PPropInfo;
begin
  for i := 0 to FProperties.Count - 1 do
   try
     S := FProperties[i];
     src := ExtractObject(Source, Owner, S, True);
     if src <> nil then
       begin
         if S = '' then pInfo := nil else
           begin
             pInfo := GetPropInfo(src, S);
             if pInfo = nil then // Invalid entry
               Continue;
           end;
         ProcessPInfo(src, pInfo, FProperties[i]);
       end;
   except
   end;
end;

function TCustomPropsManager.GetSection: string;
begin
  if FIniSection <> '' then Result := FIniSection else
   if FTemplateObj <> nil then
    if (FTemplateObj is TComponent) and ((FTemplateObj as TComponent).Name <> '') then
      Result := (FTemplateObj as TComponent).Name else
      Result := FTemplateObj.ClassName;
end;

procedure TCustomPropsManager.CreateIniObject;
begin
  if FUseRegistry then
   begin
    FIniFileObject := TRegistry.Create;
    with TRegistry(FIniFileObject) do
     begin
      case Self.RootKey of
        rkLocalMachine: RootKey := HKEY_LOCAL_MACHINE;
        rkClassesRoot:  RootKey := HKEY_CLASSES_ROOT;
        rkCurrentConfig:RootKey := HKEY_CURRENT_CONFIG;
        rkUsers:        RootKey := HKEY_USERS;
        rkDynData:      RootKey := HKEY_DYN_DATA;
        rkCurrentUser:  RootKey := HKEY_CURRENT_USER;
      end;
      OpenKey(GetSection, True);
     end;
   end else
   begin
    if FIniFileName = '' then FIniFileObject := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'))
     else FIniFileObject := TIniFile.Create(FIniFileName);
   end;
end;

procedure TCustomPropsManager.FreeIniObject;
begin
 if FIniFileObject is TRegistry then
   (FIniFileObject as TRegistry).CloseKey;
 FIniFileObject.Free;
 FIniFileObject := nil;
end;

function CorrectPropPathToSection(const S: string): string;
var i: integer;
begin
  Result := S;
  for i := 1 to Length(Result) do
    if (Result[i] = '[') or (Result[i] = ']') then
      Result[i] := '_';
end;

procedure TCustomPropsManager.LoadProp(Source: TObject;
  PInfo: PPropInfo; const PropPath: string);
var S, Sec: string;
    obj: TStrings;
    i, N: integer;
begin
  if TypeKind(PInfo) = tkClass then
    begin
      obj := TStrings(GetObjectProp(Source, PInfo, TStrings));
      if obj <> nil then
       if FIniFileObject is TRegistry then obj.Text := TRegistry(FIniFileObject).ReadString(PropPath)
        else
         begin
           S := GetSection + '_' + CorrectPropPathToSection(PropPath);
           obj.Clear;
           N := TCustomIniFile(FIniFileObject).ReadInteger(S, 'COUNT', 0);
           for i := 0 to N - 1 do
             obj.Add(TCustomIniFile(FIniFileObject).ReadString(S, 'Item' + IntToStr(i), ''));
         end;
      Exit;
    end;
  if FIniFileObject is TRegistry then S := TRegistry(FIniFileObject).ReadString(PropPath) else
    with TCustomIniFile(FIniFileObject) do
      begin
        S := ReadString(GetSection, PropPath, '');
        if S = 'LARGE_DATA' then
          begin
            Sec := GetSection + '__' + CorrectPropPathToSection(PropPath);
            if SectionExists(Sec) then
              begin
                N := ReadInteger(Sec, 'COUNT', 0);
                S := '';
                for i := 0 to N - 1 do
                  S := S + ReadString(Sec, 'DATA' + IntToStr(i), '');
              end;
          end;
      end;
  if S <> '' then
   if TypeKind(PInfo) = tkChar then
     SetOrdProp(Source, PInfo, Ord(S[1]))
   else
     SetPropValue(Source, PropName(PInfo), S);
end;

procedure TCustomPropsManager.SaveProp(Source: TObject;
  PInfo: PPropInfo; const PropPath: string);
var S, Sec: string;
    obj: TStrings;
    i, N: integer;
begin
  case TypeKind(PInfo) of
    tkClass:
      begin
        obj := TStrings(GetObjectProp(Source, PInfo, TStrings));
        if obj <> nil then
         if FIniFileObject is TRegistry then TRegistry(FIniFileObject).WriteString(obj.Text, S)
          else
           begin
             S := GetSection + '_' + CorrectPropPathToSection(PropPath);
             TCustomIniFile(FIniFileObject).WriteString(S, 'COUNT', IntToStr(obj.Count));
             for i := 0 to obj.Count - 1 do
               TCustomIniFile(FIniFileObject).WriteString(S, 'Item' + IntToStr(i), obj[i]);
           end;
        Exit;
      end;
    tkChar: S := Char(GetOrdProp(Source, PInfo));
    else S := GetPropValue(Source, PropName(PInfo){$IFNDEF EC_DOTNET}, True{$ENDIF});
  end;
  if FIniFileObject is TRegistry then TRegistry(FIniFileObject).WriteString(PropPath, S)
    else
     with TCustomIniFile(FIniFileObject) do
      begin
        if Length(S) <= MAX_INI_VALUE_LENGTH then
          WriteString(GetSection, PropPath, S)
        else
          begin
            WriteString(GetSection, PropPath, 'LARGE_DATA');
            Sec := GetSection + '__' + CorrectPropPathToSection(PropPath);
            N := Ceil(Length(S) / MAX_INI_VALUE_LENGTH);
            WriteInteger(Sec, 'COUNT', N);
            for i := 0 to N - 1 do
              WriteString(Sec, 'DATA' + IntToStr(i), Copy(S, 1 + i * MAX_INI_VALUE_LENGTH, MAX_INI_VALUE_LENGTH));
          end;
      end;
end;

procedure TCustomPropsManager.LoadProps(RegIniObj: TObject);
begin
  if FTemplateObj <> nil then
   begin
    if RegIniObj = nil then
      CreateIniObject
    else
      FIniFileObject := RegIniObj;
    try
      EnumProps(FTemplateObj, LoadProp);
    finally
      if RegIniObj = nil then
        FreeIniObject;
    end;
   end;
end;

procedure TCustomPropsManager.SaveProps(RegIniObj: TObject);
begin
  if FTemplateObj <> nil then
   begin
    if RegIniObj = nil then
      CreateIniObject
    else
      FIniFileObject := RegIniObj;
    try
      EnumProps(FTemplateObj, SaveProp);
    finally
      if RegIniObj = nil then
        FreeIniObject;
    end;
   end;
end;

{ TPropsManager }

function TPropsManager.GetTemplate: TComponent;
begin
  Result := TComponent(TemplateObj);
end;

procedure TPropsManager.SetTemplate(const Value: TComponent);
begin
  TemplateObj := Value;
end;

end.

