Changeset 390 for Registry

Timestamp:

Jul 18, 2012, 4:13:05 PM (12 years ago)

Author:

chronos

Message:

• Added: GeneralRegistry TWinRegistry class implementation.

Location:

Registry

Files:

• GeneralRegistry.lpk (modified) (2 diffs)
• GeneralRegistry.pas (modified) (2 diffs)
• Registry2.pas (deleted)
• UGeneralRegistry.pas (modified) (15 diffs)
• WinRegistry.pas (added)
• regdef.inc (deleted)
• winreg.inc (deleted)
• xmlreg.pp (deleted)
• xregreg.inc (deleted)

Registry/GeneralRegistry.lpk

@@ -3 +3 @@
   <Package Version="4">
     <Name Value="GeneralRegistry"/>
+    <Author Value="Chronos (robie@centrum.cz)"/>
     <CompilerOptions>
       <Version Value="11"/>
@@ -15 +16 @@
       </Other>
     </CompilerOptions>
-    <Files Count="8">
+    <Description Value="Generalized registry classes for multiplatform programming."/>
+    <License Value="LGPL"/>
+    <Version Minor="1"/>
+    <Files Count="3">
       <Item1>
-        <Filename Value="Registry2.pas"/>
+        <Filename Value="WinRegistry.pas"/>
         <Type Value="Text"/>
-        <UnitName Value="Registry2"/>
+        <UnitName Value="WinRegistry"/>
       </Item1>
-      <Item2>
-        <Filename Value="xmlreg.pp"/>
-        <UnitName Value="xmlreg"/>
-      </Item2>
       <Item3>
-        <Filename Value="regdef.inc"/>
-        <Type Value="Include"/>
+        <Filename Value="UGeneralRegistry.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UGeneralRegistry"/>
       </Item3>
-      <Item4>
-        <Filename Value="regini.inc"/>
-        <Type Value="Include"/>
-      </Item4>
-      <Item5>
-        <Filename Value="winreg.inc"/>
-        <Type Value="Include"/>
-      </Item5>
-      <Item6>
-        <Filename Value="xregreg.inc"/>
-        <Type Value="Include"/>
-      </Item6>
-      <Item8>
-        <Filename Value="UGeneralRegistry.pas"/>
-        <UnitName Value="UGeneralRegistry"/>
-      </Item8>
     </Files>
     <Type Value="RunAndDesignTime"/>

Registry/GeneralRegistry.pas

@@ -8 +8 @@
 
 uses
-  xmlreg, UGeneralRegistry, LazarusPackageIntf;
+  UGeneralRegistry, LazarusPackageIntf;
 
 implementation
@@ -14 +14 @@
 procedure Register;
 begin
+  RegisterUnit('UGeneralRegistry', @UGeneralRegistry.Register);
 end;
 

Registry/UGeneralRegistry.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, IniFiles;
+  Classes, SysUtils, IniFiles, WinRegistry;
 
 type
+  TRegistryRoot = (rrUnknown, rrApplicationUser, rrApplicationGlobal,
+    rrSystemUser, rrSystemGlobal);
+
   TRegKeyInfo = record
     NumberSubKeys: Integer;
@@ -30 +33 @@
   TBaseRegistry = class
   private
-    procedure SetCurrentKey(const AValue: string);
-    procedure SetCurrentRoot(const AValue: string);
   protected
-    FCurrentRoot: string;
+    FCurrentRoot: NativeInt;
     FCurrentKey: string;
+    procedure SetCurrentKey(const AValue: string); virtual; abstract;
+    procedure SetCurrentRoot(const AValue: NativeInt); virtual; abstract;
   public
     function KeyExists(const Name: string): Boolean; virtual; abstract;
     function ValueExists(const Name: string): Boolean; virtual; abstract;
-    procedure OpenKey(const Key: string; CreateNew: Boolean); virtual; abstract;
+    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; virtual; abstract;
     procedure CloseKey; virtual; abstract;
     function DeleteKey(const Name: string; Recursive: Boolean = False): Boolean; virtual; abstract;
@@ -55 +58 @@
     procedure WriteString(const Name: string; Value: string); virtual; abstract;
     procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); virtual; abstract;
-    property CurrentRoot: string read FCurrentRoot write SetCurrentRoot;
+    function HasSubKeys: Boolean; virtual; abstract;
+    procedure GetKeyNames(Strings: TStrings); virtual; abstract;
+    procedure GetValueNames(Strings: TStrings); virtual; abstract;
+    property CurrentRoot: NativeInt read FCurrentRoot write SetCurrentRoot;
     property CurrentKey: string read FCurrentKey write SetCurrentKey;
   end;
@@ -68 +74 @@
     procedure CheckBackend; inline;
     function GetCurrentKey: string;
-    function GetCurrentRoot: string;
+    function GetCurrentRoot: NativeInt;
     procedure SetBackend(const AValue: TBaseRegistry);
     procedure SetCurrentKey(const AValue: string);
-    procedure SetCurrentRoot(const AValue: string);
+    procedure SetCurrentRoot(const AValue: NativeInt);
   public
     constructor Create(AOwner: TComponent); override;
