Delphi: UAC yükselmesi için İstemi Biz zamanında HKEY_LOCAL_MACHINE için bazı ayarları değiştirmeniz gerekir

Question

gerektiğinde.

Zamanında gerekirse uac yükseltme isteminde, yoksa 'kirli işlerini' yapmak için ikinci bir yükseltilmiş işlemini başlatmak zorunda yapmak mümkün mü?

Answer 1

Varolan bir işlemi "yükseltebilirsiniz". UAC altındaki yükseltilmiş süreçler farklı bir LUID, farklı zorunlu bütünlük seviyesi ve farklı grup üyeliği ile farklı bir simgeye sahiptir. Bu değişim seviyesi, çalışan bir süreçte yapılamaz - ve bunun gerçekleşmesi bir güvenlik sorunudur.

İkinci bir süreç bu işi yapmak veya yükseltilmiş dllhost çalışan bir COM nesnesi oluşturarak olacağını yükseltilmiş başlatmak gerekiyor.

http://msdn.microsoft.com/en-us/library/bb756922.aspx bir örnek "RunAsAdmin" fonksiyonu ve bir "CoCreateInstanceAsAdmin" fonksiyonu sağlar.

DÜZENLEME: Ben sadece senin başlığında "Delphi" gördü. Listelediğim her şey açıkçası yereldir, ancak Delphi ShellExecute benzeri işlevlere erişim sağlıyorsa, kodu bağlantıdan uyarlamanız gerekir.

Answer 2

i yapmak istediğiniz şeyi yükseltilmiş ne belirten komut satırı parametreleri geçirerek, kendin gibi yükseltilmiş yeniden başlatın olacaktır. Daha sonra uygun forma atlayabilir veya sadece HKLM öğelerinizi kaydedebilirsiniz.

function RunAsAdmin(hWnd: HWND; filename: string; Parameters: string): Boolean; 
{ 
    See Step 3: Redesign for UAC Compatibility (UAC) 
    http://msdn.microsoft.com/en-us/library/bb756922.aspx 

    This code is released into the public domain. No attribution required. 
} 
var 
    sei: TShellExecuteInfo; 
begin 
    ZeroMemory(@sei, SizeOf(sei)); 
    sei.cbSize := SizeOf(TShellExecuteInfo); 
    sei.Wnd := hwnd; 
    sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; 
    sei.lpVerb := PChar('runas'); 
    sei.lpFile := PChar(Filename); // PAnsiChar; 
    if parameters <> '' then 
     sei.lpParameters := PChar(parameters); // PAnsiChar; 
    sei.nShow := SW_SHOWNORMAL; //Integer; 

    Result := ShellExecuteEx(@sei); 
end; 

diğer Microsoft

çözeltisi (özel olarak oluşturulmuş CoCreateInstanceAsAdmin fonksiyonunu kullanarak) sürecinin dışında bir COM nesnesi yaratmak önerdi. Bu fikri sevmiyorum çünkü bir COM nesnesini yazmanız ve kaydetmeniz gerekiyor.

---

Not: hayır "CoCreateInstanceAsAdmin" API çağrısı yoktur. Sadece etrafta yüzen bir kod var. İşte etrafta tökezlediğim Dephi versiyonu. Görünüşe göre bir sınıf guid dizesi prefixing hile dayanmaktadır "Yükseklik:! Yönetici new:":

function CoGetObject(pszName: PWideChar; pBindOptions: PBindOpts3; 
     const iid: TIID; ppv: PPointer): HResult; stdcall; external 'ole32.dll'; 

procedure CoCreateInstanceAsAdmin(const Handle: HWND; 
     const ClassID, IID: TGuid; PInterface: PPointer); 
var 
    BindOpts: TBindOpts3; 
    MonikerName: WideString; 
    Res: HRESULT; 
