1 | unit URegistry;
|
---|
2 |
|
---|
3 | {$MODE Delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, Registry;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TRegistryRoot = (rrKeyClassesRoot = HKEY($80000000),
|
---|
12 | rrKeyCurrentUser = HKEY($80000001),
|
---|
13 | rrKeyLocalMachine = HKEY($80000002),
|
---|
14 | rrKeyUsers = HKEY($80000003),
|
---|
15 | rrKeyPerformanceData = HKEY($80000004),
|
---|
16 | rrKeyCurrentConfig = HKEY($80000005),
|
---|
17 | rrKeyDynData = HKEY($80000006));
|
---|
18 |
|
---|
19 | TRegistryContext = record
|
---|
20 | RootKey: HKEY;
|
---|
21 | Key: string;
|
---|
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 ReadDateTimeWithDefault(const Name: string;
|
---|
38 | DefaultValue: TDateTime): TDateTime;
|
---|
39 | function DeleteKeyRecursive(const Key: string): Boolean;
|
---|
40 | function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
|
---|
41 | property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext;
|
---|
42 | end;
|
---|
43 |
|
---|
44 | function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
|
---|
45 |
|
---|
46 |
|
---|
47 | implementation
|
---|
48 |
|
---|
49 | function RegContext(RootKey: HKEY; Key: string): TRegistryContext;
|
---|
50 | begin
|
---|
51 | Result.RootKey := RootKey;
|
---|
52 | Result.Key := Key;
|
---|
53 | end;
|
---|
54 |
|
---|
55 | { TRegistryEx }
|
---|
56 |
|
---|
57 | function TRegistryEx.ReadIntegerWithDefault(const Name: string;
|
---|
58 | DefaultValue: Integer): Integer;
|
---|
59 | begin
|
---|
60 | if ValueExists(Name) then Result := ReadInteger(Name)
|
---|
61 | else begin
|
---|
62 | WriteInteger(Name, DefaultValue);
|
---|
63 | Result := DefaultValue;
|
---|
64 | end;
|
---|
65 | end;
|
---|
66 |
|
---|
67 | function TRegistryEx.ReadStringWithDefault(const Name: string;
|
---|
68 | DefaultValue: string): string;
|
---|
69 | begin
|
---|
70 | if ValueExists(Name) then Result := ReadString(Name)
|
---|
71 | else begin
|
---|
72 | WriteString(Name, DefaultValue);
|
---|
73 | Result := DefaultValue;
|
---|
74 | end;
|
---|
75 | end;
|
---|
76 |
|
---|
77 | function TRegistryEx.ReadFloatWithDefault(const Name: string;
|
---|
78 | DefaultValue: Double): Double;
|
---|
79 | begin
|
---|
80 | if ValueExists(Name) then Result := ReadFloat(Name)
|
---|
81 | else begin
|
---|
82 | WriteFloat(Name, DefaultValue);
|
---|
83 | Result := DefaultValue;
|
---|
84 | end;
|
---|
85 | end;
|
---|
86 |
|
---|
87 | function TRegistryEx.ReadDateTimeWithDefault(const Name: string;
|
---|
88 | DefaultValue: TDateTime): TDateTime;
|
---|
89 | begin
|
---|
90 | Result := ReadFloatWithDefault(Name, DefaultValue);
|
---|
91 | end;
|
---|
92 |
|
---|
93 | function TRegistryEx.DeleteKeyRecursive(const Key: string): Boolean;
|
---|
94 | var
|
---|
95 | SubKeys: TStringList;
|
---|
96 | I: Integer;
|
---|
97 | begin
|
---|
98 | try
|
---|
99 | SubKeys := TStringList.Create;
|
---|
100 | if OpenKey(Key, False) and HasSubKeys then begin
|
---|
101 | GetKeyNames(SubKeys);
|
---|
102 | for I := 0 to SubKeys.Count - 1 do
|
---|
103 | DeleteKeyRecursive(Key + '\' + SubKeys[I]);
|
---|
104 | end;
|
---|
105 | Result := DeleteKey(Key);
|
---|
106 | finally
|
---|
107 | SubKeys.Free;
|
---|
108 | end;
|
---|
109 | end;
|
---|
110 |
|
---|
111 | function TRegistryEx.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
|
---|
112 | begin
|
---|
113 | {$IFDEF Linux}
|
---|
114 | CloseKey;
|
---|
115 | {$ENDIF}
|
---|
116 | Result := inherited OpenKey(Key, CanCreate);
|
---|
117 | end;
|
---|
118 |
|
---|
119 | function TRegistryEx.GetCurrentContext: TRegistryContext;
|
---|
120 | begin
|
---|
121 | Result.Key := CurrentPath;
|
---|
122 | Result.RootKey := RootKey;
|
---|
123 | end;
|
---|
124 |
|
---|
125 | procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext);
|
---|
126 | begin
|
---|
127 | RootKey := AValue.RootKey;
|
---|
128 | OpenKey(AValue.Key, True);
|
---|
129 | end;
|
---|
130 |
|
---|
131 | function TRegistryEx.ReadBoolWithDefault(const Name: string;
|
---|
132 | DefaultValue: Boolean): Boolean;
|
---|
133 | begin
|
---|
134 | if ValueExists(Name) then Result := ReadBool(Name)
|
---|
135 | else begin
|
---|
136 | WriteBool(Name, DefaultValue);
|
---|
137 | Result := DefaultValue;
|
---|
138 | end;
|
---|
139 | end;
|
---|
140 |
|
---|
141 | end.
|
---|