@@ -81 +87 @@
     function DeleteValue(const Name: string): Boolean;
     function RenameValue(const OldName, NewName: string): Boolean;
-    procedure OpenKey(const Key: string; CreateNew: Boolean);
+    function OpenKey(const Key: string; CreateNew: Boolean): Boolean;
     function ReadBool(const Name: string): Boolean;
     function ReadDateTime(const Name: string): TDateTime;
@@ -94 +100 @@
     procedure WriteString(const Name: string; Value: string);
     procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
+    function HasSubKeys: Boolean;
+    procedure GetKeyNames(Strings: TStrings);
+    procedure GetValueNames(Strings: TStrings);
     property Backend: TBaseRegistry read FBackend write SetBackend;
-    property CurrentRoot: string read GetCurrentRoot write SetCurrentRoot;
+    property CurrentRoot: NativeInt read GetCurrentRoot write SetCurrentRoot;
     property CurrentKey: string read GetCurrentKey write SetCurrentKey;
   end;
@@ -102 +111 @@
 
   TXMLRegistry = class(TBaseRegistry)
-    procedure OpenKey(const Key: string; CreateNew: Boolean); override;
+    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; override;
   end;
 
@@ -116 +125 @@
   end;
 
+  { TWinRegistry }
+
   TWinRegistry = class(TBaseRegistry)
-
+  protected
+    procedure SetCurrentKey(const AValue: string); override;
+    procedure SetCurrentRoot(const AValue: NativeInt); override;
+  public
+    BasePath: string;
+    Registry: TRegistry;
+    function KeyExists(const Name: string): Boolean; override;
+    function ValueExists(const Name: string): Boolean; override;
+    function OpenKey(const Key: string; CreateNew: Boolean): Boolean; override;
+    procedure CloseKey; override;
+    function DeleteKey(const Name: string; Recursive: Boolean = False): Boolean; override;
+    function DeleteValue(const Name: string): Boolean; override;
+    function RenameValue(const OldName, NewName: string): Boolean; override;
+    function ReadBool(const Name: string): Boolean; override;
+    function ReadDateTime(const Name: string): TDateTime; override;
+    function ReadFloat(const Name: string): Double; override;
+    function ReadInteger(const Name: string): Integer; override;
+    function ReadString(const Name: string): string; override;
+    function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer; override;
+    procedure WriteBool(const Name: string; Value: Boolean); override;
+    procedure WriteDateTime(const Name: string; Value: TDateTime); override;
+    procedure WriteFloat(const Name: string; Value: Double); override;
+    procedure WriteInteger(const Name: string; Value: Integer); override;
+    procedure WriteString(const Name: string; Value: string); override;
+    procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); override;
+    function HasSubKeys: Boolean; override;
+    procedure GetKeyNames(Strings: TStrings); override;
+    procedure GetValueNames(Strings: TStrings); override;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -133 +173 @@
 end;
 