begin 
    //This code is released into the public domain. No attribution required. 
    ZeroMemory(@BindOpts, Sizeof(TBindOpts3)); 
    BindOpts.cbStruct := Sizeof(TBindOpts3); 
    BindOpts.hwnd := Handle; 
    BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER; 

    MonikerName := 'Elevation:Administrator!new:' + GUIDToString(ClassID); 

    Res := CoGetObject(PWideChar(MonikerName), @BindOpts, IID, PInterface); 
    if Failed(Res) then 
     raise Exception.Create(SysErrorMessage(Res)); 
end; 

---

Bir başka soru önek normalde gizli kod içten CoGetObject çağırır : Windows XP'de standart kullanıcı olarak çalışan biriyle nasıl başa çıkıyorsunuz?

Answer 3

ready-to-use code bir örneği:

Kullanım örneği:

unit Unit1; 

interface 

uses 
    Windows{....}; 

type 
    TForm1 = class(TForm) 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Label4: TLabel; 
    Button1: TButton; 
    Button2: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    private 
    procedure StartWait; 
    procedure EndWait; 
    end; 

var 
    Form1: TForm1; 

implementation 

uses 
    RunElevatedSupport; 

{$R *.dfm} 

const 
    ArgInstallUpdate  = '/install_update'; 
    ArgRegisterExtension = '/register_global_file_associations'; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    Label1.Caption := Format('IsAdministrator: %s',  [BoolToStr(IsAdministrator, True)]); 
    Label2.Caption := Format('IsAdministratorAccount: %s', [BoolToStr(IsAdministratorAccount, True)]); 
    Label3.Caption := Format('IsUACEnabled: %s',   [BoolToStr(IsUACEnabled, True)]); 
    Label4.Caption := Format('IsElevated: %s',    [BoolToStr(IsElevated, True)]); 

    Button1.Caption := 'Install updates'; 
    SetButtonElevated(Button1.Handle); 
    Button2.Caption := 'Register file associations for all users'; 
    SetButtonElevated(Button2.Handle); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    StartWait; 
    try 
    SetLastError(RunElevated(ArgInstallUpdate, Handle, Application.ProcessMessages)); 
    if GetLastError <> ERROR_SUCCESS then 
     RaiseLastOSError; 
    finally 
    EndWait; 
    end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
    StartWait; 
    try 
    SetLastError(RunElevated(ArgRegisterExtension, Handle, Application.ProcessMessages)); 
    if GetLastError <> ERROR_SUCCESS then 
     RaiseLastOSError; 
    finally 
    EndWait; 
    end; 
end; 

function DoElevatedTask(const AParameters: String): Cardinal; 

    procedure InstallUpdate; 
    var 
    Msg: String; 
    begin 
    Msg := 'Hello from InstallUpdate!' + sLineBreak + 
      sLineBreak + 
      'This function is running elevated under full administrator rights.' + sLineBreak + 
      'This means that you have write-access to Program Files folder and you''re able to overwrite files (e.g. install updates).' + sLineBreak + 
      'However, note that your executable is still running.' + sLineBreak + 
      sLineBreak + 
      'IsAdministrator: '  + BoolToStr(IsAdministrator, True) + sLineBreak + 
      'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak + 
      'IsUACEnabled: '   + BoolToStr(IsUACEnabled, True) + sLineBreak + 
      'IsElevated: '    + BoolToStr(IsElevated, True); 
    MessageBox(0, PChar(Msg), 'Hello from InstallUpdate!', MB_OK or MB_ICONINFORMATION); 
    end; 

    procedure RegisterExtension; 
    var 
    Msg: String; 
    begin 
    Msg := 'Hello from RegisterExtension!' + sLineBreak + 
      sLineBreak + 
      'This function is running elevated under full administrator rights.' + sLineBreak + 
      'This means that you have write-access to HKEY_LOCAL_MACHINE key and you''re able to write keys and values (e.g. register file extensions globally/for all users).' + sLineBreak + 
      'However, note that this is usually not a good idea. It is better to register your file extensions under HKEY_CURRENT_USER\Software\Classes.' + sLineBreak + 
      sLineBreak + 
      'IsAdministrator: '  + BoolToStr(IsAdministrator, True) + sLineBreak + 
      'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak + 
      'IsUACEnabled: '   + BoolToStr(IsUACEnabled, True) + sLineBreak + 
      'IsElevated: '    + BoolToStr(IsElevated, True); 
    MessageBox(0, PChar(Msg), 'Hello from RegisterExtension!', MB_OK or MB_ICONINFORMATION); 
    end; 

