Changeset 390 for Registry


Ignore:
Timestamp:
Jul 18, 2012, 4:13:05 PM (12 years ago)
Author:
chronos
Message:
Location:
Registry
Files:
1 added
5 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • Registry/GeneralRegistry.lpk

    r388 r390  
    33  <Package Version="4">
    44    <Name Value="GeneralRegistry"/>
     5    <Author Value="Chronos (robie@centrum.cz)"/>
    56    <CompilerOptions>
    67      <Version Value="11"/>
     
    1516      </Other>
    1617    </CompilerOptions>
    17     <Files Count="8">
     18    <Description Value="Generalized registry classes for multiplatform programming."/>
     19    <License Value="LGPL"/>
     20    <Version Minor="1"/>
     21    <Files Count="3">
    1822      <Item1>
    19         <Filename Value="Registry2.pas"/>
     23        <Filename Value="WinRegistry.pas"/>
    2024        <Type Value="Text"/>
    21         <UnitName Value="Registry2"/>
     25        <UnitName Value="WinRegistry"/>
    2226      </Item1>
    23       <Item2>
    24         <Filename Value="xmlreg.pp"/>
    25         <UnitName Value="xmlreg"/>
    26       </Item2>
    2727      <Item3>
    28         <Filename Value="regdef.inc"/>
    29         <Type Value="Include"/>
     28        <Filename Value="UGeneralRegistry.pas"/>
     29        <HasRegisterProc Value="True"/>
     30        <UnitName Value="UGeneralRegistry"/>
    3031      </Item3>
    31       <Item4>
    32         <Filename Value="regini.inc"/>
    33         <Type Value="Include"/>
    34       </Item4>
    35       <Item5>
    36         <Filename Value="winreg.inc"/>
    37         <Type Value="Include"/>
    38       </Item5>
    39       <Item6>
    40         <Filename Value="xregreg.inc"/>
    41         <Type Value="Include"/>
    42       </Item6>
    43       <Item8>
    44         <Filename Value="UGeneralRegistry.pas"/>
    45         <UnitName Value="UGeneralRegistry"/>
    46       </Item8>
    4732    </Files>
    4833    <Type Value="RunAndDesignTime"/>
  • Registry/GeneralRegistry.pas

    r388 r390  
    88
    99uses
    10   xmlreg, UGeneralRegistry, LazarusPackageIntf;
     10  UGeneralRegistry, LazarusPackageIntf;
    1111
    1212implementation
     
    1414procedure Register;
    1515begin
     16  RegisterUnit('UGeneralRegistry', @UGeneralRegistry.Register);
    1617end;
    1718
  • Registry/UGeneralRegistry.pas

    r388 r390  
    66
    77uses
    8   Classes, SysUtils, IniFiles;
     8  Classes, SysUtils, IniFiles, WinRegistry;
    99
    1010type
     11  TRegistryRoot = (rrUnknown, rrApplicationUser, rrApplicationGlobal,
     12    rrSystemUser, rrSystemGlobal);
     13
    1114  TRegKeyInfo = record
    1215    NumberSubKeys: Integer;
     
    3033  TBaseRegistry = class
    3134  private
    32     procedure SetCurrentKey(const AValue: string);
    33     procedure SetCurrentRoot(const AValue: string);
    3435  protected
    35     FCurrentRoot: string;
     36    FCurrentRoot: NativeInt;
    3637    FCurrentKey: string;
     38    procedure SetCurrentKey(const AValue: string); virtual; abstract;
     39    procedure SetCurrentRoot(const AValue: NativeInt); virtual; abstract;
    3740  public
    3841    function KeyExists(const Name: string): Boolean; virtual; abstract;
    3942    function ValueExists(const Name: string): Boolean; virtual; abstract;
    40     procedure OpenKey(const Key: string; CreateNew: Boolean); virtual; abstract;
     43    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; virtual; abstract;
    4144    procedure CloseKey; virtual; abstract;
    4245    function DeleteKey(const Name: string; Recursive: Boolean = False): Boolean; virtual; abstract;
     
    5558    procedure WriteString(const Name: string; Value: string); virtual; abstract;
    5659    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); virtual; abstract;
    57     property CurrentRoot: string read FCurrentRoot write SetCurrentRoot;
     60    function HasSubKeys: Boolean; virtual; abstract;
     61    procedure GetKeyNames(Strings: TStrings); virtual; abstract;
     62    procedure GetValueNames(Strings: TStrings); virtual; abstract;
     63    property CurrentRoot: NativeInt read FCurrentRoot write SetCurrentRoot;
    5864    property CurrentKey: string read FCurrentKey write SetCurrentKey;
    5965  end;
     
    6874    procedure CheckBackend; inline;
    6975    function GetCurrentKey: string;
    70     function GetCurrentRoot: string;
     76    function GetCurrentRoot: NativeInt;
    7177    procedure SetBackend(const AValue: TBaseRegistry);
    7278    procedure SetCurrentKey(const AValue: string);
    73     procedure SetCurrentRoot(const AValue: string);
     79    procedure SetCurrentRoot(const AValue: NativeInt);
    7480  public
    7581    constructor Create(AOwner: TComponent); override;
     
    8187    function DeleteValue(const Name: string): Boolean;
    8288    function RenameValue(const OldName, NewName: string): Boolean;
    83     procedure OpenKey(const Key: string; CreateNew: Boolean);
     89    function OpenKey(const Key: string; CreateNew: Boolean): Boolean;
    8490    function ReadBool(const Name: string): Boolean;
    8591    function ReadDateTime(const Name: string): TDateTime;
     
    94100    procedure WriteString(const Name: string; Value: string);
    95101    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
     102    function HasSubKeys: Boolean;
     103    procedure GetKeyNames(Strings: TStrings);
     104    procedure GetValueNames(Strings: TStrings);
    96105    property Backend: TBaseRegistry read FBackend write SetBackend;
    97     property CurrentRoot: string read GetCurrentRoot write SetCurrentRoot;
     106    property CurrentRoot: NativeInt read GetCurrentRoot write SetCurrentRoot;
    98107    property CurrentKey: string read GetCurrentKey write SetCurrentKey;
    99108  end;
     
    102111
    103112  TXMLRegistry = class(TBaseRegistry)
    104     procedure OpenKey(const Key: string; CreateNew: Boolean); override;
     113    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; override;
    105114  end;
    106115
     
    116125  end;
    117126
     127  { TWinRegistry }
     128
    118129  TWinRegistry = class(TBaseRegistry)
    119 
     130  protected
     131    procedure SetCurrentKey(const AValue: string); override;
     132    procedure SetCurrentRoot(const AValue: NativeInt); override;
     133  public
     134    BasePath: string;
     135    Registry: TRegistry;
     136    function KeyExists(const Name: string): Boolean; override;
     137    function ValueExists(const Name: string): Boolean; override;
     138    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; override;
     139    procedure CloseKey; override;
     140    function DeleteKey(const Name: string; Recursive: Boolean = False): Boolean; override;
     141    function DeleteValue(const Name: string): Boolean; override;
     142    function RenameValue(const OldName, NewName: string): Boolean; override;
     143    function ReadBool(const Name: string): Boolean; override;
     144    function ReadDateTime(const Name: string): TDateTime; override;
     145    function ReadFloat(const Name: string): Double; override;
     146    function ReadInteger(const Name: string): Integer; override;
     147    function ReadString(const Name: string): string; override;
     148    function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer; override;
     149    procedure WriteBool(const Name: string; Value: Boolean); override;
     150    procedure WriteDateTime(const Name: string; Value: TDateTime); override;
     151    procedure WriteFloat(const Name: string; Value: Double); override;
     152    procedure WriteInteger(const Name: string; Value: Integer); override;
     153    procedure WriteString(const Name: string; Value: string); override;
     154    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); override;
     155    function HasSubKeys: Boolean; override;
     156    procedure GetKeyNames(Strings: TStrings); override;
     157    procedure GetValueNames(Strings: TStrings); override;
     158    constructor Create;
     159    destructor Destroy; override;
    120160  end;
    121161
     
    133173end;
    134174
    135 procedure TBaseRegistry.SetCurrentKey(const AValue: string);
    136 begin
    137   if FCurrentKey=AValue then Exit;
    138   FCurrentKey:=AValue;
    139 end;
    140 
    141 procedure TBaseRegistry.SetCurrentRoot(const AValue: string);
    142 begin
    143   if FCurrentRoot=AValue then Exit;
    144   FCurrentRoot:=AValue;
    145 end;
     175{ TBaseRegistry }
     176
     177{ TWinRegistry }
     178
     179procedure TWinRegistry.SetCurrentKey(const AValue: string);
     180begin
     181  if FCurrentKey = AValue then Exit;
     182  OpenKey(AValue, False);
     183end;
     184
     185procedure TWinRegistry.SetCurrentRoot(const AValue: NativeInt);
     186begin
     187  if FCurrentRoot = AValue then Exit;
     188  FCurrentRoot := AValue;
     189  if AValue = Integer(rrApplicationUser) then begin
     190    Registry.RootKey := HKEY_CURRENT_USER;
     191    BasePath := '\Software\Company\Product';
     192  end;
     193  if AValue = Integer(rrApplicationGlobal) then begin
     194    Registry.RootKey := HKEY_LOCAL_MACHINE;
     195    BasePath := '\Software\Company\Product';
     196  end;
     197end;
     198
     199function TWinRegistry.KeyExists(const Name: string): Boolean;
     200begin
     201  Result := Registry.KeyExists(Name);
     202end;
     203
     204function TWinRegistry.ValueExists(const Name: string): Boolean;
     205begin
     206  Result := Registry.ValueExists(Name);
     207end;
     208
     209function TWinRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
     210begin
     211  Result := Registry.OpenKey(Key, CreateNew);
     212  FCurrentKey := Key;
     213end;
     214
     215procedure TWinRegistry.CloseKey;
     216begin
     217  Registry.CloseKey;
     218end;
     219
     220function TWinRegistry.DeleteKey(const Name: string; Recursive: Boolean
     221  ): Boolean;
     222var
     223  SubKeys: TStringList;
     224  I: Integer;
     225begin
     226  try
     227    SubKeys := TStringList.Create;
     228    if Recursive and OpenKey(Name, False) and HasSubKeys then begin
     229      GetKeyNames(SubKeys);
     230      for I := 0 to SubKeys.Count - 1 do
     231        DeleteKey(Name + '\' + SubKeys[I], True);
     232    end;
     233    Result := Registry.DeleteKey(Name);
     234  finally
     235    SubKeys.Free;
     236  end;
     237end;
     238
     239function TWinRegistry.DeleteValue(const Name: string): Boolean;
     240begin
     241  Result := Registry.DeleteValue(Name);
     242end;
     243
     244function TWinRegistry.RenameValue(const OldName, NewName: string): Boolean;
     245begin
     246  Result := True;
     247  Registry.RenameValue(OldName, NewName);
     248end;
     249
     250function TWinRegistry.ReadBool(const Name: string): Boolean;
     251begin
     252  Result := Registry.ReadBool(Name);
     253end;
     254
     255function TWinRegistry.ReadDateTime(const Name: string): TDateTime;
     256begin
     257  Result := Registry.ReadDateTime(Name);
     258end;
     259
     260function TWinRegistry.ReadFloat(const Name: string): Double;
     261begin
     262  Result := Registry.ReadFloat(Name);
     263end;
     264
     265function TWinRegistry.ReadInteger(const Name: string): Integer;
     266begin
     267  Result := Registry.ReadInteger(Name);
     268end;
     269
     270function TWinRegistry.ReadString(const Name: string): string;
     271begin
     272  Result := Registry.ReadString(Name);
     273end;
     274
     275function TWinRegistry.ReadBinaryData(const Name: string; var Buffer;
     276  BufSize: Integer): Integer;
     277begin
     278  Result := Registry.ReadBinaryData(Name, Buffer, BufSize);
     279end;
     280
     281procedure TWinRegistry.WriteBool(const Name: string; Value: Boolean);
     282begin
     283  Registry.WriteBool(Name, Value);
     284end;
     285
     286procedure TWinRegistry.WriteDateTime(const Name: string; Value: TDateTime);
     287begin
     288  Registry.WriteDateTime(Name, Value);
     289end;
     290
     291procedure TWinRegistry.WriteFloat(const Name: string; Value: Double);
     292begin
     293  Registry.WriteFloat(Name, Value);
     294end;
     295
     296procedure TWinRegistry.WriteInteger(const Name: string; Value: Integer);
     297begin
     298  Registry.WriteInteger(Name, Value);
     299end;
     300
     301procedure TWinRegistry.WriteString(const Name: string; Value: string);
     302begin
     303  Registry.WriteString(Name, Value);
     304end;
     305
     306procedure TWinRegistry.WriteBinaryData(const Name: string; var Buffer;
     307  BufSize: Integer);
     308begin
     309  Registry.WriteBinaryData(Name, Buffer, BufSize);
     310end;
     311
     312function TWinRegistry.HasSubKeys: Boolean;
     313begin
     314  Result := Registry.HasSubKeys;
     315end;
     316
     317procedure TWinRegistry.GetKeyNames(Strings: TStrings);
     318begin
     319  Registry.GetKeyNames(Strings);
     320end;
     321
     322procedure TWinRegistry.GetValueNames(Strings: TStrings);
     323begin
     324  Registry.GetValueNames(Strings);
     325end;
     326
     327constructor TWinRegistry.Create;
     328begin
     329  Registry := TRegistry.Create;
     330end;
     331
     332destructor TWinRegistry.Destroy;
     333begin
     334  Registry.Free;
     335  inherited Destroy;
     336end;
     337
    146338
    147339{ TBaseRegistry }
     
    162354{ TXMLRegistry }
    163355
    164 procedure TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean);
     356function TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
    165357begin
    166358
     
    181373end;
    182374
    183 function TGeneralRegistry.GetCurrentRoot: string;
     375function TGeneralRegistry.GetCurrentRoot: NativeInt;
    184376begin
    185377  CheckBackend;
     
    200392end;
    201393
    202 procedure TGeneralRegistry.SetCurrentRoot(const AValue: string);
    203 begin
    204   CheckBackend;
    205   Backend.CurrentKey := AValue;
     394procedure TGeneralRegistry.SetCurrentRoot(const AValue: NativeInt);
     395begin
     396  CheckBackend;
     397  Backend.CurrentRoot := AValue;
    206398end;
    207399
     
    242434end;
    243435
    244 procedure TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean);
    245 begin
    246   CheckBackend;
    247   Backend.OpenKey(Key, CreateNew);
     436function TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
     437begin
     438  CheckBackend;
     439  Result := Backend.OpenKey(Key, CreateNew);
    248440end;
    249441
     
    269461begin
    270462  CheckBackend;
    271   Result := ReadInteger(Name);
     463  Result := Backend.ReadInteger(Name);
    272464end;
    273465
     
    320512  CheckBackend;
    321513  Backend.WriteBinaryData(Name, Buffer, BufSize);
     514end;
     515
     516function TGeneralRegistry.HasSubKeys: Boolean;
     517begin
     518  CheckBackend;
     519  Result := Backend.HasSubKeys;
     520end;
     521
     522procedure TGeneralRegistry.GetKeyNames(Strings: TStrings);
     523begin
     524  CheckBackend;
     525  Backend.GetKeyNames(Strings);
     526end;
     527
     528procedure TGeneralRegistry.GetValueNames(Strings: TStrings);
     529begin
     530  CheckBackend;
     531  Backend.GetValueNames(Strings);
    322532end;
    323533
Note: See TracChangeset for help on using the changeset viewer.