I am having one Delphi XE2 Project for Windows Registry Operation. I need to delete all subnodes under **HKEY_CLASSES_ROOT\CLSID\{00000000-0000-0000-0000-000000000001}** , so I have defined the following codes :
function SHDeleteKey(key: HKEY; SubKey: PWideChar): Integer; stdcall; external 'shlwapi.dll' name 'SHDeleteKeyW';
..
..
..
..
..
procedure TMainForm.BitBtn02Click(Sender: TObject);
var
RegistryEntry : TRegistry;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
RegistryEntry.RootKey := HKEY_CLASSES_ROOT;
if (RegistryEntry.KeyExists('CLSID\{00000000-0000-0000-0000-000000000001}\')) then
begin
Memo01.Font.Color := 3992580;
Memo01.Lines.Add('Windows Registry Entry Has Been Found In Your System');
RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
SHDeleteKey(HKEY_CLASSES_ROOT, PWideChar('CLSID\{00000000-0000-0000-0000-000000000001}'));
RegistryEntry.CloseKey();
RegistryEntry.Free;
Memo01.Font.Color := 16756480;
Memo01.Lines.Add('Windows Registry Entry Has Been Deleted Successfully');
end
else
begin
Memo01.Font.Color := 7864575;
Memo01.Lines.Add('Windows Registry Entry Has Not Been Found In Your System');
end;
end;
But nothing is happening. Then I have tried
function SHDeleteKey(key: HKEY; SubKey: PChar): Integer; stdcall; external 'shlwapi.dll';
but here is another problem is telling "Entry Point not found".
Your function import is failing because the function is named SHDeleteKeyW where the W specifies that you want to use Unicode characters. So your function declaration should be
function SHDeleteKey(hKey: HKEY; pszSubKey: PWideChar): Integer; stdcall;
external 'shlwapi.dll' name 'SHDeleteKeyW';
Once that is fixed, the two most common failure modes are:
Your process does not have admin rights.
Your process runs in a 32 bit process on a 64 bit system and so cannot see the 64 bit view of the registry.
Based on your earlier question, option 2 seems most likely.
You said "nothing is happening", but I'm sure something is happening. The function is failing and returning an error status to you. But you did not check the return value of the call to SHDeleteKey. Whenever you call a Windows API, check the return value. If it fails, the return value allows you to diagnose that failure.
Assuming the issue is the registry redirector for your 32 bit process, your options include:
Run the code from a 64 bit process.
Use RegDeleteTree.
Empty the key's subkeys first, and then use TRegistry.DeleteKey.
Note that the code where you specify KEY_WOW64_64KEY only has effect when using the TRegistry methods. Since SHDeleteKey is a Windows API function, it is independent from that class.
For your second problem, you may want to try ShDeleteKeyW instead (explicitly selecting the wide string variant).
In both cases, however, you should check the result to see why it failed.
You don't mention what O/S this is on but there appears to be several platform-specific quirks with this function as can be seen in the comments here.
Related
In old Delphi applications which use the old and deprecated but still used BDE database engine with Paradox database files residing on a Windows 10 computer that's updated to the 1803 "Spring Creators Update" version, but the client computers using any older version of Windows like Windows 10 1709 or Windows 7, opening a Paradox table sometimes fails with a "No more files" error, idapi32.dll error code DBIERR_OSENMFILE. This raises a EDBEngineError exception in DBTables.pas / TTable.GetHandle(), which is called by TTable.CreateHandle, called by TBDEDataSet.OpenCursor().
The error seems to be caused by some file-sharing related changes in the Windows 10 1803 update. Removing the 1803 update from the file-sharing Windows 10 computer, or updating all the client computers to Windows 10 + 1803 seems to make the error go away.
People have speculated that the changes have something to do with the SMB protocol, maybe Windows Defender and/or other security related issues. Here's a Google Plus discussion
https://plus.google.com/106831056534874810288/posts/F4nsoTz2pDi
How could the "No more files" error be worked around by some reasonably easily doable changes in the Delphi application, while allowing the file-sharing client and server computers to keep using heterogeneous Windows versions?
Please try to refrain from answering or commenting self-evident things like "the sky is blue" or "BDE is old and deprecated". Keeping BDE is a decision that cannot be changed, certainly not as a "bug fix".
As an emergency fix, we have resorted to simply re-trying DbiOpenTable, when it returns the DBIERR_OSENMFILE error code. I posted an answer with source code to the idapi32.dll hack. So far it seems that if the first DbiOpenTable says "No more files", the second try succeeds, and the application works without noticing anything.
WARNING: what follows is a hack. A kludge. Band-aid, glue, duct tape and chewing gum. BDE is old. You are completely on your own if you use BDE and/or if you try this hack. I accept no responsibility over its use. If it works for you, good for you. If it ruins your business, bad for you.
Since the Paradox tables still mostly worked and the error seemed to be slightly randomly triggered, and since someone suspected Windows Defender having something to do with it, I thought maybe it just needs some kicking around. If DbiOpenTable() suddenly starts sometimes failing over a certain combination of SMB client/server versions, because "No more files" ... then why not just try the file operation again. I put an "if it returns a DBIERR_OSENMFILE error, then Sleep() and try again" logic around the DbiOpenTable function, and guess what - it seemed to work.
Hacking around the BDE's "features" is familiar to anyone who has to maintain BDE based applications. So I made a patching hook around idapi32.dll's DbiOpenTable function, starting from an old routine written by Reinaldo Yañez originally to fix the "insufficient disk space" error with BDE when the free disk space is at a 4 GB boundary. See https://cc.embarcadero.com/Item/21475
To use this, add Fix1803 in a uses clause, and call PatchBDE somewhere before starting to open Paradox tables. Maybe call UnPatchBDE when you're done, though I don't think that's necessary.
But remember, you're on your own, and this is highly experimental code.
unit Fix1803;
// * KLUDGE WARNING *
// Patch (hack) idapi32.dll DbiOpenTable() to try harder, to work with Windows 10 1803 "Spring Creators Update".
//
// The patching routine is an extension of code originally written by Reinaldo Yañez.
// see https://cc.embarcadero.com/Item/21475
//
// Some original Spanish comments are left in place.
interface
procedure PatchBDE;
procedure UnPatchBDE;
implementation
uses
Windows, Db, DbTables, BDE, SysUtils;
// ------------------------------------------- DbiOpenTable hook
var DbiOpenTable_address_plus_9 : Pointer;
function Actual_DbiOpenTable_CallStub(hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall; assembler;
asm
// these two instructions are implicitly contained in the start of the function
// push ebp
// mov ebp, esp
add esp, $fffffee8
jmp dword ptr [DbiOpenTable_address_plus_9]
end;
function LogHook_DbiOpenTable (hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall;
var
i : Integer;
begin
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
// if we got the "No more files" error, try again... and again.
i := 1;
while (Result = DBIERR_OSENMFILE) and (i < 10) do
begin
Windows.Sleep(i);
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
Inc(i);
end;
end;
// ------------------------------------------- Patching routines
const // The size of the jump instruction written over the start of the original routine is 5 bytes
NUM_BYTES_OVERWRITTEN_BY_THE_PATCH = 5;
type
TRYPatch = record
OrgAddr: Pointer;
OrgBytes: array[0..NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1] of Byte;
end;
procedure TRYPatch_Clear(var ARYPatch : TRYPatch);
begin
FillChar(ARYPatch, SizeOf(TRYPatch), 0);
end;
function RedirectFunction(OldPtr, NewPtr, CallOrigStub : Pointer; var OriginalRoutineAddressPlusN: Pointer; NumBytesInCompleteInstructionsOverwritten : Integer): TRYPatch;
type
PPtr=^pointer;
PPPtr=^PPtr;
TByteArray=array[0..maxint-1] of byte;
PByteArray=^TByteArray;
function SameBytes(Ptr1, Ptr2 : Pointer; NumBytes : Integer) : Boolean;
var
i : Integer;
begin
Result := true;
i := 0;
while (Result) and (i < NumBytes) do
begin
Result := Result and ((PByteArray(Ptr1)^[i] = PByteArray(Ptr2)^[i]));
Inc(i);
end;
end;
var
PatchingAddress : Pointer;
OldProtect,
Protect : DWORD;
p: PByteArray;
i : Integer;
begin
PatchingAddress := OldPtr;
if PWord(PatchingAddress)^ = $25FF then
begin {Es un JMP DWORD PTR [XXXXXXX](=> Esta utilizando Packages)}
p := PatchingAddress;
PatchingAddress := (PPPtr(#p[2])^)^; // PatchingAddress now points to the start of the actual original routine
end;
// Safety check (as if this thing was "safe"). The given replacement routine must start with the same bytes as the replaced routine.
// Otherwise something is wrong, maybe a different version of idapi32.dll or something.
if (CallOrigStub <> nil) and not SameBytes(PatchingAddress, CallOrigStub, NumBytesInCompleteInstructionsOverwritten) then
raise Exception.Create('Will not redirect function, original call stub doesn''t match.');
// Change memory access protection settings, so we can change the contents
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
// Save the old contents of the first N bytes of the routine we're hooking
Result.OrgAddr := PatchingAddress; // Save the address of the code we're patching (which might not be the same as the original OldPtr given as parameter)
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
result.OrgBytes[i] := PByte(Integer(PatchingAddress) + i)^;
// Replace the first bytes of the original function with a relative jump to the new replacement hook function
// First write the instruction opcode, $E9 : JMP rel32
PByte(PatchingAddress)^:= $E9;
// Then write the instruction's operand: the relative address of the new function
PInteger(Integer(PatchingAddress)+1)^ := Integer(NewPtr) - Integer(PatchingAddress) - 5;
// Address to jump to, for the replacement routine's jump instruction
OriginalRoutineAddressPlusN := Pointer(Integer(PatchingAddress) + NumBytesInCompleteInstructionsOverwritten);
// Restore the access protection settings
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
procedure RestorePatch(RestorePatch: TRYPatch);
var
OldProtect,
Protect : DWORD;
OldPtr: Pointer;
i : Integer;
begin
OldPtr := RestorePatch.OrgAddr;
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
PByte(Integer(OldPtr) + i)^ := RestorePatch.OrgBytes[i];
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
var
idapi32_handle: HMODULE;
Patch_DbiOpenTable : TRYPatch;
procedure PatchBDE;
begin
if idapi32_handle <> 0 then Exit; // already_patched
idapi32_handle := LoadLibrary('idapi32');
if idapi32_handle <> 0 then
begin
Patch_DbiOpenTable := RedirectFunction(GetProcAddress(idapi32_handle, 'DbiOpenTable'), #LogHook_DbiOpenTable, #Actual_DbiOpenTable_CallStub, DbiOpenTable_address_plus_9, 9);
end;
end;
procedure UnPatchBDE;
begin
if idapi32_handle <> 0 then
begin
{Leave everything as before, just in case...}
if Patch_DbiOpenTable.OrgAddr <> nil then
RestorePatch(Patch_DbiOpenTable);
FreeLibrary(idapi32_handle);
idapi32_handle := 0;
end;
end;
initialization
idapi32_handle := 0;
TRYPatch_Clear(Patch_DbiOpenTable);
end.
VMWare, Virtual Box, etc to virtualize an Windows 7. If, as you say, W7 work flawlessly that would solve the problem.
I am trying to delete a Windows key using Delphi , however unsuccessfully , follows the code I'm using
Function DeleteKeyAPI(hRoot: HKEY; sPath: String; IsReg64: BOOL): BOOL;
Var
iRet: Integer;
Begin
If IsReg64 Then
iRet := RegDeleteKeyEx(hRoot, PChar(sPath), KEY_WOW64_64KEY, 0)
Else
iRet := RegDeleteKeyEx(hRoot, PChar(sPath), KEY_WOW64_32KEY, 0);
If iRet = ERROR_SUCCESS Then
Result := True
Else
Result := False;
End;
in some keys I can delete more than one has in own Regedit me of an access denied error
how can I fix this problem ?
Edited -----------------------
I tried to do as follows , but without success
function SHDeleteKey(key: HKEY; pszSubKey: LPCTSTR): DWORD; stdcall;
implementation
{$R *.dfm}
function SHDeleteKey; external 'shlwapi.dll' name 'SHDeleteKeyA';
procedure TForm1.FormCreate(Sender: TObject);
begin
SHDeleteKey(HKEY_LOCAL_MACHINE, 'SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Run\AdobeCS6ServiceManager');
end;
You should inspect the value of iRet to learn more. This is a Win32 error code that will give more details of the reason for failure.
From the documentation:
The subkey to be deleted must not have subkeys. To delete a key and all its subkeys, you need to enumerate the subkeys and delete them individually. To delete keys recursively, use the RegDeleteTree or SHDeleteKey function.
This is one common failure mode, namely that the subkey you are attempting to delete has subkeys itself. I'm not sure what error code is, perhaps ERROR_DIR_NOT_EMPTY.
Another common failure mode is that the named subkey does not exist. That would lead to error code ERROR_PATH_NOT_FOUND or perhaps ERROR_FILE_NOT_FOUND.
Finally, and what I guess is the real problem, you cannot obtain delete rights to the key. Since you are using alternate registry flags, I suspect you are trying to delete a subkey under HKLM. Your process needs sufficient rights to be able to do this. Typically that means running as an elevated admin user. You will get ERROR_ACCESS_DENIED if you have insufficient rights.
Regarding your edit, AdobeCS6ServiceManager is a value rather than a key. The function you need is RegDeleteValue. Read about the registry to learn what these terms mean: https://msdn.microsoft.com/en-us/library/windows/desktop/ms724182.aspx
Furthermore, it is disappointing that you ask a question about RegDeleteKeyEx and then edit to show code that calls SHDeleteKey. Please try to stick to the original question.
I heared that Windows creates a unique key for a PC which is called "MachineID". I found two locations in my registry. Only the location "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Cryptography" should be correct. I try to read the value by this function:
Function GetMaschineID:string;
var
Reg : TRegistry;
//HKEY_CURRENT_USER\Software\Microsoft\MSNMessenger = {dd239a44-fa0d-43ff-a51c-5561d3e39de3}
//HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Cryptography = a06b0ee0-b639-4f55-9972-146776bcd5e4
begin
Reg := TRegistry.Create(KEY_READ);
try
Reg.Rootkey:=HKEY_LOCAL_MACHINE; //Hauptschlüssel
//Reg.RootKey:=HKEY_CURRENT_USER;
if Reg.OpenKey('SOFTWARE\Microsoft\Cryptography\',false) then //Unterschlüssel öffnen
//if Reg.OpenKey('Software\Microsoft\MSNMessenger\',false) then //Unterschlüssel öffnen
begin
Result:=Reg.ReadString('MachineGuid');
end;
finally
Reg.Free;
end;
end;
This version results in an empty string; you see as comment the result from the registry. The second version for "hkey_Current_user" brings the expected string result.
What is wrong with my code or are parts of the registry read protected?
Possible explanation 1
For HKLM you are subject to registry redirection. You have a 32 bit process and are trying to read a key from the 64 bit view of the registry. By default, your 32 bit process is redirected to the 32 bit view, which (implementation detail) lives under Wow6432Node.
Use the KEY_WOW64_64KEY access flag to read from the 64 bit view. As detailed here: How can I read 64-bit registry key from a 32-bit process?
Possible explanation 2
Your call to OpenKey fails for keys under HKLM because you are requesting write access and standard user does not have write access to HKLM. Use OpenKeyReadOnly instead.
Other advice
At the very least you should have debugged this a bit more. Does the call to Reg.OpenKey succeed or fail? You should have debugged enough to know that. Perhaps you did but did not say. If Reg.OpenKey failed then explanation 2 is most likely. Even then, you may subsequently suffer from the other problem.
Note also that your function does not assign to the function result variable, or raise an error, if the call to Reg.OpenKey fails. I would expect that the compiler would have warned you about that.
procedure TForm1.Button1Click(Sender: TObject);
var
registry: TRegistry;
begin
Registry := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY);
try
registry.RootKey := HKEY_LOCAL_MACHINE;
if (registry.KeyExists('\SOFTWARE\Microsoft\Microsoft SQL Server\Instance Names\SQL')) and
(registry.OpenKeyReadOnly('\SOFTWARE\Microsoft\Microsoft SQL Server\Instance Names\SQL')) then
begin
showmessage(registry.ReadString('SQLEXPRESS'));
registry.CloseKey;
end
else showmessage('failed');
finally
registry.Free;
end;
end;
I have written the following code:
var
MainForm: TMainForm;
const
SRootKey = HKEY_LOCAL_MACHINE;
SKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkList\Profiles';
implementation
{$R *.dfm}
{ TMainForm }
procedure TMainForm.GetKeys(OutList: TStrings);
var
Reg: TRegistry;
begin
OutList.BeginUpdate;
try
OutList.Clear;
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := SRootKey;
if (Reg.OpenKeyReadOnly(SKey)) and (Reg.HasSubKeys) then
begin
Reg.GetKeyNames(OutList);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
finally
OutList.EndUpdate;
end;
end;
procedure TMainForm.btnScanClick(Sender: TObject);
begin
GetKeys(ListBox1.Items);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
GetKeys(ListBox1.Items);
end;
This does not seem to do anything.
I can verify the registry path (Windows 8.1), I have even changed the SKey for testing and no issues, but certain keys like this one return nothing.
I even tried running the program from Windows as Administrator and still nothing.
Is there something else I need to change? What would make certain keys readible and others not?
Your process is 32 bit, and you are running it on a 64 bit machine. As such you are subject to registry redirection.
The registry redirector isolates 32-bit and 64-bit applications by providing separate logical views of certain portions of the registry on WOW64. The registry redirector intercepts 32-bit and 64-bit registry calls to their respective logical registry views and maps them to the corresponding physical registry location. The redirection process is transparent to the application. Therefore, a 32-bit application can access registry data as if it were running on 32-bit Windows even if the data is stored in a different location on 64-bit Windows.
The key you are looking at
HKLM\SOFTWARE
is redirected. From your 32 bit process, attempts to open this key are redirected to the 32 bit view of the registry, which as an implementation detail, is stored at
HKLM\SOFTWARE\Wow6432Node
What you are trying to do here is to access the 64 bit view of the registry. To do so you need to access an alternate registry view. That means passing the KEY_WOW64_64KEY key when opening any keys.
In Delphi you can achieve that by including KEY_WOW64_64KEY in the Access flags, or by including it in the flags you pass to the constructor.
Reg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
On top of that, for this particular key, due to the registry security configuration for this key, you need to be running with admin rights in order to open the key. Even if you only intend to read it.
I have to make a unix compatible windows delphi routine that confirms if a file name exists in filesystem exactly in same CaSe as wanted, e.g. "John.txt" is there, not "john.txt".
If I check "FileExists('john.txt')" its always true for John.txt and JOHN.TXT due windows .
How can I create "FileExistsCaseSensitive(myfile)" function to confirm a file is really what its supposed to be.
DELPHI Sysutils.FileExists uses the following function to see if file is there, how to change it to double check file name is on file system is lowercase and exists:
function FileAge(const FileName: string): Integer;
var
Handle: THandle;
FindData: TWin32FindData;
LocalFileTime: TFileTime;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
LongRec(Result).Lo) then Exit;
end;
end;
Result := -1;
end;
function FileExistsEx(const FileName: string): Integer;
var
Handle: THandle;
FindData: TWin32FindData;
LocalFileTime: TFileTime;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then
if AnsiSameStr(FindData.cFileName, ExtractFileName(FileName)) then Exit;
end;
end;
Result := -1;
end;
Tom, I'm also intrigued by your use case. I tend to agree with Motti that it would be counter intuitive and might strike your users as odd.
On windows file names are not case sensitive so I don't see what you can gain from treating file names as if they were case sensitive.
In any case you can't have two files named "John.txt" and "john.txt" and failing to find "John.txt" when "john.txt" exists will probably result in very puzzled users.
Trying to enforce case sensitivity in this context is un-intuitive and I can't see a viable use-case for it (if you have one I'll be happy to hear what it is).
I dealt with this issue a while back, and even if I'm sure that there are neater solutions out there, I just ended up doing an extra check to see if the given filename was equal to the name of the found file, using the case sensitive string comparer...
I ran into a similar problem using Java. Ultimately I ended up pulling up a list of the directory's contents (which loaded the correct case of filenames for each file) and then doing string compare on the filenames of each of the files.
It's an ugly hack, but it worked.
Edit: I tried doing what Banang describes but in Java at least, if you open up file "a.txt" you'r program will stubbornly report it as "a.txt" even if the underlying file system names it "A.txt".
You can implement the approach mention by Kris using Delphi's FindFirst and FindNext routines.
See this article