[решено] Вопрос по библиотеке JEDI (модуль JclRegistry )

[Painkiller]

Привет всем ! Столкнулся с такой проблемой . Нужно удалить ключ реестра со всеми подключами.
HKEY_LOCAL_MACHINE\Software\Microsoft\WIMMount
Проблема на x64 системе , а у меня x32 приложения . Соответственно моя программа ищет этот в ключе Wow6432Node. Решения я нашёл не используя библиотеку JEDI так:


procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create();
if IsWindows64=true then begin
Reg.Access := $100 or KEY_ALL_ACCESS;
end;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('\Software\Microsoft\WIMMount') then
Reg.DeleteKey('Software\Microsoft\WIMMount');
finally
Reg.Free;
end;end;


Всё работает и удаляется . Но хотелось бы обойтись средствами библиотеки JEDI

Набросал код :

procedure TForm1.Button2Click(Sender: TObject);
var
RootKey: HKEY;
PathKEY:String;
begin
if IsWindows64=true then begin
RegSetWOW64AccessMode(ra64Key);
end;
RootKey := HKEY_LOCAL_MACHINE;
PathKEY:='Software\Microsoft\WIMMount';
if not RegKeyExists (RootKey,PathKEY) then begin
Memo1.Lines.Add('- [ Ошибка ] Ключ не найден')
end else begin
Memo1.Lines.Add('[ ОК ] Ключ найден');
if not RegDeleteKeyTree (RootKey,PathKEY)then begin
Memo1.Lines.Add('[ Ошибка ] Ключ не удалён')
end else begin
Memo1.Lines.Add('[ ОК ] Ключ удалён');
end;
end;
end;
end.


