Запуск программы с правами администратора

[Vadik(R)]

Тема в принципе заезженная, поэтому решил написать в ветке FAQ (да и вообще, моей любимой ).
В общем, проблема такая. Когда делаешь какую-либо программу на Delphi 7, и в ней, допустим, пытаешься создать какой-либо файл в корне диска, то в Windows XP все работает нормально, а в Windows 7 - файл вместо корня диска создается в папке C:\Users\Vadim\AppData\Local\VirtualStore.
Ну, как и следует, видимо из соображений безопасности. Для того, чтобы создать файл именно в корне диска C - приходиться запускать программу с правами администратора, щелкать по кнопке OK в UAC-окне. Проблема в следующем, что мне надоело каждый раз принудительно щелкать правой кнопкой мыши и запускать программу с администраторскими правами. Решение есть - поставить в свойствах галочку - запустить программу с правами администратора. Но оно меня не очень устраивает, поскольку, если сменить расположение программы, то галочку приходится ставить заново, да и вообще, выходит мне так придеться ставить галочки почти для каждой написанной мною программы? - Не выход. Отключать UAC я тоже не хочу, все же раз придумали эту штуку как средство защиты, пускай есть, пригодится. Потому пришёл к выводу, что надо сделать так, чтобы программа сама запускала себя сразу с правами администратора. Погуглив, я нашёл способ сделать такое с помощью manifest-файла, правда везде этот способ описывался для Visual Studio C++. А мне надо для Delphi 7, все же, хоть и мертвый язык, для меня он привычней
Вот, стал гуглить, как запустить программу с правами администратора для Delphi, а параллельно наткнулся на код, который определяет, запущена ли программа уже с правами администратора или нет:

const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;

function IsAdmin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken);
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for x := 0 to ptgGroups.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
begin
Result := True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if isAdmin then ShowMessage('Logged in as Administrator');
end;

Но, проблема в том, что этот код не рабочий. Он всегда выдает сообщение, что программа запущена с правами администратора.
Поэтому, я нашёл другой выход из этой ситуации, правда кривой на мой взгляд. А именно, программе без администраторских прав запрещено создавать exe-файлы в корне диска, даже если в файл будет создаваться в VirtualStore. Потому я пытаюсь создать какую-либо exe-шку в корне диска, и, если это сделать не получается, то программа запущена без администраторских прав, иначе все хорошо Способ, понятное дело, очень не хороший, так как программа с таким именем может уже существовать в корне диска, да и в целом, левый способ. Хотя, если бы можно было внедрять manifest-файл в Delphi, так же, как и в Visual Stidio C++, то проблема определения, запущена ли программа с администраторскими правами, отпадет сама
Но это только половина дела, определить, как запущена программа, ведь если она запущена не под админом, то ей стоит перезапустить саму себя уже с администраторскими правами. Вот, опять погуглил эту проблему, нашёл код с функцией CreateProcessWithLogonW:

function CreateProcessWithLogonW(lpUsername: PWideChar; lpDomain: PWideChar; lpPassword: PWideChar; dwLogonFlags: DWORD; lpApplicationName: PWideChar; lpCommandLine: PWideChar; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: PWideChar; const lpStartupInfo: STARTUPINFO; var lpProcessInfo: PROCESS_INFORMATION): BOOL; stdcall; external 'advapi32.dll' name 'CreateProcessWithLogonW';
...
var
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
begin
...
ZeroMemory(@si, SizeOf(si));
si.cb := SizeOf(si);
if CreateProcessWithLogonW('administrator', nil, '', 1, nil, PWideChar(Application.ExeName), 0, nil, nil, si, pi) then ShowMessage('Yahoo') else ShowMessage('Krahhh...');
end;

Но эта функция всегда выводит мне сообщение "Краххх.."
Не знаю, почему так. Кто-то говорит, что это из-за того, что пароль стоит пустой, и таким образом это такая защита...
В общем, проблема такая, что надо программно запустить самого себя с правами администратора. Сделать это надо средствами Delphi 7, было бы обидно, что если такая возможность была только в C++.

 

[Vadik(R)]

Погуглив далее, я всё же нашёл рабочую функцию запуска программы с правами администратора:

procedure RunAsAdministrator(const source: string);
var
shExecInfo: PSHELLEXECUTEINFOA;
begin
New(shExecInfo);
shExecInfo^.cbSize := sizeof(SHELLEXECUTEINFO);
shExecInfo^.fMask := 0;
shExecInfo^.Wnd := 0;
shExecInfo^.lpVerb := 'runas';
shExecInfo^.lpFile := PAnsiChar(ExtractFileName(source));
shExecInfo^.lpParameters := '';
shExecInfo^.lpDirectory := PAnsiChar(ExtractFilePath(source));
shExecInfo^.nShow := SW_SHOWNORMAL;
shExecInfo^.hInstApp := 0;
ShellExeCuteex(shExecInfo);
Dispose(shExecInfo);
shExecInfo := nil;
end;