begin 
    Result := ERROR_SUCCESS; 
    if AParameters = ArgInstallUpdate then 
    InstallUpdate 
    else 
    if AParameters = ArgRegisterExtension then 
    RegisterExtension 
    else 
    Result := ERROR_GEN_FAILURE; 
end; 

procedure TForm1.StartWait; 
begin 
    Cursor := crHourglass; 
    Screen.Cursor := crHourglass; 
    Button1.Enabled := False; 
    Button2.Enabled := False; 
    Application.ProcessMessages; 
end; 

procedure TForm1.EndWait; 
begin 
    Cursor := crDefault; 
    Screen.Cursor := crDefault; 
    Button1.Enabled := True; 
    Button2.Enabled := True; 
    Application.ProcessMessages; 
end; 

initialization 
    OnElevateProc := DoElevatedTask; 
    CheckForElevatedTask; 
end. 

Ve destek birimi kendisi: Genellikle

unit RunElevatedSupport; 

{$WARN SYMBOL_PLATFORM OFF} 
{$R+} 

interface 

uses 
    Windows; 

type 
    TElevatedProc  = function(const AParameters: String): Cardinal; 
    TProcessMessagesMeth = procedure of object; 

var 
    // Warning: this function will be executed in external process. 
    // Do not use any global variables inside this routine! 
    // Use only supplied AParameters. 
    OnElevateProc: TElevatedProc; 

// Call this routine after you have assigned OnElevateProc 
procedure CheckForElevatedTask; 

// Runs OnElevateProc under full administrator rights 
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload; 

function IsAdministrator: Boolean; 
function IsAdministratorAccount: Boolean; 
function IsUACEnabled: Boolean; 
function IsElevated: Boolean; 
procedure SetButtonElevated(const AButtonHandle: THandle); 


implementation 

uses 
    SysUtils, Registry, ShellAPI, ComObj; 

const 
    RunElevatedTaskSwitch = '0CC5C50CB7D643B68CB900BF000FFFD5'; // some unique value, just a GUID with removed '[', ']', and '-' 

function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership'; 

function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload; 
var 
    SEI: TShellExecuteInfo; 
    Host: String; 
    Args: String; 
begin 
    Assert(Assigned(OnElevateProc), 'OnElevateProc must be assigned before calling RunElevated'); 

    if IsElevated then 
    begin 
    if Assigned(OnElevateProc) then 
     Result := OnElevateProc(AParameters) 
    else 
     Result := ERROR_PROC_NOT_FOUND; 
    Exit; 
    end; 


    Host := ParamStr(0); 
    Args := Format('/%s %s', [RunElevatedTaskSwitch, AParameters]); 

    FillChar(SEI, SizeOf(SEI), 0); 
    SEI.cbSize := SizeOf(SEI); 
    SEI.fMask := SEE_MASK_NOCLOSEPROCESS; 
    {$IFDEF UNICODE} 
    SEI.fMask := SEI.fMask or SEE_MASK_UNICODE; 
    {$ENDIF} 
    SEI.Wnd := AWnd; 
    SEI.lpVerb := 'runas'; 
    SEI.lpFile := PChar(Host); 
    SEI.lpParameters := PChar(Args); 
    SEI.nShow := SW_NORMAL; 

    if not ShellExecuteEx(@SEI) then 
    RaiseLastOSError; 
    try 

    Result := ERROR_GEN_FAILURE; 
    if Assigned(AProcessMessages) then 
    begin 
     repeat 
     if not GetExitCodeProcess(SEI.hProcess, Result) then 
      Result := ERROR_GEN_FAILURE; 
     AProcessMessages; 
     until Result <> STILL_ACTIVE; 
    end 
    else 
    begin 
     if WaitForSingleObject(SEI.hProcess, INFINITE) <> WAIT_OBJECT_0 then 
     if not GetExitCodeProcess(SEI.hProcess, Result) then 
      Result := ERROR_GEN_FAILURE; 
    end; 

    finally 
    CloseHandle(SEI.hProcess); 
    end; 
