Changeset 390 for Registry/UGeneralRegistry.pas
- Timestamp:
- Jul 18, 2012, 4:13:05 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Registry/UGeneralRegistry.pas
r388 r390 6 6 7 7 uses 8 Classes, SysUtils, IniFiles ;8 Classes, SysUtils, IniFiles, WinRegistry; 9 9 10 10 type 11 TRegistryRoot = (rrUnknown, rrApplicationUser, rrApplicationGlobal, 12 rrSystemUser, rrSystemGlobal); 13 11 14 TRegKeyInfo = record 12 15 NumberSubKeys: Integer; … … 30 33 TBaseRegistry = class 31 34 private 32 procedure SetCurrentKey(const AValue: string);33 procedure SetCurrentRoot(const AValue: string);34 35 protected 35 FCurrentRoot: string;36 FCurrentRoot: NativeInt; 36 37 FCurrentKey: string; 38 procedure SetCurrentKey(const AValue: string); virtual; abstract; 39 procedure SetCurrentRoot(const AValue: NativeInt); virtual; abstract; 37 40 public 38 41 function KeyExists(const Name: string): Boolean; virtual; abstract; 39 42 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; 41 44 procedure CloseKey; virtual; abstract; 42 45 function DeleteKey(const Name: string; Recursive: Boolean = False): Boolean; virtual; abstract; … … 55 58 procedure WriteString(const Name: string; Value: string); virtual; abstract; 56 59 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; 58 64 property CurrentKey: string read FCurrentKey write SetCurrentKey; 59 65 end; … … 68 74 procedure CheckBackend; inline; 69 75 function GetCurrentKey: string; 70 function GetCurrentRoot: string;76 function GetCurrentRoot: NativeInt; 71 77 procedure SetBackend(const AValue: TBaseRegistry); 72 78 procedure SetCurrentKey(const AValue: string); 73 procedure SetCurrentRoot(const AValue: string);79 procedure SetCurrentRoot(const AValue: NativeInt); 74 80 public 75 81 constructor Create(AOwner: TComponent); override; … … 81 87 function DeleteValue(const Name: string): Boolean; 82 88 function RenameValue(const OldName, NewName: string): Boolean; 83 procedure OpenKey(const Key: string; CreateNew: Boolean);89 function OpenKey(const Key: string; CreateNew: Boolean): Boolean; 84 90 function ReadBool(const Name: string): Boolean; 85 91 function ReadDateTime(const Name: string): TDateTime; … … 94 100 procedure WriteString(const Name: string; Value: string); 95 101 procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); 102 function HasSubKeys: Boolean; 103 procedure GetKeyNames(Strings: TStrings); 104 procedure GetValueNames(Strings: TStrings); 96 105 property Backend: TBaseRegistry read FBackend write SetBackend; 97 property CurrentRoot: stringread GetCurrentRoot write SetCurrentRoot;106 property CurrentRoot: NativeInt read GetCurrentRoot write SetCurrentRoot; 98 107 property CurrentKey: string read GetCurrentKey write SetCurrentKey; 99 108 end; … … 102 111 103 112 TXMLRegistry = class(TBaseRegistry) 104 procedure OpenKey(const Key: string; CreateNew: Boolean); override;113 function OpenKey(const Key: string; CreateNew: Boolean): Boolean; override; 105 114 end; 106 115 … … 116 125 end; 117 126 127 { TWinRegistry } 128 118 129 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; 120 160 end; 121 161 … … 133 173 end; 134 174 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 179 procedure TWinRegistry.SetCurrentKey(const AValue: string); 180 begin 181 if FCurrentKey = AValue then Exit; 182 OpenKey(AValue, False); 183 end; 184 185 procedure TWinRegistry.SetCurrentRoot(const AValue: NativeInt); 186 begin 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; 197 end; 198 199 function TWinRegistry.KeyExists(const Name: string): Boolean; 200 begin 201 Result := Registry.KeyExists(Name); 202 end; 203 204 function TWinRegistry.ValueExists(const Name: string): Boolean; 205 begin 206 Result := Registry.ValueExists(Name); 207 end; 208 209 function TWinRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean; 210 begin 211 Result := Registry.OpenKey(Key, CreateNew); 212 FCurrentKey := Key; 213 end; 214 215 procedure TWinRegistry.CloseKey; 216 begin 217 Registry.CloseKey; 218 end; 219 220 function TWinRegistry.DeleteKey(const Name: string; Recursive: Boolean 221 ): Boolean; 222 var 223 SubKeys: TStringList; 224 I: Integer; 225 begin 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; 237 end; 238 239 function TWinRegistry.DeleteValue(const Name: string): Boolean; 240 begin 241 Result := Registry.DeleteValue(Name); 242 end; 243 244 function TWinRegistry.RenameValue(const OldName, NewName: string): Boolean; 245 begin 246 Result := True; 247 Registry.RenameValue(OldName, NewName); 248 end; 249 250 function TWinRegistry.ReadBool(const Name: string): Boolean; 251 begin 252 Result := Registry.ReadBool(Name); 253 end; 254 255 function TWinRegistry.ReadDateTime(const Name: string): TDateTime; 256 begin 257 Result := Registry.ReadDateTime(Name); 258 end; 259 260 function TWinRegistry.ReadFloat(const Name: string): Double; 261 begin 262 Result := Registry.ReadFloat(Name); 263 end; 264 265 function TWinRegistry.ReadInteger(const Name: string): Integer; 266 begin 267 Result := Registry.ReadInteger(Name); 268 end; 269 270 function TWinRegistry.ReadString(const Name: string): string; 271 begin 272 Result := Registry.ReadString(Name); 273 end; 274 275 function TWinRegistry.ReadBinaryData(const Name: string; var Buffer; 276 BufSize: Integer): Integer; 277 begin 278 Result := Registry.ReadBinaryData(Name, Buffer, BufSize); 279 end; 280 281 procedure TWinRegistry.WriteBool(const Name: string; Value: Boolean); 282 begin 283 Registry.WriteBool(Name, Value); 284 end; 285 286 procedure TWinRegistry.WriteDateTime(const Name: string; Value: TDateTime); 287 begin 288 Registry.WriteDateTime(Name, Value); 289 end; 290 291 procedure TWinRegistry.WriteFloat(const Name: string; Value: Double); 292 begin 293 Registry.WriteFloat(Name, Value); 294 end; 295 296 procedure TWinRegistry.WriteInteger(const Name: string; Value: Integer); 297 begin 298 Registry.WriteInteger(Name, Value); 299 end; 300 301 procedure TWinRegistry.WriteString(const Name: string; Value: string); 302 begin 303 Registry.WriteString(Name, Value); 304 end; 305 306 procedure TWinRegistry.WriteBinaryData(const Name: string; var Buffer; 307 BufSize: Integer); 308 begin 309 Registry.WriteBinaryData(Name, Buffer, BufSize); 310 end; 311 312 function TWinRegistry.HasSubKeys: Boolean; 313 begin 314 Result := Registry.HasSubKeys; 315 end; 316 317 procedure TWinRegistry.GetKeyNames(Strings: TStrings); 318 begin 319 Registry.GetKeyNames(Strings); 320 end; 321 322 procedure TWinRegistry.GetValueNames(Strings: TStrings); 323 begin 324 Registry.GetValueNames(Strings); 325 end; 326 327 constructor TWinRegistry.Create; 328 begin 329 Registry := TRegistry.Create; 330 end; 331 332 destructor TWinRegistry.Destroy; 333 begin 334 Registry.Free; 335 inherited Destroy; 336 end; 337 146 338 147 339 { TBaseRegistry } … … 162 354 { TXMLRegistry } 163 355 164 procedure TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean);356 function TXMLRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean; 165 357 begin 166 358 … … 181 373 end; 182 374 183 function TGeneralRegistry.GetCurrentRoot: string;375 function TGeneralRegistry.GetCurrentRoot: NativeInt; 184 376 begin 185 377 CheckBackend; … … 200 392 end; 201 393 202 procedure TGeneralRegistry.SetCurrentRoot(const AValue: string);203 begin 204 CheckBackend; 205 Backend.Current Key:= AValue;394 procedure TGeneralRegistry.SetCurrentRoot(const AValue: NativeInt); 395 begin 396 CheckBackend; 397 Backend.CurrentRoot := AValue; 206 398 end; 207 399 … … 242 434 end; 243 435 244 procedure TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean);245 begin 246 CheckBackend; 247 Backend.OpenKey(Key, CreateNew);436 function TGeneralRegistry.OpenKey(const Key: string; CreateNew: Boolean): Boolean; 437 begin 438 CheckBackend; 439 Result := Backend.OpenKey(Key, CreateNew); 248 440 end; 249 441 … … 269 461 begin 270 462 CheckBackend; 271 Result := ReadInteger(Name);463 Result := Backend.ReadInteger(Name); 272 464 end; 273 465 … … 320 512 CheckBackend; 321 513 Backend.WriteBinaryData(Name, Buffer, BufSize); 514 end; 515 516 function TGeneralRegistry.HasSubKeys: Boolean; 517 begin 518 CheckBackend; 519 Result := Backend.HasSubKeys; 520 end; 521 522 procedure TGeneralRegistry.GetKeyNames(Strings: TStrings); 523 begin 524 CheckBackend; 525 Backend.GetKeyNames(Strings); 526 end; 527 528 procedure TGeneralRegistry.GetValueNames(Strings: TStrings); 529 begin 530 CheckBackend; 531 Backend.GetValueNames(Strings); 322 532 end; 323 533
Note:
See TracChangeset
for help on using the changeset viewer.