Launch Windows Optimize application (Windows 10) from Delphi - windows

We have a legacy Delphi 7 application that launches the Windows Defrag and On-screen Keyboard applications as follows:
// Defragmentation application
ShellExecute(0, 'open', PChar('C:\Windows\System32\dfrg.msc'), nil, nil, SW_SHOWNORMAL);
// On-screen keyboard
ShellExecute(0, 'open', PChar('C:\Windows\System32\osk.exe'), nil, nil, SW_SHOWNORMAL);
Both work on Windows XP but fail on Windows 10. I spotted that the defragmentation application has had a name change to dfrgui.exe, but updating the code does not help. The On-screen Keyboard is still called osk.exe on Windows 10.
Both applications can be launched manually / directly from the command line or by double-clicking them in Windows Explorer.
My suspicion is that Windows security is preventing my application from launching anything from C:\Windows\System32, because I can launch several other applications from Program Files and from C:\Windows.
Can anyone help?

Delphi 7 produces only 32-bit apps, there is no option to produce 64-bit apps (that was added in XE2).
Accessing a path under %WINDIR%\System32 from a 32-bit app running on a 64-bit system is subject to WOW64's File
System Redirector, which will silently redirect requests for the 64-bit System32 folder to the 32-bit SysWOW64 folder instead.
Chances are, the apps you are trying to run only exist in the 64-bit System32 folder and not in the 32-bit SysWOW64 folder.
To avoid redirection, you need to either:
replace System32 with the special Sysnative alias in your paths (ie 'C:\Windows\Sysnative\osk.exe'), which only works when running under WOW64, so you have to detect that dynamically at runtime via IsWow64Process():
function GetSystem32Folder: string;
var
Folder: array[0..MAX_PATH] of Char;
IsWow64: BOOL;
begin
Result := '';
if IsWow64Process(GetCurrentProcess(), #IsWow64) and IsWow64 then
begin
SetString(Result, Folder, GetWindowsDirectory(Folder, Length(Folder)));
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result) + 'Sysnative' + PathDelim;
end else
begin
SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result);
end;
end;
function RunDefrag: Boolean;
var
SysFolder: string;
Res: Integer;
begin
SysFolder := GetSystem32Folder;
Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
if Res = ERROR_FILE_NOT_FOUND then
Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
Result := (Res = 0);
end;
function RunOnScreenKeyboard: Boolean;
begin
Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
end;
temporarily disable the Redirector via Wow64DisableWow64FsRedirection(), and then re-enable it via Wow64RevertWow64FsRedirection() when done:
function GetSystem32Folder: string
var
Folder: array[0..MAX_PATH] of Char;
begin
SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result);
end;
function RunDefrag: Boolean;
var
SysFolder: string;
OldState: Pointer;
Res: Integer;
begin
Wow64DisableWow64FsRedirection(#OldState);
try
SysFolder := GetSystem32Folder;
Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
if Res = ERROR_FILE_NOT_FOUND then
Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
Result := Res = 0;
finally
Wow64RevertWow64FsRedirection(OldState);
end;
end;
function RunOnScreenKeyboard: Boolean;
var
OldState: Pointer;
begin
Wow64DisableWow64FsRedirection(#OldState);
try
Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
finally
Wow64RevertWow64FsRedirection(OldState);
end;
end;
Update: that being said, it turns out that a 32-bit process running under WOW64 is not allowed to run osk.exe when UAC is enabled:
Delphi - On Screen Keyboard (osk.exe) works on Win32 but fails on Win64
So, you will have to create a helper 64-bit process to launch osk.exe on your app's behalf when it is running under WOW64.

A small addition to Remy Lebeau's answer:
If Wow64DisableWow64FsRedirection is not available in your Delphi version, and/or if you are not sure if your target platform will support this API, you could use following code sample that calls the function dynamically:
https://www.delphipraxis.net/155861-windows-7-64bit-redirection.html
function ChangeFSRedirection(bDisable: Boolean): Boolean;
type
TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
TWow64EnableWow64FsRedirection = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
var
hHandle: THandle;
Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
Wow64EnableWow64FsRedirection: TWow64EnableWow64FsRedirection;
Wow64FsEnableRedirection: LongBool;
begin
Result := false;
try
hHandle := GetModuleHandle('kernel32.dll');
#Wow64EnableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection');
#Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');
if bDisable then
begin
if (hHandle <> 0) and (#Wow64DisableWow64FsRedirection <> nil) then
begin
Result := Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
end;
end else
begin
if (hHandle <> 0) and (#Wow64EnableWow64FsRedirection <> nil) then
begin
Result := Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
Result := True;
end;
end;
Except
end;
end;

Related

Capturing Dos Window Progress

I am using the code at the end of my question for capturing outputs of dos applications.
I trying to capture output of the 7z.exe command below:
7z.exe x -y "C:\Linux.iso" -o"E:\"
7z.exe is showing a progress at the end of its dos window like %14.., %15..., %16... But it is not adding new lines for each progress. It is updating the last line of the dos output window. So the last line of the dos window changes like %14.., %15.., .. and 100%.
I am unable to capture this %14.., %15, %16.. progress. I am trying to find a solution for days. How can I capture this progress texts?
--
Note: The code is working and capturing the output great with the commands like ping:
ping 127.0.0.1
The problem is capturing the dos window's output which is not adding a new line, updating a line.
// Source: https://thundaxsoftware.blogspot.com/2012/12/capturing-console-output-with-delphi.html#comment-form_7827048960744956444
//
// #Author: Jordi Corbilla
// (c) Copyright by Jordi Corbilla.
// Anonymous procedure approach by Lars Fosdal
type
TArg<T> = reference to procedure(const Arg: T);
procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWORD;
dRunning: DWORD;
dAvailable: DWORD;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := true;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
try
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), #saSecurity, #saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
piProcess) then
try
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
PeekNamedPipe(hRead, nil, 0, nil, #dAvailable, nil);
if (dAvailable > 0) then
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToCharA(pBuffer, dBuffer);
CallBack(dBuffer);
until (dRead < CReadBuffer);
Application.ProcessMessages;
until (dRunning <> WAIT_TIMEOUT);
finally
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
finally
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;

How to get appdata folder path in delphi

How can I get the appdata folder path? This is my code:
begin
Winexec(PAnsichar('%appdata%\TEST.exe'), sw_show);
end;
but not working.
You cannot pass environment variables to WinExec(). You have to resolve them first, eg:
uses
..., SysUtils;
function GetPathToTestExe: string;
begin
Result := SysUtils.GetEnvironmentVariable('APPDATA');
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result) + 'TEST.exe';
end;
uses
..., Windows;
var
Path: string;
begin
Path = GetPathToTestExe;
if Path <> '' then
WinExec(PAnsiChar(Path), SW_SHOW);
end;
Alternatively:
uses
..., SysUtils, Windows;
function GetPathToTestExe: string;
var
Path: array[0..MAX_PATH+1] of Char;
begin
if ExpandEnvironmentStrings('%APPDATA%', Path, Length(Path)) > 1 then
Result := IncludeTrailingPathDelimiter(Path) + 'TEST.exe'
else
Result := '';
end;
A more reliable (and official) way to get the APPDATA folder path is to use SHGetFolderPath() (or SHGetKnownFolderPath() on Vista+) instead, eg:
uses
..., SysUtils, Windows, SHFolder;
function GetPathToTestExe: string;
var
Path: array[0..MAX_PATH] of Char;
begin
if SHGetFolderPath(0, CSIDL_APPDATA, 0, SHGFP_TYPE_CURRENT, Path) = S_OK then
Result := IncludeTrailingPathDelimiter(Path) + 'TEST.exe'
else
Result := '';
end;
Alternatively:
uses
..., SysUtils;
function GetPathToTestExe: string;
var
Path: string;
begin
// GetHomePath() uses SHGetFolderPath(CSIDL_APPDATA) internally...
Path := SysUtils.GetHomePath;
if Path <> '' then
Result := IncludeTrailingPathDelimiter(Path) + 'TEST.exe'
else
Result := '';
end;
But, in any case, WinExec() has been deprecated since Windows 95, you really should be using CreateProcess() instead, eg:
uses
..., Windows;
var
Path: String;
si: TStartupInfo;
pi: TProcessInformation;
Path := GetPathToTestExe;
if Path <> '' then
begin
ZeroMemory(#si, SizeOf(si));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := SW_SHOW;
if CreateProcess(nil, PChar(Path), nil, nil, FALSE, 0, nil, nil, #si, pi)
begin
//...
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
end;
end;
The proper way to do it, using System.IOUtils:
function GetAppDataFolder: string; { Returns the path to the current user's AppData folder on Windows and to the current user's home directory on Mac OS X. Example: c:\Documents and Settings\Bere\Application Data\AppName\ }
begin
Assert(System.IOUtils.TPath.HasValidFileNameChars(AppName, FALSE), 'Invalid chars in AppName: '+ AppName);
Result:= Trail(Trail(System.SysUtils.GetHomePath)+ AppName);
end;
Utils:
function ForceAppDataFolder: string; // Make sure the AppDataFolder exists before you try to write the INI file there!
begin
Result:= GetAppDataFolder;
ForceDirectories(Result);
end;
function Trail(CONST Path: string): string; //ok Works with UNC paths
begin
if Path= '' then EXIT(''); { Encountered when doing something like this: ExtractLastFolder('c:\'). ExtractLastFolder will return '' }
Result:= IncludeTrailingPathDelimiter(Path)
end;
SHGetKnownFolderPath
program Project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes;
function SHGetKnownFolderPath(const rfid: TGuid; dwFlags: DWORD; hToken: THandle; out ppszPath: PWideChar): HRESULT; stdcall; external 'shell32.dll' name 'SHGetKnownFolderPath';
const
localAppdataGuid: TGuid = '{F1B32785-6FBA-4FCF-9D55-7B8E7F157091}';
var
ppszPath: PWideChar;
begin
SHGetKnownFolderPath(localAppdataGuid, 0, 0, ppszPath);
Writeln(string(ppszPath));
Readln;
end.
for another folder guid KNOWNFOLDERID

How to permanently terminate Windows Explorer (the "explorer.exe" process)?

I'm using the following code to terminate a process:
function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
The problem is, when I call the above function in order to permanently terminate the explorer.exe, the Windows Explorer terminates though, but it's re-started afterwards:
KillTask('explorer.exe');
I'm using Delphi XE3, Delphi 7 and Windows 8.
Based on this Exit Explorer feature and code debugged by Luke in this post you may try to use the following code:
Warning:
This way is absolutely undocumented! So all constants and variables appearing in this post are fictitious. Any resemblance to real, documented code is purely coincidental :-)
function ExitExplorer: Boolean;
var
TrayHandle: HWND;
const
WM_EXITEXPLORER = $5B4;
begin
Result := False;
TrayHandle := FindWindow('Shell_TrayWnd', nil);
if TrayHandle <> 0 then
Result := PostMessage(TrayHandle, WM_EXITEXPLORER, 0, 0);
end;
I've tested it in Windows 7, where it works and doesn't even need the administrator elevation. Don't know how about the other systems (I'd say this won't work at least on Windows XP, but it's just a guess).

How to set a Windows folder's permissions using SID's in Delphi

Just now I'm looking at fixing a localization bug with a small application that get's fired during the install of a software package. The small application essentially brute forces permissions on our own folder within Application Data to set EVERYONE to full access.
The problem arises with EVERYONE not being localized. I know I need to use SID's, which for EVERYONE, is S-1-1-0. I can't find a WinAPI function for setting permissions using an SID.
The function just now uses BuildExplicitAccessWithName and SetNamedSecurityInfo as shown below
function setfullaccess(foldername:string):boolean; //B2415 MDE
var
pDACL: PACL;
pEA: PEXPLICIT_ACCESS_A;
R: DWORD;
begin
result := true;
pEA := AllocMem(SizeOf(EXPLICIT_ACCESS));
BuildExplicitAccessWithName(pEA, 'EVERYONE', GENERIC_ALL{GENERIC_READ},GRANT_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT{NO_INHERITANCE});
R := SetEntriesInAcl(1, pEA, nil, pDACL);
if R = ERROR_SUCCESS then
begin
if SetNamedSecurityInfo(pchar(foldername), SE_FILE_OBJECT,DACL_SECURITY_INFORMATION, nil, nil, pDACL, nil) <> ERROR_SUCCESS then result := false;
LocalFree(Cardinal(pDACL));
end
else result := false;//ShowMessage('SetEntriesInAcl failed: ' + SysErrorMessage(R));
end;
Which functions should I be looking at using instead?
After some searching through the WinAPI documentation I went for the solution below. Essentially I use the SID to lookup the "readable" name and then use that. It won't be the most elegant solution but it works for me.
procedure TTestform.Button4Click(Sender: TObject);
var
Sid: PSID;
peUse: DWORD;
cchDomain: DWORD;
cchName: DWORD;
Name: array of Char;
Domain: array of Char;
pDACL: PACL;
pEA: PEXPLICIT_ACCESS_A;
R: DWORD;
foldername: String; //Temp to hardcode
begin
foldername := 'C:\TEMP'; //Temp to hardcode
Sid := nil;
Win32Check(ConvertStringSidToSidA(PChar('S-1-1-0'), Sid));
cchName := 0;
cchDomain := 0;
//Get Length
if (not LookupAccountSid(nil, Sid, nil, cchName, nil, cchDomain, peUse)) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
begin
SetLength(Name, cchName);
SetLength(Domain, cchDomain);
if LookupAccountSid(nil, Sid, #Name[0], cchName, #Domain[0], cchDomain, peUse) then
begin
pEA := AllocMem(SizeOf(EXPLICIT_ACCESS));
BuildExplicitAccessWithName(pEA, PChar(Name), GENERIC_ALL{GENERIC_READ},GRANT_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT{NO_INHERITANCE});
R := SetEntriesInAcl(1, pEA, nil, pDACL);
if R = ERROR_SUCCESS then
begin
if SetNamedSecurityInfo(pchar(foldername), SE_FILE_OBJECT,DACL_SECURITY_INFORMATION, nil, nil, pDACL, nil) <> ERROR_SUCCESS then ShowMessage('SetNamedSecurityInfo failed: ' + SysErrorMessage(GetLastError));
LocalFree(Cardinal(pDACL));
end
else ShowMessage('SetEntriesInAcl failed: ' + SysErrorMessage(R));
end;
end;
end;
Alternative approach to avoid using both lookup and build
var SID: JwaWinNT.PSid; // JWA clashes with Delphi XE2 Windows.Windows.PSID type
pDACL: PACL;
EA: EXPLICIT_ACCESS;
SID_DATA: array[1..SECURITY_MAX_SID_SIZE] of byte;
SID_DATA_SIZE: DWORD;
SID_DATA_SIZE := Length(SID_DATA);
Pointer(SID) := #SID_DATA; // #SID_DATA[Low(SID_DATA)] for non-static arrays
pDACL := nil;
// if ConvertStringSidToSid(Auth_Users_SID, SID) then
if CreateWellKnownSid(WinAuthenticatedUserSid, nil, SID, SID_DATA_SIZE) then
try
EA.grfInheritance := SUB_CONTAINERS_AND_OBJECTS_INHERIT; // NO_INHERITANCE; // 0
EA.grfAccessMode := GRANT_ACCESS;
EA.grfAccessPermissions := GENERIC_ALL;
EA.Trustee.MultipleTrusteeOperation := NO_MULTIPLE_TRUSTEE;
EA.Trustee.pMultipleTrustee := nil;
EA.Trustee.TrusteeType := TRUSTEE_IS_WELL_KNOWN_GROUP;
EA.Trustee.TrusteeForm := TRUSTEE_IS_SID;
EA.Trustee.ptstrName := pointer(SID);
if ERROR_SUCCESS = SetEntriesInAcl(1, #EA, nil, pDACL) then begin
// optional creation of PATH and 0-bytes dummy file skipped
SetNamedSecurityInfo(pchar(foldername), SE_FILE_OBJECT, .... {see the author's answer above }
end;
finally
LocalFree(pDACL); // SID is not allocated on heap - no need to free it
end;
This snippet can also be checked against the unit at page #2 at http://forum.vingrad.ru/forum/topic-374131/0.html#st_15_view_0

How can I read 64-bit registry key from a 32-bit process?

I've been using the value of key MachineGuid from HKEY_LOCAL_MACHINE\Software\Microsoft\Cryptography to uniquely identify hosts, but from 32-bit processes running on 64-bit computers, the value appears to be missing. I guess it's searching under Wow6432Node, where it is indeed missing. According to this you should be able to get to the right key by adding a flag, but below code still doesn't appear to do the job. What am I missing?
const
KEY_WOW64_64KEY=$0100;
var
r:HKEY;
s:string;
i,l:integer;
begin
//use cryptography machineguid, keep a local copy of this in initialization?
l:=40;
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar('Software\Microsoft\Cryptography'),
0,KEY_QUERY_VALUE,r)=ERROR_SUCCESS then
begin
SetLength(s,l);
if RegQueryValue(r,'MachineGuid',PChar(s),l)=ERROR_SUCCESS then
begin
SetLength(s,l);
RegCloseKey(r);
end
else
begin
//try from-32-to-64
RegCloseKey(r);
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar('Software\Microsoft\Cryptography'),
0,KEY_QUERY_VALUE or KEY_WOW64_64KEY,r)=ERROR_SUCCESS then
begin
l:=40;
if RegQueryValue(r,'MachineGuid',PChar(s),l)=ERROR_SUCCESS then
SetLength(s,l)
else
l:=0;
RegCloseKey(r);
end;
end;
end;
I would suggest you use the IsWow64Process() function to know when you are a 32-process running on a 64-bit OS, and then only apply the KEY_WOW64_64KEY flags in that specific condition. If the app is a 32-bit process on a 32-bit OS, or a 64-bit process on a 64-bit OS, the flags is not needed.
For example:
const
KEY_WOW64_64KEY = $0100;
var
key: HKEY;
str: string;
len: DWORD;
flag: REGSAM;
wow64: BOOL;
begin
flag := 0;
wow64 := 0;
IsWow64Process(GetCurrentProcess(), #wow64);
if wow64 <> 0 then flag := KEY_WOW64_64KEY;
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Cryptography', 0, KEY_QUERY_VALUE or flag, key) = ERROR_SUCCESS then
try
SetLength(str, 40);
len := Length(str) * SizeOf(Char);
if RegQueryValueEx(key, 'MachineGuid', nil, nil, PByte(Pointer(s)), #len) <> ERROR_SUCCESS then len := 0;
SetLength(str, len div SizeOf(Char));
finally
RegCloseKey(key);
end;
end;
Your code is needlessly complex, largely because you are not taking advantage of the built-in TRegistry class which shields you from all the complexities of the low-level registry API. For example, consider the following code:
type
TRegistryView = (rvDefault, rvRegistry64, rvRegistry32);
function RegistryViewAccessFlag(View: TRegistryView): LongWord;
begin
case View of
rvDefault:
Result := 0;
rvRegistry64:
Result := KEY_WOW64_64KEY;
rvRegistry32:
Result := KEY_WOW64_32KEY;
end;
end;
function ReadRegStr(const Root: HKEY; const Key, Name: string;
const View: TRegistryView=rvDefault): string;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create(KEY_READ or RegistryViewAccessFlag(View));
try
Registry.RootKey := Root;
if not Registry.OpenKey(Key) then
raise ERegistryException.CreateFmt('Key not found: %s', [Key]);
if not Registry.ValueExists(Name) then
raise ERegistryException.CreateFmt('Name not found: %s\%s', [Key, Name]);
Result := Registry.ReadString(Name);//will raise exception in case of failure
finally
Registry.Free;
end;
end;
The function ReadRegStr will return the string value named Name from the key Key relative to the root key Root. If there is an error, for example if the key or name do not exists, or if the value is of the wrong type, then an exception will be raised.
The View parameter is an enumeration that makes it simple for you to access native, 32-bit or 64-bit views of the registry. Note that native means native to the process that is running. So it will be the 32-bit view for a 32-bit process and the 64-bit view for a 64-bit process. This enumeration mirrors the equivalent definition in .net.
In my use of this registry key I went a step further. If the value didn't exist I created it: not in HKEY_LOCAL_MACHINE, that would require elevation, but in HKEY_CURRENT_USER. Anyone seeing the introduced key there is unlikely to realise that it's a dummy.
function GetComputerGUID: String;
var
Reg: TRegistry;
oGuid: TGUID;
sGuid: String;
begin
Result := '';
// Attempt to retrieve the real key
Reg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Cryptography') and Reg.ValueExists('MachineGuid') then
Result := Reg.ReadString('MachineGuid');
Reg.CloseKey;
finally
Reg.Free;
end;
// If retrieval fails, look for the surrogate
if Result = '' then begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('SOFTWARE\Microsoft\Cryptography', True) then begin
if Reg.ValueExists('MachineGuid') then
Result := Reg.ReadString('MachineGuid')
else begin
// If the surrogate doesn't exist, create it
if CreateGUID(oGUID) = 0 then begin
sGuid := Lowercase(GUIDToString(oGUID));
Reg.WriteString('MachineGuid', Copy(sGuid, 2, Length(sGUID) - 2));
Result := Reg.ReadString('MachineGuid');
end;
end;
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;
if Result = '' then
raise Exception.Create('Unable to access registry value in GetComputerGUID');
end;
That's a good point from #Remy Lebeau - TeamB though; I should mod the above code appropriately.
Call reg.exe using this path
C:\Windows\sysnative\reg.exe
For example:
C:\Windows\sysnative\reg.exe QUERY "HKLM\SOFTWARE\JavaSoft\JDK" /v CurrentVersion
source: https://stackoverflow.com/a/25103599

Resources