Delphi : 필요할 때 UAC 표고 승격

Question

런타임시 일부 설정을 HKEY_LOCAL_MACHINE으로 변경해야합니다.

런타임시 필요하면 uac 고도를 묻는 것이 가능합니까? 아니면 '더러운 일'을 수행하기 위해 두 번째 높은 프로세스를 시작해야합니까?

Answer 1

기존 프로세스를 "승격"할 수 없습니다. UAC의 상위 프로세스에는 다른 LUID, 다른 필수 무결성 수준 및 다른 그룹 구성원으로 다른 토큰이 있습니다. 이 수준의 변경은 실행중인 프로세스에서 수행 할 수 없으며 보안 문제가 발생할 수 있습니다.

상승 된 dllhost에서 실행되는 COM 개체를 만들거나 작업을 수행 할 수있는 상승 된 두 번째 프로세스를 시작해야합니다.

http://msdn.microsoft.com/en-us/library/bb756922.aspx에는 "RunAsAdmin"함수와 "CoCreateInstanceAsAdmin"함수가 있습니다.

편집 : 방금 제목에서 '델파이'를 보았습니다. 필자가 나열한 모든 것은 분명히 기본이지만 Delphi가 ShellExecute와 같은 기능에 액세스 할 수있는 경우 링크에서 코드를 적용 할 수 있어야합니다.

Answer 2

당신이 원하는 상승 된 물건을 나타내는 커맨드 라인 매개 변수를 전달하여 자신을 승진시킵니다. 그러면 적절한 양식으로 바로 이동하거나 HKLM 물건을 저장할 수 있습니다.

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; 

다른 마이크로 소프트

이 솔루션은 (특별히 만든 CoCreateInstanceAsAdmin 기능을 사용) 과정의 밖으로 COM 개체를 만드는 것입니다 제안했다. COM 개체를 작성하고 등록해야하기 때문에이 아이디어가 마음에 들지 않습니다.

---

참고 :에는 "CoCreateInstanceAsAdmin"API 호출이 없습니다. 주위에 떠 다니는 코드 일뿐입니다. 여기에 대한 비틀 거리는 Dephi 버전이 있습니다. 그것은 명백히와 클래스 GUID 문자열 접두어의 트릭을 기반으로 "고도 :! 관리자를 새로운 :"

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; 

---

또 다른 질문 접두사 일반적으로 숨겨진 코드는 내부적으로 CoGetObject를 호출 : Windows XP에서 표준 사용자로 실행중인 사람을 어떻게 처리합니까?

는

Answer 3

는

ready-to-use code의 샘플 :

사용 예 :

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. 

및 지원 단위 자체 : 보통

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

, 텍스트 "설정"또는 퍼팅은 어딘가에서 "설치"당신의 EXE 이름은 Windows가 상승 된 privelages로 자동 실행되도록하기에 충분하며 작성하기가 쉬운 설치 유틸리티 인 경우 잘 수행 할 가치가 있습니다.

관리자로 로그인하지 않은 상태에서 Windows 7에서 문제가 발생하여 수동으로 실행할 때 관리자 권한으로 실행 (Wise 설치 마법사를 통해 프로그램을 실행하는 것이 좋습니다)

델파이 10.1 베를린은 프로젝트 옵션 | 신청. Enable Administrator Privileges를 체크하고 매니페스트가 완성되었습니다.

NB. 별도의 설치 프로그램을 통해 이러한 종류의 변경을 수행해야하며, 상승 된 권한으로 항상 응용 프로그램을 실행하면 기본 전자 메일 프로필이 더 이상 선택되지 않는 전자 메일과 같은 다른 문제에 항상 문제가 발생할 수 있습니다.

편집 : 1 월 2018 : 2017 년 8 월에이 답변을 작성한 이후로 많은 Windows 업데이트가 나왔습니다. 설치 프로그램의 경우에도 사용자가 마우스 오른쪽 단추로 클릭하고 관리자로 실행해야합니다. 와이즈와 함께 지어졌습니다. 심지어 Outlook은 관리자 권한으로 실행하지 않아도 더 이상 제대로 설치되지 않습니다. 자동 고도가 더 이상 보이지 않습니다.