Changeset 390


Ignore:
Timestamp:
Jul 18, 2012, 4:13:05 PM (12 years ago)
Author:
chronos
Message:
Files:
2 added
6 deleted
7 edited

Legend:

Unmodified
Added
Removed

  • Common/Common.lpk

    r387 r390  
    9191    <RequiredPkgs Count="3">
    9292      <Item1>
    93         <PackageName Value="RegistryPkg"/>
     93        <PackageName Value="GeneralRegistry"/>
     94        <MinVersion Minor="1" Valid="True"/>
    9495      </Item1>
    9596      <Item2>

  • Common/StopWatch.pas

    r358 r390  
    2222    function GetElapsed: string;
    2323  public
    24     constructor Create(const startOnCreate : Boolean = False) ;
     24    constructor Create(const startOnCreate: Boolean = False) ;
    2525    procedure Start;
    2626    procedure Stop;
    27     property IsHighResolution : Boolean read fIsHighResolution;
    28     property ElapsedTicks : TLargeInteger read GetElapsedTicks;
    29     property ElapsedMiliseconds : TLargeInteger read GetElapsedMiliseconds;
    30     property Elapsed : string read GetElapsed;
    31     property IsRunning : Boolean read fIsRunning;
     27    property IsHighResolution: Boolean read fIsHighResolution;
     28    property ElapsedTicks: TLargeInteger read GetElapsedTicks;
     29    property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds;
     30    property Elapsed: string read GetElapsed;
     31    property IsRunning: Boolean read fIsRunning;
    3232  end;
    3333

  • Common/UApplicationInfo.pas

    r387 r390  
    66
    77uses
    8   SysUtils, Registry2, Classes, Forms, URegistry;
     8  SysUtils, Classes, Forms, UGeneralRegistry;
    99
    1010type
    … …  
    7474  FAppName := Application.Name;
    7575  FRegistryKey := '\Software\' + FAppName;
    76   FRegistryRoot := rrKeyCurrentUser;
     76  FRegistryRoot := rrApplicationUser;
    7777end;
    7878

  • Common/ULastOpenedList.pas

    r387 r390  
    66
    77uses
    8   Classes, SysUtils, Registry2, URegistry, Menus;
     8  Classes, SysUtils, UGeneralRegistry, Menus;
    99
    1010type
    … …  
    2323    destructor Destroy; override;
    2424    procedure LoadToMenuItem(MenuItem: TMenuItem; ClickAction: TNotifyEvent);
    25     procedure LoadFromRegistry(Root: HKEY; Key: string);
    26     procedure SaveToRegistry(Root: HKEY; Key: string);
     25    procedure LoadFromRegistry(Root: Integer; const Key: string);
     26    procedure SaveToRegistry(Root: Integer; const Key: string);
    2727    procedure AddItem(FileName: string);
    2828  published
    … …  
    8787end;
    8888
    89 procedure TLastOpenedList.LoadFromRegistry(Root: HKEY; Key: string);
     89procedure TLastOpenedList.LoadFromRegistry(Root: Integer; const Key: string);
    9090var
    9191  I: Integer;
    92   Registry: TRegistryEx;
     92  Registry: TGeneralRegistry;
    9393  FileName: string;
    9494begin
    95   Registry := TRegistryEx.Create;
     95  Registry := TGeneralRegistry.Create(nil);
    9696  with Registry do
    9797  try
    98     RootKey := Root;
     98    CurrentRoot := Root;
    9999    OpenKey(Key, True);
    100100    Items.Clear;
    101101    I := 0;
    102102    while ValueExists('File' + IntToStr(I)) and (I < MaxCount) do begin
    103       FileName := UTF8Encode(ReadStringWithDefault('File' + IntToStr(I), ''));
     103      if ValueExists('File' + IntToStr(I)) then
     104        FileName := UTF8Encode(ReadString('File' + IntToStr(I)))
     105        else FileName := '';
    104106      if Trim(FileName) <> '' then Items.Add(FileName);
    105107      Inc(I);
    … …  
    112114end;
    113115
    114 procedure TLastOpenedList.SaveToRegistry(Root: HKEY; Key: string);
     116procedure TLastOpenedList.SaveToRegistry(Root: Integer; const Key: string);
    115117var
    116118  I: Integer;
    117   Registry: TRegistryEx;
     119  Registry: TGeneralRegistry;
    118120begin
    119   Registry := TRegistryEx.Create;
     121  Registry := TGeneralRegistry.Create(nil);
    120122  with Registry do
    121123  try
    122     RootKey := Root;
     124    CurrentRoot := Root;
    123125    OpenKey(Key, True);
    124126    for I := 0 to Items.Count - 1 do

  • 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.