end; 

function IsAdministrator: Boolean; 
var 
    psidAdmin: Pointer; 
    B: BOOL; 
const 
    SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); 
    SECURITY_BUILTIN_DOMAIN_RID = $00000020; 
    DOMAIN_ALIAS_RID_ADMINS  = $00000220; 
    SE_GROUP_USE_FOR_DENY_ONLY = $00000010; 
begin 
    psidAdmin := nil; 
    try 
    // Создаём SID группы админов для проверки 
    Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, 
     SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, 
     psidAdmin)); 

    // Проверяем, входим ли мы в группу админов (с учётов всех проверок на disabled SID) 
    if CheckTokenMembership(0, psidAdmin, B) then 
     Result := B 
    else 
     Result := False; 
    finally 
    if psidAdmin <> nil then 
     FreeSid(psidAdmin); 
    end; 
end; 

{$R-} 

function IsAdministratorAccount: Boolean; 
var 
    psidAdmin: Pointer; 
    Token: THandle; 
    Count: DWORD; 
    TokenInfo: PTokenGroups; 
    HaveToken: Boolean; 
    I: Integer; 
const 
    SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); 
    SECURITY_BUILTIN_DOMAIN_RID = $00000020; 
    DOMAIN_ALIAS_RID_ADMINS  = $00000220; 
    SE_GROUP_USE_FOR_DENY_ONLY = $00000010; 
begin 
    Result := Win32Platform <> VER_PLATFORM_WIN32_NT; 
    if Result then 
    Exit; 

    psidAdmin := nil; 
    TokenInfo := nil; 
    HaveToken := False; 
    try 
    Token := 0; 
    HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token); 
    if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then 
     HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token); 
    if HaveToken then 
    begin 
     Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, 
     SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, 
     psidAdmin)); 
     if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or 
     (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then 
     RaiseLastOSError; 
     TokenInfo := PTokenGroups(AllocMem(Count)); 
     Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count)); 
     for I := 0 to TokenInfo^.GroupCount - 1 do 
     begin 
     Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid); 
     if Result then 
      Break; 
     end; 
    end; 
    finally 
    if TokenInfo <> nil then 
     FreeMem(TokenInfo); 
    if HaveToken then 
     CloseHandle(Token); 
    if psidAdmin <> nil then 
     FreeSid(psidAdmin); 
    end; 
end; 

{$R+} 

function IsUACEnabled: Boolean; 
var 
    Reg: TRegistry; 
begin 
    Result := CheckWin32Version(6, 0); 
    if Result then 
    begin 
    Reg := TRegistry.Create(KEY_READ); 
    try 
     Reg.RootKey := HKEY_LOCAL_MACHINE; 
     if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then 
     if Reg.ValueExists('EnableLUA') then 
      Result := (Reg.ReadInteger('EnableLUA') <> 0) 
     else 
      Result := False 
     else 
     Result := False; 
    finally 
     FreeAndNil(Reg); 
    end; 
    end; 
end; 

function IsElevated: Boolean; 
const 
    TokenElevation = TTokenInformationClass(20); 
type 
    TOKEN_ELEVATION = record 
    TokenIsElevated: DWORD; 
    end; 
var 
    TokenHandle: THandle; 
    ResultLength: Cardinal; 
    ATokenElevation: TOKEN_ELEVATION; 
    HaveToken: Boolean; 
begin 
    if CheckWin32Version(6, 0) then 
    begin 
    TokenHandle := 0; 
    HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, TokenHandle); 
    if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then 
     HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle); 
    if HaveToken then 
    begin 
     try 
     ResultLength := 0; 
     if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then 
      Result := ATokenElevation.TokenIsElevated <> 0 
     else 
      Result := False; 
     finally 
     CloseHandle(TokenHandle); 
     end; 
    end 
    else 
     Result := False; 
    end 
    else 
    Result := IsAdministrator; 
