[xteam777]

Добрейшего уважаемые.

ОС Windows 10. UAC включен. Не получается из программы установить службу:

ShellExecute(Application.Handle, 'open', PChar(ParamStr(0)), PChar('/INSTALL'), '', SW_HIDE);
Error 5 - Отказано в доступе

Если правой кнопкой-Запустить под админом, то все нормально.

Как это обойти и сделать так, чтобы программа при запуске не требовала повышения прав, а при нажатии на кнопку Установить службу, требовала?

[nixon232]

Нельзя сделать чтобы не требовало, можно поднять привелегии при помощи манифеста

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
type="win32"
name="name.App"
version="1.0.0.1"
processorArchitecture="*"/>
<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>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
<application>

<!-- Windows 10 -->
<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
<!-- Windows 8.1 -->
<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
<!-- Windows Vista -->
<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
<!-- Windows 7 -->
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
<!-- Windows 8 -->
<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
</application>
</compatibility>
</assembly>

Или проверить права веред операцией

Код:

function EnablePrivilege(const Value: Boolean; privilegename: string): Boolean;
var
  hToken: THandle;
  tp: TOKEN_PRIVILEGES;
  d: dword;
begin
  Result := False;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken) then
  begin
    tp.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, pchar(privilegename), tp.Privileges[0].Luid);
    if Value then
      tp.Privileges[0].Attributes := $00000002
    else
      tp.Privileges[0].Attributes := $80000000;
    AdjustTokenPrivileges(hToken, False, tp, SizeOf(TOKEN_PRIVILEGES), nil, d);
    if GetLastError = ERROR_SUCCESS then
    begin
      Result := true;
    end;
    CloseHandle(hToken);
  end;
end;
 if EnablePrivilege(true, 'SeDebugPrivilege') then
  begin
// do install
  end;

[Zorkov Igor]

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  ShellExecuteInfo: TShellExecuteInfo;
begin
  ShellExecuteInfo.cbSize:= SizeOf(TShellExecuteInfo);
  ShellExecuteInfo.fMask:= 0;
  ShellExecuteInfo.Wnd:= 0;
  ShellExecuteInfo.lpVerb:= 'runas';
  ShellExecuteInfo.lpFile:= PChar(ParamStr(0));
  ShellExecuteInfo.lpParameters:= PChar('/INSTALL');
  ShellExecuteInfo.lpDirectory:= nil;
  ShellExecuteInfo.nShow:= SW_SHOWNORMAL;
  ShellExecuteEx(@ShellExecuteInfo)
end;

[xteam777]

Сообщение от Zorkov Igor

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  ShellExecuteInfo: TShellExecuteInfo;
begin
  ShellExecuteInfo.cbSize:= SizeOf(TShellExecuteInfo);
  ShellExecuteInfo.fMask:= 0;
  ShellExecuteInfo.Wnd:= 0;
  ShellExecuteInfo.lpVerb:= 'runas';
  ShellExecuteInfo.lpFile:= PChar(ParamStr(0));
  ShellExecuteInfo.lpParameters:= PChar('/INSTALL');
  ShellExecuteInfo.lpDirectory:= nil;
  ShellExecuteInfo.nShow:= SW_SHOWNORMAL;
  ShellExecuteEx(@ShellExecuteInfo)
end;

Вроде то, что нужно. А нужно эмулировать нажатие ПКМ-Запуск от имени администратора. Но при вызове Эксплорер выдает следующее:

Windows не удается получить доступ к указанному устройству, пути или файлу. Возможно, у вас нет нужных разрешений для доступа к этому объекту.

GetLastError() при этом выдает 0

Сам экзешник с параметром /INSTALL при ПКМ-Запуск от имени администратора отрабатывает без ошибок

[xteam777]

Добавил это. Проблема осталась.

Код:

ShellExecuteInfo.lpDirectory := PChar(ExtractFilePath(ParamStr(0)));

[Zorkov Igor]

Не совсем понятно конечно что за служба такая, тоже написана вами? это драйвер? что за служба? код службы есть?

[xteam777]

Прошу прощения. Какойто глюк был с виндой после обновлений. Сейчас все работает. Перезагрузка помогла.