source: trunk/Packages/Common/URegistry.pas

Last change on this file was 38, checked in by chronos, 7 years ago
  • Modified: Updated Common package.
File size: 4.0 KB
Line 
1unit URegistry;
2
3{$MODE Delphi}
4
5interface
6
7uses
8 Classes, Registry;
9
10type
11 TRegistryRoot = (rrKeyClassesRoot, rrKeyCurrentUser, rrKeyLocalMachine,
12 rrKeyUsers, rrKeyPerformanceData, rrKeyCurrentConfig, rrKeyDynData);
13
14 { TRegistryContext }
15
16 TRegistryContext = record
17 RootKey: HKEY;
18 Key: string;
19 class operator Equal(A, B: TRegistryContext): Boolean;
20 function Create(RootKey: TRegistryRoot; Key: string): TRegistryContext; overload;
21 function Create(RootKey: HKEY; Key: string): TRegistryContext; overload;
22 end;
23
24 { TRegistryEx }
25
26 TRegistryEx = class(TRegistry)
27 private
28 function GetCurrentContext: TRegistryContext;
29 procedure SetCurrentContext(AValue: TRegistryContext);
30 public
31 function ReadBoolWithDefault(const Name: string;
32 DefaultValue: Boolean): Boolean;
33 function ReadIntegerWithDefault(const Name: string; DefaultValue: Integer): Integer;
34 function ReadStringWithDefault(const Name: string; DefaultValue: string): string;
35 function ReadFloatWithDefault(const Name: string;
36 DefaultValue: Double): Double;
37 function DeleteKeyRecursive(const Key: string): Boolean;
38 function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
39 property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext;
40 end;
41
42const
43 RegistryRootHKEY: array[TRegistryRoot] of HKEY = (HKEY_CLASSES_ROOT,
44 HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_PERFORMANCE_DATA,
45 HKEY_CURRENT_CONFIG, HKEY_DYN_DATA);
46
47implementation
48
49
50{ TRegistryContext }
51
52class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean;
53begin
54 Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
55end;
56
57function TRegistryContext.Create(RootKey: TRegistryRoot; Key: string): TRegistryContext;
58begin
59 Result.RootKey := RegistryRootHKEY[RootKey];
60 Result.Key := Key;
61end;
62
63function TRegistryContext.Create(RootKey: HKEY; Key: string): TRegistryContext;
64begin
65 Result.RootKey := RootKey;
66 Result.Key := Key;
67end;
68
69{ TRegistryEx }
70
71function TRegistryEx.ReadIntegerWithDefault(const Name: string;
72 DefaultValue: Integer): Integer;
73begin
74 if ValueExists(Name) then Result := ReadInteger(Name)
75 else begin
76 WriteInteger(Name, DefaultValue);
77 Result := DefaultValue;
78 end;
79end;
80
81function TRegistryEx.ReadStringWithDefault(const Name: string;
82 DefaultValue: string): string;
83begin
84 if ValueExists(Name) then Result := ReadString(Name)
85 else begin
86 WriteString(Name, DefaultValue);
87 Result := DefaultValue;
88 end;
89end;
90
91function TRegistryEx.ReadFloatWithDefault(const Name: string;
92 DefaultValue: Double): Double;
93begin
94 if ValueExists(Name) then Result := ReadFloat(Name)
95 else begin
96 WriteFloat(Name, DefaultValue);
97 Result := DefaultValue;
98 end;
99end;
100
101function TRegistryEx.DeleteKeyRecursive(const Key: string): Boolean;
102var
103 SubKeys: TStringList;
104 I: Integer;
105begin
106 try
107 SubKeys := TStringList.Create;
108 if OpenKey(Key, False) and HasSubKeys then begin
109 GetKeyNames(SubKeys);
110 for I := 0 to SubKeys.Count - 1 do
111 DeleteKeyRecursive(Key + '\' + SubKeys[I]);
112 end;
113 Result := DeleteKey(Key);
114 finally
115 SubKeys.Free;
116 end;
117end;
118
119function TRegistryEx.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
120begin
121 {$IFDEF Linux}
122 CloseKey;
123 {$ENDIF}
124 Result := inherited OpenKey(Key, CanCreate);
125end;
126
127function TRegistryEx.GetCurrentContext: TRegistryContext;
128begin
129 Result.Key := CurrentPath;
130 Result.RootKey := RootKey;
131end;
132
133procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext);
134begin
135 RootKey := AValue.RootKey;
136 OpenKey(AValue.Key, True);
137end;
138
139function TRegistryEx.ReadBoolWithDefault(const Name: string;
140 DefaultValue: Boolean): Boolean;
141begin
142 if ValueExists(Name) then Result := ReadBool(Name)
143 else begin
144 WriteBool(Name, DefaultValue);
145 Result := DefaultValue;
146 end;
147end;
148
149end.
Note: See TracBrowser for help on using the repository browser.