I am having one Delphi XE2 project to work something with registry key. So I have defined the following codes :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
RegistryEntry: TRegistry;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
RegistryEntry.RootKey:= HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists('Software\MyCompanyName\MyName\')) then
begin
RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
RegistryEntry.OpenKey('Software\MyCompanyName\MyName\',True);
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
Memo01.Lines.Add(RegistryEntry.ReadString('(Default)')); //Not Working
Memo01.Lines.Add(RegistryEntry.ReadString('')); //Not Working
Memo01.Lines.Add(RegistryEntry.ReadString('#')); //Not Working
end;
RegistryEntry.CloseKey();
RegistryEntry.Free;
end;
My requirement is to check the Default Value of "MyName" and to show in Memo01. But nothing is heppening. So I have tried another way as follows :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
RegistryEntry: TRegistry;
RegistryString: string;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
RegistryEntry.RootKey:= HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists('Software\MyCompanyName\MyName\')) then
begin
RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
RegistryEntry.OpenKey('Software\MyCompanyName\MyName\',True);
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
RegistryString := RegistryEntry.ReadString('(Default)'); //Not Working
RegistryString := RegistryEntry.ReadString(''); //Not Working
RegistryString := RegistryEntry.ReadString('#'); //Not Working
Memo01.Lines.Add(RegistryString);
end;
RegistryEntry.CloseKey();
RegistryEntry.Free;
end;
But it is also not working.
There is no Openkey in your else part.
Const
C_KEY='Software\MyCompanyName\MyName\';
var
RegistryEntry: TRegistry;
RegistryString: string;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
try
RegistryEntry.RootKey := HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists(C_KEY)) then
begin
RegistryEntry.Access := KEY_WRITE or KEY_WOW64_64KEY;
if RegistryEntry.OpenKey(C_KEY, true) then
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
RegistryEntry.Access := KEY_READ or KEY_WOW64_64KEY;
if RegistryEntry.OpenKey(C_KEY, false) then
begin
Memo01.Lines.Add(RegistryEntry.ReadString(''));
end;
end;
RegistryEntry.CloseKey();
finally
RegistryEntry.Free;
end;
end;
You might want to consider using HKEY_CURRENT_USER instead of HKEY_LOCAL_MACHINE.
In Vista/7/8, unless the program is run using administrator rights, you don't actually get HKEY_LOCAL_MACHINE, you get a virtualized location. Essentially, Windows gives you something only that user can see.
Using HKEY_LOCAL_MACHINE only leads to headaches later on. Windows has been locking that down.
Related
I would like to modernize the GUI of my Delphi 7 App, I have already .manifest file and it looks quite good, but the Fileopen dialogs are terrible. How the make them modern?
I am using this code at the moment.
What would it require to use e.g. IFileOpenDialog instead, how to compile the header for that, or any tweaks to dialogs.pas ?
FileOpenDialog := TOpenDialog.create(parent);
FileOpenDialog.DefaultExt := '*.x';
FileOpenDialog.Filter := 'my|*.x|Text File (CSV)|*.csv';
FileOpenDialog.options := [ofHideReadOnly,ofFileMustExist ,ofNoChangeDir,ofPathMustExist ];
if FileOpenDialog.Execute then begin
// do my tricks with FileOpenDialog.filename
FormUpdate;
end;
The following example code of IFileDialog cannot be compiled with D7:
var
FolderDialog : IFileDialog;
hr: HRESULT;
IResult: IShellItem;
FileName: PChar;
Settings: DWORD;
begin
if Win32MajorVersion >= 6 then
begin
hr := CoCreateInstance(CLSID_FileOpenDialog,
nil,
CLSCTX_INPROC_SERVER,
IFileDialog,
FolderDialog);
if hr = S_OK then
begin
FolderDialog.SetOkButtonLabel(PChar('Select'));
FolderDialog.SetTitle(PChar('Select a Directory'));
hr := FolderDialog.Show(Handle);
if hr = S_OK then
begin
hr := FolderDialog.GetResult(IResult);
if hr = S_OK then
begin
IResult.GetDisplayName(SIGDN_FILESYSPATH,FileName);
ConfigPathEdit.Text := FileName;
end;
end;
end;
end;
I used this one, I tested it with D7.
// uses commdlg
function OpenSaveFileDialog( Parent: TWinControl;
const DefExt,Filter,InitialDir,Title: string;
var FileName: string;
MustExist,OverwritePrompt,NoChangeDir,DoOpen: Boolean): Boolean;
var ofn: TOpenFileName;
szFile: array[0..MAX_PATH] of Char;
begin
Result := False;
FillChar(ofn, SizeOf(TOpenFileName), 0);
with ofn do
begin
lStructSize := SizeOf(TOpenFileName);
hwndOwner := Parent.Handle;
lpstrFile := szFile;
nMaxFile := SizeOf(szFile);
if (Title <> '') then
lpstrTitle := PChar(Title);
if (InitialDir <> '') then
lpstrInitialDir := PChar(InitialDir);
StrPCopy(lpstrFile, FileName);
lpstrFilter := PChar(StringReplace(Filter, '|', #0,[rfReplaceAll, rfIgnoreCase])+#0#0);
if DefExt <> '' then
lpstrDefExt := PChar(DefExt);
end;
if MustExist then
ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST;
if OverwritePrompt then
ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;
if NoChangeDir then
ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR;
if DoOpen
then begin
if GetOpenFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
else begin
if GetSaveFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR FilSelez : String;
begin
If OpenSaveFileDialog(Form1,'','*.*','c:\windows','',FilSelez,False,False,True,True) Then
Edit1.Text := FilSelez;
end;
Instead of using the IFileDialog interface you can also just modify Delphi's 7 Dialogs.pas file to display the "modern" dialogs.
First make a backup copy of the Dialogs.pas file in the Source\VCL folder under the Delphi installation directory. Then search the file for the term OFN_ENABLEHOOK. The complete line should be Flags := OFN_ENABLEHOOK;. Comment out the line. Add a new line Flags := 0; directly below.
Now search for the term OFN_ENABLETEMPLATE. Two lines above this should be an if Template <> nil then statement. Comment out this statement and all following ones up to and including hWndOwner := Application.Handle; and add the line hWndOwner := Screen.ActiveForm.Handle;.
Now make sure to replace the precompiled units Dialogs.dcu in the Lib and SLib directory under the Delphi installation directory with newly compiled Dialogs.dcu containing the changes. In the Lib directory you store a version without debug information, while the SLib directory contains a version with debug information. Make backup copies of the files before replacing them.
Please take note that the instructions given above only apply to Delphi 7. Furthermore, the code disables event handling for the common dialog components.
I am trying to export a registry key using either TRegistry.SaveKey or RegSaveKey functions with no luck. All I get is an empty file 0 bytes. I have seen examples online none seems to be working on Windows10.
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
reg.Access := KEY_ALL_ACCESS;
if reg.OpenKey('\Software\MyCompanyName\MyApplication\', True) then
begin
reg.WriteInteger('background', Self.Color);
reg.SaveKey('HKEY_CURRENT_USER\Software\MyCompanyName\MyApplication', 'test.txt'); //not working
RegSaveKey(reg.CurrentKey, 'test.reg', nil); //creates empty file
end;
reg.CloseKey;
reg.Free;
Also if I extract existing key from RegEdit and then try to load it in the application using TRegistry.LoadKey or RegLoadKey nothing is happening
I do have admin right on the machine I run this.
Anyone familiar with the issue?
From the documentation of RegSaveKey:
The calling process must have the SE_BACKUP_NAME privilege enabled.
My guess is that RegSaveKey returning a value other than ERROR_SUCCESS. which your code does not check.
See also:
RegSaveKey returns ERROR_PRIVILEGE_NOT_HELD
Another thing to check for is that the destination file does not exists before you try to save, or else the function will fail (this is also mentioned in the documentation), and obviously that you have write permissions to the file location.
Here is a working example.
Be aware that you must run the program as administrator.
program SO59753973;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Registry,
Windows,
System.SysUtils;
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
hToken: THandle;
TokenPriv: TOKEN_PRIVILEGES;
PrevTokenPriv: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
errval:Cardinal;
begin
Result := True;
errval:=0;
// Only for Windows NT/2000/XP and later.
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
Result := False;
// obtain the processes token
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
try
// Get the locally unique identifier (LUID) .
if LookupPrivilegeValue(nil, PChar(sPrivilege),TokenPriv.Privileges[0].Luid) then
begin
TokenPriv.PrivilegeCount := 1; // one privilege to set
case bEnabled of
True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
False: TokenPriv.Privileges[0].Attributes := 0;
end;
ReturnLength := 0; // replaces a var parameter
PrevTokenPriv := TokenPriv;
// enable or disable the privilege
if AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),PrevTokenPriv, ReturnLength) then
Result := True
else
begin
errval:= GetLastError;
Result := errval = 0;
end;
end;
finally
CloseHandle(hToken);
end;
// test the return value of AdjustTokenPrivileges.
//Result := GetLastError = ERROR_SUCCESS;
if not Result then
raise Exception.Create(SysErrorMessage(errval));
end;
var
Reg: TRegistry;
sKeyFileName: String;
begin
try
if not NTSetPrivilege('SeBackupPrivilege',true) then
Exit;
sKeyFileName := 'C:\temp\tempReg.reg';
if FileExists(sKeyFileName) then
DeleteFile(sKeyFileName);
Reg := TRegistry.Create(KEY_ALL_ACCESS);
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.SaveKey('\Software\Microsoft', sKeyFileName)
then
Writeln('Registry has been saved!')
else
Writeln('Failed to save registry, received error: ' + IntToStr(Reg.LastError) + '!');
finally
Reg.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
For restoring the registry, you must enable the SE_RESTORE_NAME in addition to the SE_BACKUP_NAME Privilege.
Code has been taken (and adapted) from this old forum post
I'm using Windows 10 and I am logged in as Administrator.
When I try to reboot the system, all it does is it logs me off.
ExitWindowsEx(EWX_REBOOT and EWX_FORCE, 0);
Can someone please tell me why is this not rebooting?
So it seems that even though I am a administrator I need to set the rights with the following function
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
hToken: THandle;
TokenPriv: TOKEN_PRIVILEGES;
PrevTokenPriv: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
begin
Result := True;
// Only for Windows NT/2000/XP and later.
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
Result := False;
// obtain the processes token
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
try
// Get the locally unique identifier (LUID) .
if LookupPrivilegeValue(nil, PChar(sPrivilege),
TokenPriv.Privileges[0].Luid) then
begin
TokenPriv.PrivilegeCount := 1; // one privilege to set
case bEnabled of
True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
False: TokenPriv.Privileges[0].Attributes := 0;
end;
ReturnLength := 0; // replaces a var parameter
PrevTokenPriv := TokenPriv;
// enable or disable the privilege
AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
PrevTokenPriv, ReturnLength);
end;
finally
CloseHandle(hToken);
end;
end;
// test the return value of AdjustTokenPrivileges.
Result := GetLastError = ERROR_SUCCESS;
if not Result then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
like this :
procedure TMain.Neustart1Click(Sender: TObject);
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
NTSetPrivilege(SE_SHUTDOWN_NAME, True);
ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0);
end;
Now it works.
I was looking for a better solution to the one I had done about 5 years ago (posted below), I needed to do some tweaking for it to run on latest Delphi, older Delphi versions simply use Windows.AdjustTokenPrivileges. Code below is tried and tested since windows XP. Be careful - it works, make sure you save your work before running!
//Uses WinApi.Windows on Latest Delphi 10.3.2
function MyExitWindows(RebootParam: Longword): Boolean;
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
tpResult := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd);
if tpResult then
begin
tpResult := LookupPrivilegeValue(nil,
SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid);
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg);
pcbtpPreviousRequired := 0;
if tpResult then
//Older Delphi - replace the WinApi. to read WinApi.AdjustTokenPrivileges
WinApi.Windows.AdjustTokenPrivileges(TTokenHd,
False,
TTokenPvg,
cbtpPrevious,
rTTokenPvg,
pcbtpPreviousRequired);
end;
end;
Result := ExitWindowsEx(RebootParam, 0);
end;
//Examples
//Shutdown the computer
MyExitWindows(EWX_POWEROFF or EWX_FORCE);
//Reboot the computer
MyExitWindows(EWX_REBOOT or EWX_FORCE);
I am using Kaspersky Internet Security 2018. But when I compile my Delphi application with these codes, my anti-virus application will remove the compiled exe:
function BrowseForFolder(var dpFolder: String; dpTitle: String): Boolean;
var
dpBrowseInfo: TBrowseInfo;
dpDisplayName: array[0..255] of Char;
dpItemIDList: PItemIDList;
begin
FillChar(dpBrowseInfo, sizeof(dpBrowseInfo), #0);
with dpBrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := #dpDisplayName[0];
lpszTitle := PChar(dpTitle);
dpItemIDList := SHBrowseForFolder(dpBrowseInfo);
ulFlags := BIF_RETURNONLYFSDIRS and BIF_VALIDATE;
end;
if Assigned(dpItemIDList) then begin
if SHGetPathFromIDList(dpItemIDList, dpDisplayName) then begin
dpFolder := dpDisplayName;
Result := True;
end else begin
Result := False;
end;
end;
end;
What should I do to pop up "Browse folder" menu other than adding my app to whitelist?
I have tried every "Browse Folder" dialog types and I have realized that my anti-virus software only allows Vcl.FileCtrl.TSelectDirExtOpt (also it hates other FileCtrl dialogs).
So, I fixed my issue myself like this:
procedure TForm1.gözatDüğmesiClick(Sender: TObject);
begin
if not (menü4CB = '1') then begin
if not (SelectDirectory('Kurulum programının yedekleneceği klasörü seçin',
GetSpecialFolderPathFromCSIDL($0011), adres, [sdNewFolder, sdNewUI], nil) = False) then begin
adresÇubuğu.Text := adres;
end else begin
end;
end;
end;
Thank Remy Lebeau anyway for caring about me.
Using the code below I try to set a value in the HKEY_LOCAL_MACHINE section of registry but I get an error 'Failed to set data for.....'
If I use HKEY_CURRENT_USER there is no problem.
What might I be missing here.
(The code is not complete, but I think it is the important parts of it)
type
TTypWinBits = (Bit32, Bit64);
function WinBits: TTypWinBits;
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
hKernel32 : Integer;
IsWow64Process : TIsWow64Process;
IsWow64 : BOOL;
begin
Result := Bit32;
hKernel32 := LoadLibrary('kernel32.dll');
if (hKernel32 = 0) then RaiseLastOSError;
#IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
if Assigned(IsWow64Process) then
begin
IsWow64 := False;
if (IsWow64Process(GetCurrentProcess, IsWow64)) then
Result := Bit64
else
RaiseLastOSError;
end;
FreeLibrary(hKernel32);
end;
function TFastRegistry.CreateConnection: TRegistry;
begin
Result := TRegistry.Create;
try
case WinBits of
Bit32: Result := TRegistry.Create;
Bit64: Result := TRegistry.Create(KEY_WRITE OR KEY_WOW64_64KEY);
end;
except
on E: exception do
Result := nil;
end;
end;
procedure TFastRegistry.RunAdd(aDesc, aName: string);
var
Reg: TRegistry;
sRegKey: String;
begin
sRegKey := 'Software\Microsoft\Windows\CurrentVersion\Run';
Reg := CreateConnection;
with Reg do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if not KeyExists(sRegKey) then
OpenKey(sRegKey, True)
else
OpenKey(sRegKey, False);
WriteString(aDesc, aName);
finally
CloseKey;
Free;
end;
end;
end;
A program requires elevated privileges to write to the local-machine key. Without that, functions will fail, as you've observed. If your program is supposed to be an administrative tool, then use a manifest file so the OS will prompt for permission. If you don't need that, then write to the current-user key instead so it doesn't affect all accounts on the system.
You just need to release the handle by the "Free" and for the next entry in the register to recreate it, and not keep it permanently set up and open and close them through OpenKey and CloseKey! It looks like a bug :-)