Вот. Правда так и не научился нормально определять, запущена ли программа уже с правами администратора или нет.
Более того, научился вставлять свой манифест в программу, в результате чего происходит автоматический запрос прав администратора
Теперь хотелось бы пойти дальше. Каким образом тогда программы, типа антивируса касперского при запуске больше не запрашивают уровень администратора? То есть, они запросили его однажды при первом запуске (при установке), что-то где-то прописали и теперь всегда запускаются с правами администратора, без окошка UAC. Как они такое сделали?

 

[sinkopa]

Теперь хотелось бы пойти дальше. Каким образом тогда программы, типа антивируса касперского при запуске больше не запрашивают уровень администратора? То есть, они запросили его однажды при первом запуске (при установке), что-то где-то прописали и теперь всегда запускаются с правами администратора, без окошка UAC. Как они такое сделали?

А просто они (антивири) уже давно службы и следовательно запускаются не от имени пользователя, а от имени системы... улавливаете разницу?
А что касается определения того есть ли админские права...
Вот код юнита (источник - форум на

Ссылка скрыта от гостей

)

unit unitIsAdmin;

interface

uses
Windows;

function CheckTokenMembership(TokenHandle: THandle; SidToCheck: PSID;
out IsMember: BOOL): BOOL; stdcall;
function SHTestTokenMembership(hToken: THandle; ulRID: ULONG): BOOL; stdcall;
function IsUserAnAdmin(): BOOL; stdcall;

implementation

function GetAdvApi32Lib(): HMODULE;
const
ModuleName = 'ADVAPI32';
{$WRITEABLECONST ON}
const
ModuleHandle: HMODULE = HMODULE(nil);
{$WRITEABLECONST OFF}
begin
Result := ModuleHandle;
if Result = HMODULE(nil) then
begin
Result := LoadLibrary(ModuleName);
if Result <> HMODULE(nil) then
ModuleHandle := Result;
end;
end;

function CheckTokenMembership(TokenHandle: THandle; SidToCheck: PSID;
out IsMember: BOOL): BOOL;
type
TFNCheckTokenMembership = function(TokenHandle: THandle; SidToCheck: PSID;
out IsMember: BOOL): BOOL; stdcall;
{$WRITEABLECONST ON}
const
Initialized: Integer = 0;
RealApiFunc: TFNCheckTokenMembership = nil;
{$WRITEABLECONST OFF}
type
TAceHeader = packed record
AceType : Byte;
AceFlags: Byte;
AceSize : Word;
end;
TAccessAllowedAce = packed record
Header : TAceHeader;
Mask : ACCESS_MASK;
SidStart: DWORD;
end;
const
ACL_REVISION = 2;
DesiredAccess = 1;
GenericMapping: TGenericMapping = (
GenericRead : STANDARD_RIGHTS_READ;
GenericWrite : STANDARD_RIGHTS_WRITE;
GenericExecute: STANDARD_RIGHTS_EXECUTE;
GenericAll : STANDARD_RIGHTS_ALL
);
var
ClientToken: THandle;
ProcessToken: THandle;
SecurityDescriptorSize: Cardinal;
SecurityDescriptor: PSecurityDescriptor;
Dacl: PACL;
PrivilegeSetBufferSize: ULONG;
PrivilegeSetBuffer: packed record
PrivilegeSet: TPrivilegeSet;
Buffer: array [0..2] of TLUIDAndAttributes;
end;
GrantedAccess: ACCESS_MASK;
AccessStatus: BOOL;
begin
if Initialized = 0 then
begin
RealApiFunc := TFNCheckTokenMembership(
GetProcAddress(GetAdvApi32Lib(), 'CheckTokenMembership'));
InterlockedIncrement(Initialized);
end;
if Assigned(RealApiFunc) then
Result := RealApiFunc(TokenHandle, SidToCheck, IsMember)
else
begin
Result := False;
IsMember := False;
ClientToken := THandle(nil);
try
if TokenHandle <> THandle(nil) then
ClientToken := TokenHandle
else if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, False,
ClientToken) then
begin
ClientToken := THandle(nil);
if GetLastError() = ERROR_NO_TOKEN then
begin
if OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY or
TOKEN_DUPLICATE, ProcessToken) then
try
if not DuplicateToken(ProcessToken, SecurityImpersonation,
@ClientToken) then
begin
ClientToken := THandle(nil);
end;
finally
CloseHandle(ProcessToken);
end;
end;
end;
if ClientToken <> THandle(nil) then
begin
SecurityDescriptorSize := SizeOf(TSecurityDescriptor) +
SizeOf(TAccessAllowedAce) + SizeOf(TACL) +
3 * GetLengthSid(SidToCheck);
SecurityDescriptor := PSecurityDescriptor(
LocalAlloc(LMEM_ZEROINIT, SecurityDescriptorSize));
if SecurityDescriptor <> nil then
try
if InitializeSecurityDescriptor(SecurityDescriptor,
SECURITY_DESCRIPTOR_REVISION) then
begin
if SetSecurityDescriptorOwner(SecurityDescriptor, SidToCheck,
False) then
begin
if SetSecurityDescriptorGroup(SecurityDescriptor, SidToCheck,
False) then
begin
Dacl := PACL(SecurityDescriptor);
Inc(PSecurityDescriptor(Dacl));
if InitializeAcl(Dacl^,
SecurityDescriptorSize - SizeOf(TSecurityDescriptor),
ACL_REVISION) then
begin
if AddAccessAllowedAce(Dacl^, ACL_REVISION, DesiredAccess,
SidToCheck) then
begin
if SetSecurityDescriptorDacl(SecurityDescriptor, True, Dacl,
False) then
begin
PrivilegeSetBufferSize := SizeOf(PrivilegeSetBuffer);
Result := AccessCheck(SecurityDescriptor, ClientToken,
DesiredAccess, GenericMapping,
PrivilegeSetBuffer.PrivilegeSet, PrivilegeSetBufferSize,
GrantedAccess, AccessStatus);
if Result then
IsMember := AccessStatus and
(GrantedAccess = DesiredAccess);
end;
end;
end;
end;
end;
end;
finally
LocalFree(HLOCAL(SecurityDescriptor));
end;
end;
finally
if (ClientToken <> THandle(nil)) and
(ClientToken <> TokenHandle) then
begin
CloseHandle(ClientToken);
end;
end;
end;
end;