-procedure TBaseRegistry.SetCurrentKey(const AValue: string);
-begin
-  if FCurrentKey=AValue then Exit;
-  FCurrentKey:=AValue;
-end;
-
-procedure TBaseRegistry.SetCurrentRoot(const AValue: string);
-begin
-  if FCurrentRoot=AValue then Exit;
-  FCurrentRoot:=AValue;
-end;
+{ TBaseRegistry }
+
+{ TWinRegistry }
+
+procedure TWinRegistry.SetCurrentKey(const AValue: string);
+begin
+  if FCurrentKey = AValue then Exit;
+  OpenKey(AValue, False);
+end;
+
+procedure TWinRegistry.SetCurrentRoot(const AValue: NativeInt);
+begin
+  if FCurrentRoot = AValue then Exit;
+  FCurrentRoot := AValue;
+  if AValue = Integer(rrApplicationUser) then begin
+    Registry.RootKey := HKEY_CURRENT_USER;
+    BasePath := '\Software\Company\Product';
+  end;
+  if AValue = Integer(rrApplicationGlobal) then begin
+    Registry.RootKey := HKEY_LOCAL_MACHINE;
+    BasePath := '\Software\Company\Product';
+  end;
+end;
+
+function TWinRegistry.KeyExists(const Name: string): Boolean;
+begin
+  Result := Registry.KeyExists(Name);
+end;
+
+function TWinRegistry.ValueExists(const Name: string): Boolean;
+begin
+  Result := Registry.ValueExists(Name);
+end;
+
+function TWinRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
+begin
+  Result := Registry.OpenKey(Key, CreateNew);
+  FCurrentKey := Key;
+end;
+
+procedure TWinRegistry.CloseKey;
+begin
+  Registry.CloseKey;
+end;
+
+function TWinRegistry.DeleteKey(const Name: string; Recursive: Boolean
+  ): Boolean;
+var
+  SubKeys: TStringList;
+  I: Integer;
+begin
+  try
+    SubKeys := TStringList.Create;
+    if Recursive and OpenKey(Name, False) and HasSubKeys then begin
+      GetKeyNames(SubKeys);
+      for I := 0 to SubKeys.Count - 1 do
+        DeleteKey(Name + '\' + SubKeys[I], True);
+    end;
+    Result := Registry.DeleteKey(Name);
+  finally
+    SubKeys.Free;
+  end;
+end;
+
+function TWinRegistry.DeleteValue(const Name: string): Boolean;
+begin
+  Result := Registry.DeleteValue(Name);
+end;
+
+function TWinRegistry.RenameValue(const OldName, NewName: string): Boolean;
+begin
+  Result := True;
+  Registry.RenameValue(OldName, NewName);
+end;
+
+function TWinRegistry.ReadBool(const Name: string): Boolean;
+begin
+  Result := Registry.ReadBool(Name);
+end;
+
+function TWinRegistry.ReadDateTime(const Name: string): TDateTime;
+begin
+  Result := Registry.ReadDateTime(Name);
+end;
+
+function TWinRegistry.ReadFloat(const Name: string): Double;
+begin
+  Result := Registry.ReadFloat(Name);
+end;
+
+function TWinRegistry.ReadInteger(const Name: string): Integer;
+begin
+  Result := Registry.ReadInteger(Name);
+end;
+
+function TWinRegistry.ReadString(const Name: string): string;
+begin
+  Result := Registry.ReadString(Name);
+end;
+
+function TWinRegistry.ReadBinaryData(const Name: string; var Buffer;
+  BufSize: Integer): Integer;
+begin
+  Result := Registry.ReadBinaryData(Name, Buffer, BufSize);
+end;
+
+procedure TWinRegistry.WriteBool(const Name: string; Value: Boolean);
+begin
+  Registry.WriteBool(Name, Value);
+end;
+
+procedure TWinRegistry.WriteDateTime(const Name: string; Value: TDateTime);
+begin
+  Registry.WriteDateTime(Name, Value);
+end;
+
+procedure TWinRegistry.WriteFloat(const Name: string; Value: Double);
+begin
+  Registry.WriteFloat(Name, Value);
+end;
+
+procedure TWinRegistry.WriteInteger(const Name: string; Value: Integer);
+begin
+  Registry.WriteInteger(Name, Value);
+end;
+
+procedure TWinRegistry.WriteString(const Name: string; Value: string);
+begin
+  Registry.WriteString(Name, Value);
+end;
+
+procedure TWinRegistry.WriteBinaryData(const Name: string; var Buffer;
+  BufSize: Integer);
+begin
+  Registry.WriteBinaryData(Name, Buffer, BufSize);
+end;
+
+function TWinRegistry.HasSubKeys: Boolean;
+begin
+  Result := Registry.HasSubKeys;
+end;
+
+procedure TWinRegistry.GetKeyNames(Strings: TStrings);
+begin
+  Registry.GetKeyNames(Strings);
+end;
+
+procedure TWinRegistry.GetValueNames(Strings: TStrings);
+begin
+  Registry.GetValueNames(Strings);
+end;
+
+constructor TWinRegistry.Create;
+begin
+  Registry := TRegistry.Create;
+end;
+
+destructor TWinRegistry.Destroy;
+begin
+  Registry.Free;
+  inherited Destroy;
+end;
+
 
 { TBaseRegistry }
@@ -162 +354 @@
 { TXMLRegistry }
 
-procedure TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean);
+function TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
 begin
 
@@ -181 +373 @@
 end;
 
-function TGeneralRegistry.GetCurrentRoot: string;
+function TGeneralRegistry.GetCurrentRoot: NativeInt;
 begin
   CheckBackend;
@@ -200 +392 @@
 end;
 
-procedure TGeneralRegistry.SetCurrentRoot(const AValue: string);
-begin
-  CheckBackend;
-  Backend.CurrentKey := AValue;
+procedure TGeneralRegistry.SetCurrentRoot(const AValue: NativeInt);
+begin
+  CheckBackend;
+  Backend.CurrentRoot := AValue;
 end;
 
@@ -242 +434 @@
 end;
 
-procedure TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean);
-begin
-  CheckBackend;
-  Backend.OpenKey(Key, CreateNew);
+function TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean;
+begin
+  CheckBackend;
+  Result := Backend.OpenKey(Key, CreateNew);
 end;
 
@@ -269 +461 @@
 begin
   CheckBackend;
-  Result := ReadInteger(Name);
+  Result := Backend.ReadInteger(Name);
 end;
 
@@ -320 +512 @@
   CheckBackend;
   Backend.WriteBinaryData(Name, Buffer, BufSize);
+end;
+
+function TGeneralRegistry.HasSubKeys: Boolean;
+begin
+  CheckBackend;
+  Result := Backend.HasSubKeys;
+end;
+
+procedure TGeneralRegistry.GetKeyNames(Strings: TStrings);
+begin
+  CheckBackend;
+  Backend.GetKeyNames(Strings);
+end;
+
+procedure TGeneralRegistry.GetValueNames(Strings: TStrings);
+begin
+  CheckBackend;
+  Backend.GetValueNames(Strings);
 end;