Ключ находит, но не удаляет =((( Что нужно ещё добавить ??? Помогите, плиз!

[opel431]

1. TForm1.FormCreate(....);
...
RegSetWOW64AccessMode(raNative);

и запросить привилегии, если программа исполняется в Виста и выше

if (CheckWin32Version(6, 0)) then
begin
if not IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(True, 'SeBackupPrivilege');
if not IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(True, 'SeRestorePrivilege');
end;
....

а по завершению программы, восстановить привилегии

if (CheckWin32Version(6, 0)) then
begin
if IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(False, 'SeBackupPrivilege');
if IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(False, 'SeRestorePrivilege');
end;

2. Нужно ли выводить все операциям с ключами в Memo, может просто поднимать исключение?

if (RegKeyExists(RootKey, PathKEY)) then
begin
if not(RegDeleteKeyTree(RootKey, PathKEY)) then
begin
RaiseLastOSError;
exit;
end
end;

а если Memo служит для последующего сохранения log-файла, то тогда можно добавить код ошибки (дата, время и т.д.)
... Lines.Add('Сообщение.... '+ SysErrorMessage ( GetLastError )));

[Painkiller]

opel431, добавил ваш код :


uses
JclSecurity,JclRegistry,....
..........................
procedure TForm1.Button2Click(Sender: TObject);
var
RootKey: HKEY;
PathKEY:String;
begin
RegSetWOW64AccessMode(raNative);
RootKey := HKEY_LOCAL_MACHINE;
PathKEY:='Software\Microsoft\WIMMount\Mounted Images';
if not RegKeyExists (RootKey,PathKEY) then begin
RaiseLastOSError;
Memo1.Lines.Add('[ Ошибка [ '+ SysErrorMessage ( GetLastError )+' ] Ключ не найден') ;
exit
end else begin
Memo1.Lines.Add('[ ОК ] Ключ найден');
if not RegDeleteKeyTree (RootKey,PathKEY)then begin
RaiseLastOSError;
Memo1.Lines.Add('[ Ошибка [ '+ SysErrorMessage ( GetLastError )+' ] Ключ не удалён');
exit
end else begin
Memo1.Lines.Add('[ ОК ] Ключ удалён');
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (CheckWin32Version(6, 0)) then
begin
if IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(False, 'SeBackupPrivilege');
if IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(False, 'SeRestorePrivilege');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if (CheckWin32Version(6, 0)) then
begin
if not IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(True, 'SeBackupPrivilege');
if not IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(True, 'SeRestorePrivilege');
end;
end;
end.



При нажатии кнопки Button2 выскакивает ошибка

http://i4.imageban.ru/out/2016/02/26/2105ec3093ff03fe13f55b8bb8d54e2e.png

Windows 7 Максимальная x64 установлена
Убрал RaiseLastOSError ошибка ушла , ключ находит, но ключ не удаляет =((. Хочу заметить то что если я делаю x64 приложения , то ключ удаляется

Пробовал использовать manifest


с <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
publicKeyToken="6595b64144ccf1df"
language="*"
processorArchitecture="*"/>
</dependentAssembly>
</dependency>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
<security>
<requestedPrivileges>
<requestedExecutionLevel
level="requireAdministrator"
uiAccess="false"/>
</requestedPrivileges>
</security>
</trustInfo>
</assembly>


Результат не дал =(

[opel431]

В целом, сообщение "A call to an OS function failed" вызывается из SysUtils, когда Win32Check или RaiseLastOSError не находит соответствующее сообщение об ошибке в модуле.

При нажатии кнопки Button2 выскакивает ошибка »И как это понимать? Я ведь написал Вам два варианта:
1. Вызывать исключение
RaiseLastOSError; // выводит сообщение об исключительной ситуации, но не для RegKeyExists(....), а для RegDeleteKeyTree(...)
Exit(); // выйти из процедуры

2. Выводить сообщение с кодом ошибки
memo1.Lines.Add('[ Ошибка [ ' + SysErrorMessage(GetLastError) + ' ] Ключ не найден');
// это сообщение будет такого вида Ошибка [Операция успешно завершена]Ключ не найден !!!! Зачем такой вид?? Не проще
memo1.Lines.Add('[ Сообщение - ( ' + SysErrorMessage(GetLastError)+')')

А Вы все в одну кучу!

3. Для чего Вы RegSetWOW64AccessMode(raNative) поместили в событие кнопки? Оно должно вызываться один раз, при создании или инициализации формы.

[Painkiller]

opel431, извиняюсь, поправил код.

procedure TForm1.Button2Click(Sender: TObject);
var
RootKey: HKEY;
PathKEY:String;
begin
RegSetWOW64AccessMode(raNative);
RootKey := HKEY_LOCAL_MACHINE;
PathKEY:='Software\Microsoft\WIMMount';
if not RegKeyExists (RootKey,PathKEY) then begin
Memo1.Lines.Add('[ '+ SysErrorMessage ( GetLastError )+' ] Ключ не найден') ;
exit
end else begin
Memo1.Lines.Add('[ '+ SysErrorMessage ( GetLastError )+' ] Ключ найден') ;
if not RegDeleteKeyTree (RootKey,PathKEY)then begin
Memo1.Lines.Add('['+ SysErrorMessage ( GetLastError )+' ] Ключ не удалён');
exit
end else begin
Memo1.Lines.Add('['+ SysErrorMessage ( GetLastError )+' ] Ключ удалён');
end;
end;
end;

Операции выполняются успешно , но ключ всё равно не удаляется

http://i4.imageban.ru/out/2016/02/26/5ff3cc9a04ff3b3f4e69567fb0ed3cb7.png

[opel431]

Смотря, что Вам нужно!
RegDeleteKeyTree - удаляет подключи, для сбора всех ='RegKeyName' нужно будет формировать список и удалять по списку (RegGetKeyNames)
RegDeleteEntry - удаляет ключ

[Painkiller]

Смотря, что Вам нужно!
RegDeleteKeyTree - удаляет подключи, для сбора всех ='RegKeyName' нужно будет формировать список и удалять по списку (RegGetKeyNames)
RegDeleteEntry - удаляет ключ »
Нужно удалить ключ реестра со всеми подключами. RegDeleteKeyTree удаляет ключ с подключами и не нужно удалять по списку. Я же писал что при компиляции x64 приложения , всё удаляется с подключами без проблем, проблема только с x32 приложением
Разницы нет где располагать RegSetWOW64AccessMode(raNative). Так как без его ключ вообще не видит. Значит RegSetWOW64AccessMode(raNative) работает и в кнопке.

[opel431]

RegDeleteKeyTree удаляет ключ с подключами и не нужно удалять по списку. »
Значит я не совсем Вас понял и предположил, что Вам еще нужно найти в ветке n-ключей, а затем их удалить с под ключами.
Манифест, с параметром level="requireAdministrator" + получение прав, нужны обязательно!

Так как без его ключ вообще не видит. »
Фактически, это переключатель и режим переключения (по условию) Вы задаете сами

OS/Application 32bit/32bit 64bit/32bit 64bit/64bit
raDefault Software Wow6432Node Software
raNative Software Software Software
ra32Key Software Wow6432Node Wow6432Node
ra64Key Software Software Software


Delphi, ставлю когда мне это необходимо, потому даю совет исходя из справки и исходников JCL.
Вы можете еще добавить в процедуры работы с привилегиями еще пару "вездесущих" привилегий: SeDebugPrivilege и SeManageVolumePrivilege.
Да, после изменений в реестре нужно известить систему - SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar(Ветка реестра)));

[Painkiller]

Фактически, это переключатель и режим переключения (по условию) Вы задаете сами »
Я знаю, модуль я курил искав решения .
получение прав, нужны обязательно! »
Этот ключ с подключами удаляется легко через рег файл , через батник. Разве нужны права ?
после изменений в реестре нужно известить систему - SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar(Ветка реестра))); »
А вот этого не знал . Спасибо. Попробую

Всё равно не работает. =( Объясните мне тогда почему мой код не используя библиотеку JEDI работает без манифеста, привилегий.

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create();
if IsWindows64=true then begin
Reg.Access := $100 or KEY_ALL_ACCESS;
end;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('\Software\Microsoft\WIMMount') then
Reg.DeleteKey('Software\Microsoft\WIMMount');
finally
Reg.Free;
end;end;

А с JEDI не работает = ( Ладно , буду использовать свой код раз с JEDI не получается .

[opel431]

Объясните мне тогда почему мой код не используя библиотеку JEDI работает без манифеста, привилегий »
1. Ваш код, удаляет ключ! А функция RegDeleteKeyTree, удаляет подключи!

2. Права доступа к реестру необходимы и они присутствуют в обоих вариантах. См KEY_ALL_ACCESS у Вас и в исходнике
function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean;
var
RegKey: HKEY;
I: DWORD;
Size: DWORD;
NumSubKeys: DWORD;
MaxSubKeyLen: DWORD;
KeyName: string;
begin
RegKey := 0;
Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS;
if Result then
begin
RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil);
if NumSubKeys <> 0 then
for I := NumSubKeys - 1 downto 0 do
begin
Size := MaxSubKeyLen+1;
SetLength(KeyName, Size);
RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil);
SetLength(KeyName, StrLen(PChar(KeyName)));
Result := RegDeleteKeyTree(RootKey, Key + RegKeyDelimiter + KeyName);
if not Result then
Break;
end;
RegCloseKey(RegKey);
if Result then
Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegDeleteKey(RootKey, RelativeKey(RootKey, PChar(Key))) = ERROR_SUCCESS;
end
else
WriteError(RootKey, Key);
end;
3. Вы работаете в системе с отключенным UAC?

[Painkiller]

3. Вы работаете в системе с отключенным UAC? »
Да , вот почему мне манифест не нужен, но я его всё равно его добавлял.

А функция RegDeleteKeyTree, удаляет подключи! »
Если скомпилировать x64 приложения , то функция удаляет ключ с подключами без проблем .

[opel431]

Reg.Access := $100 or KEY_ALL_ACCESS; »Давайте так, не гадать, а почитать, как работает перенаправление RegSetWOW64AccessMode. Посмотрите вот это https://msdn.microsoft.com/en-us/library/aa384129(VS.85).aspx и это http://blog.delphi-jedi.net/2010/08/17/tregistry-deletekey-and-64bit/
У Вас какая версия и под какую платформу Вы создаете приложение? Будут затруднения, поставлю Delphi и посмотрю на практике.

[Painkiller]

У Вас какая версия и под какую платформу Вы создаете приложение? Будут затруднения, поставлю Delphi и посмотрю на практике. »
Ещё раз повторяю .Я создаю x32 приложения , но мне нужно, чтобы она работа и на x86 и на x64 . Всё работает кроме функции RegDeleteKeyTree. Если скомпилировать x64, то всё работает, удаляет ключ с подключами. RegDeleteKeyTree не работает если приложения скомпилировать x32. Вот в чём загвостка.

[opel431]

Ещё раз повторяю »Ну вот, Вы уже с возмущением! У меня XE, компилятор только для платформы x32. Скиньте именно ваш проблемный ключ (.reg). Попробую воспроизвести проблему.

[Painkiller]

Ну вот, Вы уже с возмущением! У меня XE, компилятор только для платформы x32. Скиньте именно ваш проблемный ключ (.reg). Попробую воспроизвести проблему. »
Вам показалось, вы тут единственный, который не раз мне помогал с delphi и на этот раз я на вас то и рассчитываю. Увы я самоучка и иногда не хватает опыта, здесь только на вас и рассчитывать можно. Причём о чудной библиотеке JEDI я узнал из вашего сообщения тут на форуме и в с ней знакомы лично.
Скомпилировал для двух платформ и вместе с рег файлом и исходником залил на яндекс диск тут (https://yadi.sk/d/p5oAt460pZyQ9)
x64 удаляет , а x86 находит но не удаляет. =((

[opel431]

Скомпилировал для двух платформ и вместе с рег файлом.... »Вот это мне не нужно, мне покажите экспорт ключа из реестра, можно и Unit1 (выложите здесь, заключив в теги, ведь просматривают Ваше сообщение и другие). Все остальное лишнее, кроме того, тянет за собой хвост. Или "троян" или ложное срабатывание защиты - Trojan:Win32/Spursint.A.

[Painkiller]

Вот это мне не нужно, мне покажите экспорт ключа из реестра, »

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WIMMount]

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WIMMount\1]


Можно и Unit1 (выложите здесь, заключив в теги, ведь просматривают Ваше сообщение и другие). »


unit Unit1;

interface

uses
JclSecurity,JclRegistry, JclSysInfo, Registry,Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;



type

TForm1 = class(TForm)
Button2: TButton;
Memo1: TMemo;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
RootKey: HKEY;
PathKEY:String;
begin
RegSetWOW64AccessMode(raNative);
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar('HKEY_LOCAL_MACHINE\Software\Microsoft\WIMMount')));
RootKey := HKEY_LOCAL_MACHINE;
PathKEY:='Software\Microsoft\WIMMount';
if not RegKeyExists (RootKey,PathKEY) then begin
Memo1.Lines.Add ('Ключ не найден ');
exit
end else begin
Memo1.Lines.Add('[ ОК ] Ключ найден');
if not RegDeleteKeyTree (RootKey,PathKEY)then begin
Memo1.Lines.Add ('Ключ не удалён ');
exit
end else begin
Memo1.Lines.Add('[ ОК ] Ключ удалён');
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (CheckWin32Version(6, 0)) then
begin
if IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(False, 'SeBackupPrivilege');
if IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(False, 'SeRestorePrivilege');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if (CheckWin32Version(6, 0)) then
begin
if not IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(True, 'SeBackupPrivilege');
if not IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(True, 'SeRestorePrivilege');
end;
end;
end.