end; 

procedure SetButtonElevated(const AButtonHandle: THandle); 
const 
    BCM_SETSHIELD = $160C; 
var 
    Required: BOOL; 
begin 
    if not CheckWin32Version(6, 0) then 
    Exit; 
    if IsElevated then 
    Exit; 

    Required := True; 
    SendMessage(AButtonHandle, BCM_SETSHIELD, 0, LPARAM(Required)); 
end; 

procedure CheckForElevatedTask; 

    function GetArgsForElevatedTask: String; 

    function PrepareParam(const ParamNo: Integer): String; 
    begin 
     Result := ParamStr(ParamNo); 
     if Pos(' ', Result) > 0 then 
     Result := AnsiQuotedStr(Result, '"'); 
    end; 

    var 
    X: Integer; 
    begin 
    Result := ''; 
    for X := 1 to ParamCount do 
    begin 
     if (AnsiUpperCase(ParamStr(X)) = ('/' + RunElevatedTaskSwitch)) or 
     (AnsiUpperCase(ParamStr(X)) = ('-' + RunElevatedTaskSwitch)) then 
     Continue; 

     Result := Result + PrepareParam(X) + ' '; 
    end; 

    Result := Trim(Result); 
    end; 

var 
    ExitCode: Cardinal; 
begin 
    if not FindCmdLineSwitch(RunElevatedTaskSwitch) then 
    Exit; 

    ExitCode := ERROR_GEN_FAILURE; 
    try 
    if not IsElevated then 
     ExitCode := ERROR_ACCESS_DENIED 
    else 
    if Assigned(OnElevateProc) then 
     ExitCode := OnElevateProc(GetArgsForElevatedTask) 
    else 
     ExitCode := ERROR_PROC_NOT_FOUND; 
    except 
    on E: Exception do 
    begin 
     if E is EAbort then 
     ExitCode := ERROR_CANCELLED 
     else 
     if E is EOleSysError then 
     ExitCode := Cardinal(EOleSysError(E).ErrorCode) 
     else 
     if E is EOSError then 
     else 
     ExitCode := ERROR_GEN_FAILURE; 
    end; 
    end; 

    if ExitCode = STILL_ACTIVE then 
    ExitCode := ERROR_GEN_FAILURE; 
    TerminateProcess(GetCurrentProcess, ExitCode); 
end; 

end. 

Answer 4

, metin "Kur" veya koyarak yerde "Yükle" senin EXE adı, Windows otomatik olarak yükseltilmiş privelages ile çalıştırmak için yeterli ve yapmak için çok kolay olduğu gibi, yazdığınız bir kurulum programı ise yapmaya değer.

Şu anda Windows 7'de bir yönetici olarak oturum açmamışken ve el ile çalıştırıldığında (Farklı bir kurulum sihirbazı aracılığıyla programı çalıştırdığınızda) Yönetici Olarak Çalıştır'ı sağ tıklatmak zorunda kaldığım halde, artık sorunlarla karşılaşıyorum.

Delphi 10.1 Berlin'in Project Options | Uygulama. Sadece Yönetici Ayrıcalıklarını Etkinleştir seçeneğini işaretleyin ve bildirim sizin için çok kolay!

NB. Ayrı bir kurulum programı aracılığıyla bu tür değişiklikleri yaptığınızdan emin olun, uygulamanızı her zaman başka şeylerle ilgili sorunlara yol açacak şekilde yükseltilmiş yükler ile çalıştırabilirsiniz, örneğin varsayılan posta profilinin artık alınamadığı e-posta gibi.

Düzeltme: Ocak 2018: Ağustos 2017'de bu yanıtı yazdığından beri, pek çok Windows güncellemesi çıkmış gibi görünüyor; bu, kullanıcının hemen her şeyde sağ tıklatıp Yönetici Olarak Çalıştır öğelerini yüklemesini gerektirir. Wise ile inşa edilmiştir. Outlook bile, yönetici olarak çalıştırılmadan düzgün yüklenmiyor. Görünüşe göre daha fazla otomatik yükseklik yok.