Changeset 390
- Timestamp:
- Jul 18, 2012, 4:13:05 PM (12 years ago)
- Files:
-
- 2 added
- 6 deleted
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Common.lpk
r387 r390 91 91 <RequiredPkgs Count="3"> 92 92 <Item1> 93 <PackageName Value="RegistryPkg"/> 93 <PackageName Value="GeneralRegistry"/> 94 <MinVersion Minor="1" Valid="True"/> 94 95 </Item1> 95 96 <Item2> -
Common/StopWatch.pas
r358 r390 22 22 function GetElapsed: string; 23 23 public 24 constructor Create(const startOnCreate 24 constructor Create(const startOnCreate: Boolean = False) ; 25 25 procedure Start; 26 26 procedure Stop; 27 property IsHighResolution 28 property ElapsedTicks 29 property ElapsedMiliseconds 30 property Elapsed 31 property IsRunning 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; 32 32 end; 33 33 -
Common/UApplicationInfo.pas
r387 r390 6 6 7 7 uses 8 SysUtils, Registry2, Classes, Forms, URegistry;8 SysUtils, Classes, Forms, UGeneralRegistry; 9 9 10 10 type … … 74 74 FAppName := Application.Name; 75 75 FRegistryKey := '\Software\' + FAppName; 76 FRegistryRoot := rr KeyCurrentUser;76 FRegistryRoot := rrApplicationUser; 77 77 end; 78 78 -
Common/ULastOpenedList.pas
r387 r390 6 6 7 7 uses 8 Classes, SysUtils, Registry2, URegistry, Menus;8 Classes, SysUtils, UGeneralRegistry, Menus; 9 9 10 10 type … … 23 23 destructor Destroy; override; 24 24 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); 27 27 procedure AddItem(FileName: string); 28 28 published … … 87 87 end; 88 88 89 procedure TLastOpenedList.LoadFromRegistry(Root: HKEY;Key: string);89 procedure TLastOpenedList.LoadFromRegistry(Root: Integer; const Key: string); 90 90 var 91 91 I: Integer; 92 Registry: T RegistryEx;92 Registry: TGeneralRegistry; 93 93 FileName: string; 94 94 begin 95 Registry := T RegistryEx.Create;95 Registry := TGeneralRegistry.Create(nil); 96 96 with Registry do 97 97 try 98 RootKey:= Root;98 CurrentRoot := Root; 99 99 OpenKey(Key, True); 100 100 Items.Clear; 101 101 I := 0; 102 102 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 := ''; 104 106 if Trim(FileName) <> '' then Items.Add(FileName); 105 107 Inc(I); … … 112 114 end; 113 115 114 procedure TLastOpenedList.SaveToRegistry(Root: HKEY;Key: string);116 procedure TLastOpenedList.SaveToRegistry(Root: Integer; const Key: string); 115 117 var 116 118 I: Integer; 117 Registry: T RegistryEx;119 Registry: TGeneralRegistry; 118 120 begin 119 Registry := T RegistryEx.Create;121 Registry := TGeneralRegistry.Create(nil); 120 122 with Registry do 121 123 try 122 RootKey:= Root;124 CurrentRoot := Root; 123 125 OpenKey(Key, True); 124 126 for I := 0 to Items.Count - 1 do -
Registry/GeneralRegistry.lpk
r388 r390 3 3 <Package Version="4"> 4 4 <Name Value="GeneralRegistry"/> 5 <Author Value="Chronos (robie@centrum.cz)"/> 5 6 <CompilerOptions> 6 7 <Version Value="11"/> … … 15 16 </Other> 16 17 </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"> 18 22 <Item1> 19 <Filename Value=" Registry2.pas"/>23 <Filename Value="WinRegistry.pas"/> 20 24 <Type Value="Text"/> 21 <UnitName Value=" Registry2"/>25 <UnitName Value="WinRegistry"/> 22 26 </Item1> 23 <Item2>24 <Filename Value="xmlreg.pp"/>25 <UnitName Value="xmlreg"/>26 </Item2>27 27 <Item3> 28 <Filename Value="regdef.inc"/> 29 <Type Value="Include"/> 28 <Filename Value="UGeneralRegistry.pas"/> 29 <HasRegisterProc Value="True"/> 30 <UnitName Value="UGeneralRegistry"/> 30 31 </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>47 32 </Files> 48 33 <Type Value="RunAndDesignTime"/> -
Registry/GeneralRegistry.pas
r388 r390 8 8 9 9 uses 10 xmlreg,UGeneralRegistry, LazarusPackageIntf;10 UGeneralRegistry, LazarusPackageIntf; 11 11 12 12 implementation … … 14 14 procedure Register; 15 15 begin 16 RegisterUnit('UGeneralRegistry', @UGeneralRegistry.Register); 16 17 end; 17 18 -
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.