myReg:=TRegistry.Create;
myReg.CreateKey('\sunandan123\');
//myReg.WriteString('Tile','1');
myReg.WriteString ('TileWallpaper','1') ;
This code gives an exception that i 'failed to set the value for 'TileWallpaper'. how to correct it?
Thanks
I always do it like this.
procedure TForm1.Button1Click(Sender: TObject);
var R: TRegistry;
begin
R := TRegistry.Create;
try
if not R.OpenKey('Software\CompanyName\ProductName\SubKey', True) then
RaiseLastOSError;
R.WriteString('ValueName', '1');
R.WriteString('Other Value Name', 'Some other value');
finally R.Free;
end;
end;
Calling CreateKey doesn't open the key which is why the write fails.
The easiest solution is to replace the call to CreateKey with one to OpenKey passing True for the CanCreate parameter. This will create the key if it does not already exist, and then open it for you to use in subsequent method calls.
myReg.OpenKey('\sunandan123\', True);
myReg.WriteString ('TileWallpaper', '1');
And for the sake of completeness you should include error handling, try/finally around the lifetime of myReg etc. I would also recommend that you explicitly set RootKey since at the moment you are relying on its default value of HKCU.
Related
I am trying to add values to Internet Explorer's Registry key from an addon. My understanding is if OpenKey() doesn't find the Registry key, then it creates the key because of the true parameter I am using. But it's not being created, and the function returns false. Any idea what I'm doing wrong?
procedure DoInitialization;
var
...
reg1: TRegistry;
begin
reg1 := tRegistry.Create(KEY_ALL_ACCESS);
try
if reg1.OpenKey('HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Low Rights\ElevationPolicy\{B93642D4-0A6D-11DF-AD36-FF4756D89593}', true) then begin
reg1.WriteString('AppPath', ClientDir);
reg1.WriteInteger('Policy', $00000003);
reg1.WriteString('AppName', 'xxxxxxxx.exe');
end else
ShowMessage('False');
finally
reg1.CloseKey;
end;
...
end;
The root key is to be set in the RootKey property, not the key.
reg1.RootKey := HKEY_CURRENT_USER;
if reg1.OpenKey('Software\...', True) then begin
....
In fact, HKEY_CURRENT_USER is the default so strictly speaking you don't need to set it. But it is, in my opinion, helpful to be explicit.
If that fails then likely you have got a mistake in the registry key string, or perhaps the user does not have sufficient rights. Use the LastError property of reg1 to find out why the call failed.
Note that you leak reg1. You need to destroy the object in the finally block.
DON'T use KEY_ALL_ACCESS, that requires admin rights to use. In this situation, you are just writing values to the key, so all you need to use is KEY_SET_VALUE instead. Don't request more rights than you actually need.
Also, you need to use the RootKey property to specify HKEY_CURRENT_USER, do not include it in the key path string.
And, you are leaking the TRegistry object.
Try this instead:
procedure DoInitialization;
var
...
reg1: TRegistry;
begin
reg1 := TRegistry.Create(KEY_SET_VALUE);
try
reg1.RootKey := HKEY_CURRENT_USER;
if reg1.OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Low Rights\ElevationPolicy\{B93642D4-0A6D-11DF-AD36-FF4756D89593}', true) then
begin
try
reg1.WriteString('AppPath', ClientDir);
reg1.WriteInteger('Policy', $00000003);
reg1.WriteString('AppName', 'xxxxxxxx.exe');
finally
reg1.CloseKey;
end;
end else
ShowMessage('False');
finally
reg1.Free;
end;
...
end;
I assume that it is possible to get the complete path of the unit (not just the name) at runtime, since when I generate an error, Delphi already has this stored information:
try
Assert (False, '#');
except
on E: EAssertionFailed from
begin
ShowMessage (E.Message); // this show me the path
end;
end;
Would anyone know if there is any function that returns me the path of a specific unit, or something similar?
The complete path of the unit as it was on the machine that compiled the project is only possible using Assert. However personally I don't find that information incredibly useful unless you have many units with the same name in different folders or lost control over your source repository and and library paths in effect when compiling.
To get the unit name you can turn on map file or debug information (aka TD32) and do the following:
Use the FileByLevel function from JclDebug - in your case with the default value (0).
The level parameter tells the function how many calls it look up the callstack. If you put that method into a FormCreate of a VCL form for example and pass 1 it will give you Vcl.Forms.pas as the event handler was called from there.
I hesitate to write this answer as it shows a really dirty hack to get the unit name making use of the Assert compiler magic shown above.
Use the following unit:
unit UnitNameHack;
interface
const
cUnitNameSentinel = '$$$sentinel$$$';
var
HackUnitname: string = '';
implementation
var
OrgAssertErrorProc: TAssertErrorProc = nil;
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
if Message = cUnitNameSentinel then begin
HackUnitname:= Filename;
end
else begin
OrgAssertErrorProc(Message, Filename, LineNumber, ErrorAddr);
end;
end;
initialization
OrgAssertErrorProc := AssertErrorProc;
AssertErrorProc := MyAssertErrorProc;
finalization
AssertErrorProc := OrgAssertErrorProc;
end.
Now whenever you need the unit name call
Assert(False, cUnitNameSentinel);
and retrieve the unit name from HackUnitname.
Note that you cannot wrap the Assert call and reading HackUnitName into a function, not even if inlined.
You've said, something similar. I see that it might have been in a different context, but anyway, for objects you can inspect UnitName or UnitScope to get the name of the module where the object instance was declared, without the module path (which is not valuable information anyway).
Based on Uwe Raabe's answer:
// directly after the implementation uses:
var
ThisUnit: string = '<unknown>';
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
ThisUnit := Filename;
end;
procedure InitThisUnit;
var
OrgAssertErrorProc: TAssertErrorProc;
begin
OrgAssertErrorProc := AssertErrorProc;
try
AssertErrorProc := MyAssertErrorProc;
Assert(False);
finally
AssertErrorProc := OrgAssertErrorProc;
end;
end;
// [...]
// call InitThisUnit in the initialization section
initialization
InitThisUnit;
end.
It's still a hack, but a bit more elegant. ;-)
In addition to this question I have made some tests and researches on the docwiki. My conclusion is that this kind of code should work without memory leaks:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
Result.DoSomething;
end;
And then somewhere I can call the above code in this manner:
var k: TClassA;
begin
k := testResultObject;
try
//code code code
finally
k.Free;
end;
end;
As Remy suggested in the answer it's better to avoid this way of doing things and instead use something like testResultObject(x: TClassA): boolean. In this case the return true/false can tell me if everything went fine and I am passing an object already created.
Look at this code:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
The problem with the first version above of the function is that DoSomething could raise an exception and if so I'll leak memory. Can the second implementation with try-except be a solution? For sure later I'll have to check if the result is assigned or nil.
I agree that (as already said above) the testResultObject(x: TClassA): boolean would be better. I was just wondering if the return-a-class function way could be fixed as I've written.
Your code has serious problems. In case of an error, it swallows the exception, and returns an invalid object reference.
This is easy to fix. The canonical way is as follows:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
raise;
end;
end;
Either the function succeeds and returns a new object. Or it fails, cleans up after itself, and raises an exception.
In other words, this function looks and behaves just like a constructor. You consume it in the same way:
obj := testResultObject;
try
// do things with obj
finally
obj.Free;
end;
Your second approach works, but has 2 serious problems.
By swallowing all exceptions, (as J pointed out) you'll hide the fact that something went wrong.
There's no indication to the caller that you've created an object that the caller is responsible for destroying. This makes using the function more error prone; and easier to cause memory leaks.
I would recommend the following improvement on your second approach:
{Name has a clue that caller should take ownership of a new object returned}
function CreateObjectA: TClassA;
begin
{Once object is successfully created, internal resource protection is required:
- if no error, it is callers responsibility to destroy the returned object
- if error, caller must assume creation *failed* so must destroy object here
Also, by assigning Result of successful Create before *try*:
The object (reference) is returned
**if-and-only-if**
This function returns 'normally' (i.e. no exception state)}
Result := TClassA.Create;
try
Result.DoSomething; {that could fail}
except
{Cleanup only if something goes wrong:
caller should not be responsible for errors *within* this method}
Result.Free;
{Re-raise the exception to notify caller:
exception state means caller does not "receive" Result...
code jumps to next finally or except block}
raise;
end;
end;
The most important benefit of the above create function is that: as far as any caller/client code is concerned, it behaves exactly like a normal TObject.Create.
And so the correct usage pattern is exactly the same.
Note that I'm not keen on J's FreeAndNil suggestion because if calling code doesn't check if the result was assigned: it is likely to AV. And code that does check the result correctly will be a little messy:
var k: TClassA;
begin
k := testResultObject; {assuming nil result on failed create, next/similar is *required*}
if Assigned(k) then {Note how this differs from normal try finally pattern}
try
//code using k
finally
k.Free;
end;
end;
NB: It's important to note that you cannot ever have your caller simply ignore memory management; which brings me to the next section.
All the above aside, there is much less chance of making careless mistakes if your testResultObject takes an input object that you require the caller to create and manage its lifetime as needed. I'm not sure why you're resisting that approach so much? You cannot get simpler than the following without resorting to a different memory model.
var k: TClassA;
begin
k := TClassA.Create;
try
testResultObject(k); {Where this is simply implemented as k.DoSomething;}
//more code using k
finally
k.Free;
end;
end;
The only problem with this :
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
Is that you have no way of knowing whether the function was successful. Freeing an object does not alter the reference; the variable will still point to the (now) invalid memory location where the object used to exist. You must explicitly set the reference to nil if you want the consumer to be able to test if the reference is valid. If you want to use this pattern (having the consumer test for nil) then you would need to do :
try
Result.DoSomething;
except
FreeAndNil(Result);
end;
This way the caller can test the result for nil (using Assigned or otherwise) as you intended. This still isn't a very clean approach, however, since you're still swallowing exceptions. Another solution might be to simply introduce a new constructor or alter the existing one. For example
TFoo = class
public
constructor Create(ADoSomething : boolean = false);
procedure DoSomething;
end;
constructor TClassA.Create(ADoSomething: Boolean = False);
begin
inherited Create;
if ADoSomething then DoSomething;
end;
procedure TClassA.DoSomething;
begin
//
end;
This way you can get rid of all of the exception handling and just call this as :
function testResultObject: TClassA;
begin
Result := TClassA.Create(true);
end;
Since you've now pushed the DoSomething execution into the constructor any exceptions will naturally automatically call the destructor and your memory management problems go away. The other answers also have good solutions.
I use the following code to change region data in the Registry.
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg:=TRegistry.Create;
try
reg.RootKey:=HKEY_CURRENT_USER;
reg.OpenKey('\Control Panel\International\',true);
reg.WriteString('iCountry','1');
reg.WriteString('iCurrDigits','2');
reg.WriteString('iCurrency','0');
reg.WriteString('iDate','1');
reg.WriteString('iDigits','2');
reg.WriteString('iLZero','0');
reg.WriteString('iMeasure','1');
reg.WriteString('iNegCurr','0');
reg.WriteString('iNegNumber','1');
reg.WriteString('iTimePrefix','0');
reg.WriteString('iTLZero','1');
reg.WriteString('Locale','00000409');
reg.WriteString('LocaleName','en-US');
reg.WriteString('sCountry','United States');
reg.WriteString('sDate','/');
reg.WriteString('sDecimal','.');
reg.WriteString('iNegCurr','0');
reg.WriteString('sShortDate','dd/MM/yyyy'); reg.CloseKey;
finally
reg.free;
end;
end;
but this requires restarting the machine before the changes take effect. Can it be done without rebooting?
After changing the Registry, broadcast a system-wide WM_SETTINGCHANGE message by calling SendMessageTimeout() with its hWnd set to HWND_BROADCAST:
Applications should send WM_SETTINGCHANGE to all top-level windows when they make changes to system parameters.
...
wParam
... When the system sends this message as a result of a change in locale settings, this parameter is zero.
When an application sends this message, this parameter must be NULL.
...
lParam
... When the system sends this message as a result of a change in locale settings, this parameter points to the string "intl".
For example:
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.Access := KEY_SET_VALUE;
if reg.OpenKey('\Control Panel\International\', true) then
try
reg.WriteString('iCountry','1');
reg.WriteString('iCurrDigits','2');
reg.WriteString('iCurrency','0');
reg.WriteString('iDate','1');
reg.WriteString('iDigits','2');
reg.WriteString('iLZero','0');
reg.WriteString('iMeasure','1');
reg.WriteString('iNegCurr','0');
reg.WriteString('iNegNumber','1');
reg.WriteString('iTimePrefix','0');
reg.WriteString('iTLZero','1');
reg.WriteString('Locale','00000409');
reg.WriteString('LocaleName','en-US');
reg.WriteString('sCountry','United States');
reg.WriteString('sDate','/');
reg.WriteString('sDecimal','.');
reg.WriteString('iNegCurr','0');
reg.WriteString('sShortDate','dd/MM/yyyy');
finally
reg.CloseKey;
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar('intl')), SMTO_NORMAL, 100, PDWORD(nil)^);
end;
finally
reg.free;
end;
end;
And before you ask, yes it is safe to use nil in the last parameter in this manner:
Passing nil to a variable parameter
Prior to XE2, Delphi's Windows unit declares the last parameter of SendMessageTimeout() as:
var lpdwResult: DWORD
But the Win32 API defines the parameter as:
_Out_opt_ PDWORD_PTR lpdwResult
Which allows a NULL pointer to be passed in. The above nil trick is the only way for Delphi code to pass a NULL value to a var parameter. The machine code generated by the compiler will be correct - it will simply pass a value of 0 to the parameter, it will not actually try access memory address $00000000.
In XE2, the Windows unit was changed to declare the last parameter as:
lpdwResult: PDWORD_PTR
To match the Win32 API definition.
So, if you ever upgrade your code to XE2 or later, simply replace PDWORD(nil)^ with nil instead. Or, you can account for it now and not worry about it later:
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar('intl')), SMTO_NORMAL, 100, {$IF RTLVersion >= 23}nil{$ELSE}PDWORD(nil)^{$IFEND});
I'd like to ask if anyone knows correct way how to load ntuser.dat file into registry on Windows7 or XP. I've been trying to accomplish that by using this code
_Reg := TRegistry.Create;
_Reg.RootKey := HKEY_USERS;
if (_Reg.Loadkey('Test2', 'C:\Users\Test2\NTUSER.DAT')) then
ShowMessage('User hive loaded');
_Reg.Unloadkey('Test2');
_Reg.CloseKey;
_Reg.Free;
Path to a file is correct and file exists. I've also tried to use function I found on the internet EnableNTPrivilege('SeRestorePrivilege', SE_PRIVILEGE_ENABLED) for setting up privileges before trying to load a hive. And still I get false from _Reg.Loadkey.
I've also tried to use this function NTSetPrivilege('SeRestorePrivilege', True) for setting up privileges. But this function returns error 'Not all privileges or groups referenced are assigned to the caller'
The TRegistry.LoadKey function internally uses the RegLoadKey function which requieres that the calling process have the SE_RESTORE_NAME and SE_BACKUP_NAME privileges. If the call to the function returns a value <> to ERROR_SUCCESS (0) you must check the LastError and the LastErrorMsg properties to get more info.
Check this sample to see how the function must be called and how the result of the operation is handled.
var
Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
NTSetPrivilege('SeRestorePrivilege', True); //this is a third-party function, you can implemnt your own to set the privileges.
NTSetPrivilege('SeBackupPrivilege', True);
Reg.RootKey := HKEY_USERS;
if (Reg.Loadkey('Test2', 'C:\Users\Test2\NTUSER.DAT')) then
begin
try
Reg.OpenKey('Test2', False);
try
//do your stuff here
finally
Reg.CloseKey;
end;
finally
Reg.Unloadkey('Test2');
end;
end
else
Writeln(Reg.LastErrorMsg);
finally
Reg.Free;
end;
end;
The correct way to load and manipulate a specific user's Registry hive is to having your calling thread impersonate that user (if the thread is not already running as that user) and then use RegOpenCurrentUser(), RegOpenUserClassesRoot(), and/or LoadUserProfile() as needed.