Все остальное лишнее, кроме того, тянет за собой хвост. Или "троян" или ложное срабатывание защиты - Trojan:Win32/Spursint.A. »
А вот это у вас ложное срабатывания . У меня тут нет цели распространять вирусы. У вас случайно не Аваст или Авира ?
Результата virustotal 86.exe (https://www.virustotal.com/ru/file/ee4619e48540728c094af1351ef2f284b8d6653b8196dbd35a992dbf35c75ca5/analysis/1456519066/)
Результата virustotal 64.exe (https://www.virustotal.com/ru/file/4b7b75c43d3f0efd3d1e2d351bc5d3d5bd8b22cb79e25ae2dcf860eb61843d88/analysis/1456519440/)

[opel431]

Вижу Вы еще здесь. Попробуй те на платформе x32 RegSetWOW64AccessMode(raDefault);

У вас случайно не Аваст или Авира ? »
"Казенный" - MSE

[Painkiller]

Вижу Вы еще здесь. Попробуй те на платформе x32 RegSetWOW64AccessMode(raDefault); »
Ключ не найден, хоть он и существует. Я уже игрался с этим прежде чем сюда написать, то день просидел вчера , всё перепробовал.

[opel431]

всё перепробовал. »У меня в XE удаляет.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
btn1: TButton;
lbl1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses JclRegistry, JclSecurity, JclSysInfo;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
if (CheckWin32Version(6, 0)) then
begin
if not(IsPrivilegeEnabled('SeBackupPrivilege')) then
EnableProcessPrivilege(True, 'SeBackupPrivilege');
if not(IsPrivilegeEnabled('SeRestorePrivilege')) then
EnableProcessPrivilege(True, 'SeRestorePrivilege');
if not(IsPrivilegeEnabled('SeDebugPrivilege')) then
EnableProcessPrivilege(True, 'SeDebugPrivilege');
if not(IsPrivilegeEnabled('SeManageVolumePrivilege')) then
EnableProcessPrivilege(True, 'SeManageVolumePrivilege');
end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (CheckWin32Version(6, 0)) then
begin
if IsPrivilegeEnabled('SeBackupPrivilege') then
EnableProcessPrivilege(False, 'SeBackupPrivilege');
if IsPrivilegeEnabled('SeRestorePrivilege') then
EnableProcessPrivilege(False, 'SeRestorePrivilege');
if IsPrivilegeEnabled('SeDebugPrivilege') then
EnableProcessPrivilege(False, 'SeDebugPrivilege');
if IsPrivilegeEnabled('SeManageVolumePrivilege') then
EnableProcessPrivilege(False, 'SeManageVolumePrivilege');
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
const
KeyName = 'SOFTWARE\Microsoft\WIMMount';
var
RootKey: HKEY;
LastAccess: TJclRegWOW64Access;
begin
LastAccess := RegGetWOW64AccessMode;
RootKey := HKEY_LOCAL_MACHINE;
try
if not IsWindows64 then
RegSetWOW64AccessMode(raNative);

if not(RegKeyExists(RootKey, KeyName)) then
begin
lbl1.Caption := 'Ключ - ' + KeyName + ' не найден!';
end
else
begin
if not(RegDeleteKeyTree(RootKey, KeyName)) then
begin
lbl1.Caption := 'Ключ - ' + KeyName + ' не удален!';
end
else
lbl1.Caption := 'Ключ - ' + KeyName + ' удален!';
end;
finally
RegSetWOW64AccessMode(LastAccess);
end;
end;

end.