function GetShell32Lib(): HMODULE;
const
ModuleName = 'SHELL32';
{$WRITEABLECONST ON}
const
ModuleHandle: HMODULE = HMODULE(nil);
{$WRITEABLECONST OFF}
begin
Result := ModuleHandle;
if Result = HMODULE(nil) then
begin
Result := LoadLibrary(ModuleName);
if Result <> HMODULE(nil) then
ModuleHandle := Result;
end;
end;

function SHTestTokenMembership(hToken: THandle; ulRID: ULONG): BOOL; stdcall;
type
TFNSHTestTokenMembership = function(hToken: THandle; ulRID: ULONG): BOOL; stdcall;
{$WRITEABLECONST ON}
const
Initialized: Integer = 0;
RealApiFunc: TFNSHTestTokenMembership = nil;
{$WRITEABLECONST OFF}
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
var
SidToCheck: PSID;
begin
if Initialized = 0 then
begin
RealApiFunc := TFNSHTestTokenMembership(
GetProcAddress(GetShell32Lib(), 'SHTestTokenMembership'));
InterlockedIncrement(Initialized);
end;
if Assigned(RealApiFunc) then
Result := RealApiFunc(hToken, ulRID)
else
begin
Result := AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, ulRID, 0, 0, 0, 0, 0, 0, SidToCheck);
if Result then
try
if not CheckTokenMembership(THandle(nil), SidToCheck, Result) then
Result := False;
finally
FreeSid(SidToCheck);
end;
end;
end;

function IsUserAnAdmin(): BOOL;
const
DOMAIN_ALIAS_RID_ADMINS = $00000220;
type
TFNIsUserAnAdmin = function(): BOOL; stdcall;
{$WRITEABLECONST ON}
const
Initialized: Integer = 0;
RealApiFunc: TFNIsUserAnAdmin = nil;
{$WRITEABLECONST OFF}
begin
if Initialized = 0 then
begin
RealApiFunc := TFNIsUserAnAdmin(
GetProcAddress(GetShell32Lib(), 'IsUserAnAdmin'));
InterlockedIncrement(Initialized);
end;
if Assigned(RealApiFunc) then
Result := RealApiFunc()
else
Result := SHTestTokenMembership(THandle(nil), DOMAIN_ALIAS_RID_ADMINS);
end;

end.

Пример использования

...
uses
unitIsAdmin;
...
if IsUserAnAdmin then
showmessage('running in administrator mode');

У меня это работает и под XP и под Win7.

 

[Vadik(R)]

Спасибо за объяснения!
Твоя функция действительно верно работает в Win 7!