SHARE
TWEET

runas Admin Elevated UAC ShellExecute Delphi

a guest Nov 14th, 2013 1,438 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit RunElevatedSupport;
  2.  
  3. {$WARN SYMBOL_PLATFORM OFF}
  4. {$R+}
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows;
  10.  
  11. type
  12.   TElevatedProc        = function(const AParameters: String): Cardinal;
  13.   TProcessMessagesMeth = procedure of object;
  14.  
  15. var
  16.   // Warning: this function will be executed in external process.
  17.   // Do not use any global variables inside this routine!
  18.   // Use only supplied AParameters.
  19.   OnElevateProc: TElevatedProc;
  20.  
  21. // Call this routine after you have assigned OnElevateProc
  22. procedure CheckForElevatedTask;
  23.  
  24. // Runs OnElevateProc under full administrator rights
  25. function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
  26.  
  27. function  IsAdministrator: Boolean;
  28. function  IsAdministratorAccount: Boolean;
  29. function  IsUACEnabled: Boolean;
  30. function  IsElevated: Boolean;
  31. procedure SetButtonElevated(const AButtonHandle: THandle);
  32.  
  33.  
  34. implementation
  35.  
  36. uses
  37.   SysUtils, Registry, ShellAPI, ComObj;
  38.  
  39. const
  40.   RunElevatedTaskSwitch = '0CC5C50CB7D643B68CB900BF000FFFD5'; // some unique value, just a GUID with removed '[', ']', and '-'
  41.  
  42. function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership';
  43.  
  44. function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
  45. var
  46.   SEI: TShellExecuteInfo;
  47.   Host: String;
  48.   Args: String;
  49. begin
  50.   Assert(Assigned(OnElevateProc), 'OnElevateProc must be assigned before calling RunElevated');
  51.  
  52.   if IsElevated then
  53.   begin
  54.     if Assigned(OnElevateProc) then
  55.       Result := OnElevateProc(AParameters)
  56.     else
  57.       Result := ERROR_PROC_NOT_FOUND;
  58.     Exit;
  59.   end;
  60.  
  61.  
  62.   Host := ParamStr(0);
  63.   Args := Format('/%s %s', [RunElevatedTaskSwitch, AParameters]);
  64.  
  65.   FillChar(SEI, SizeOf(SEI), 0);
  66.   SEI.cbSize := SizeOf(SEI);
  67.   SEI.fMask := SEE_MASK_NOCLOSEPROCESS;
  68.   {$IFDEF UNICODE}
  69.   SEI.fMask := SEI.fMask or SEE_MASK_UNICODE;
  70.   {$ENDIF}
  71.   SEI.Wnd := AWnd;
  72.   SEI.lpVerb := 'runas';
  73.   SEI.lpFile := PChar(Host);
  74.   SEI.lpParameters := PChar(Args);
  75.   SEI.nShow := SW_NORMAL;
  76.  
  77.   if not ShellExecuteEx(@SEI) then
  78.    RaiseLastOSError;
  79.   try
  80.  
  81.     Result := ERROR_GEN_FAILURE;
  82.     if Assigned(AProcessMessages) then
  83.     begin
  84.       repeat
  85.         if not GetExitCodeProcess(SEI.hProcess, Result) then
  86.           Result := ERROR_GEN_FAILURE;
  87.         AProcessMessages;
  88.       until Result <> STILL_ACTIVE;
  89.     end
  90.     else
  91.     begin
  92.       if WaitForSingleObject(SEI.hProcess, INFINITE) <> WAIT_OBJECT_0 then
  93.         if not GetExitCodeProcess(SEI.hProcess, Result) then
  94.           Result := ERROR_GEN_FAILURE;
  95.     end;
  96.  
  97.   finally
  98.     CloseHandle(SEI.hProcess);
  99.   end;
  100. end;
  101.  
  102. function IsAdministrator: Boolean;
  103. var
  104.   psidAdmin: Pointer;
  105.   B: BOOL;
  106. const
  107.   SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  108.   SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
  109.   DOMAIN_ALIAS_RID_ADMINS      = $00000220;
  110.   SE_GROUP_USE_FOR_DENY_ONLY  = $00000010;
  111. begin
  112.   psidAdmin := nil;
  113.   try
  114.     // Создаём SID группы админов для проверки
  115.     Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
  116.       SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
  117.       psidAdmin));
  118.  
  119.     // Проверяем, входим ли мы в группу админов (с учётов всех проверок на disabled SID)
  120.     if CheckTokenMembership(0, psidAdmin, B) then
  121.       Result := B
  122.     else
  123.       Result := False;
  124.   finally
  125.     if psidAdmin <> nil then
  126.       FreeSid(psidAdmin);
  127.   end;
  128. end;
  129.  
  130. {$R-}
  131.  
  132. function IsAdministratorAccount: Boolean;
  133. var
  134.   psidAdmin: Pointer;
  135.   Token: THandle;
  136.   Count: DWORD;
  137.   TokenInfo: PTokenGroups;
  138.   HaveToken: Boolean;
  139.   I: Integer;
  140. const
  141.   SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  142.   SECURITY_BUILTIN_DOMAIN_RID  = $00000020;
  143.   DOMAIN_ALIAS_RID_ADMINS      = $00000220;
  144.   SE_GROUP_USE_FOR_DENY_ONLY  = $00000010;
  145. begin
  146.   Result := Win32Platform <> VER_PLATFORM_WIN32_NT;
  147.   if Result then
  148.     Exit;
  149.  
  150.   psidAdmin := nil;
  151.   TokenInfo := nil;
  152.   HaveToken := False;
  153.   try
  154.     Token := 0;
  155.     HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token);
  156.     if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
  157.       HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
  158.     if HaveToken then
  159.     begin
  160.       Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
  161.         SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
  162.         psidAdmin));
  163.       if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or
  164.          (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
  165.         RaiseLastOSError;
  166.       TokenInfo := PTokenGroups(AllocMem(Count));
  167.       Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count));
  168.       for I := 0 to TokenInfo^.GroupCount - 1 do
  169.       begin
  170.         Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid);
  171.         if Result then
  172.           Break;
  173.       end;
  174.     end;
  175.   finally
  176.     if TokenInfo <> nil then
  177.       FreeMem(TokenInfo);
  178.     if HaveToken then
  179.       CloseHandle(Token);
  180.     if psidAdmin <> nil then
  181.       FreeSid(psidAdmin);
  182.   end;
  183. end;
  184.  
  185. {$R+}
  186.  
  187. function IsUACEnabled: Boolean;
  188. var
  189.   Reg: TRegistry;
  190. begin
  191.   Result := CheckWin32Version(6, 0);
  192.   if Result then
  193.   begin
  194.     Reg := TRegistry.Create(KEY_READ);
  195.     try
  196.       Reg.RootKey := HKEY_LOCAL_MACHINE;
  197.       if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then
  198.         if Reg.ValueExists('EnableLUA') then
  199.           Result := (Reg.ReadInteger('EnableLUA') <> 0)
  200.         else
  201.           Result := False
  202.       else
  203.         Result := False;
  204.     finally
  205.       FreeAndNil(Reg);
  206.     end;
  207.   end;
  208. end;
  209.  
  210. function IsElevated: Boolean;
  211. const
  212.   TokenElevation = TTokenInformationClass(20);
  213. type
  214.   TOKEN_ELEVATION = record
  215.     TokenIsElevated: DWORD;
  216.   end;
  217. var
  218.   TokenHandle: THandle;
  219.   ResultLength: Cardinal;
  220.   ATokenElevation: TOKEN_ELEVATION;
  221.   HaveToken: Boolean;
  222. begin
  223.   if CheckWin32Version(6, 0) then
  224.   begin
  225.     TokenHandle := 0;
  226.     HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, TokenHandle);
  227.     if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
  228.       HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle);
  229.     if HaveToken then
  230.     begin
  231.       try
  232.         ResultLength := 0;
  233.         if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
  234.           Result := ATokenElevation.TokenIsElevated <> 0
  235.         else
  236.           Result := False;
  237.       finally
  238.         CloseHandle(TokenHandle);
  239.       end;
  240.     end
  241.     else
  242.       Result := False;
  243.   end
  244.   else
  245.     Result := IsAdministrator;
  246. end;
  247.  
  248. procedure SetButtonElevated(const AButtonHandle: THandle);
  249. const
  250.   BCM_SETSHIELD = $160C;
  251. var
  252.   Required: BOOL;
  253. begin
  254.   if not CheckWin32Version(6, 0) then
  255.     Exit;
  256.   if IsElevated then
  257.     Exit;
  258.  
  259.   Required := True;
  260.   SendMessage(AButtonHandle, BCM_SETSHIELD, 0, LPARAM(Required));
  261. end;
  262.  
  263. procedure CheckForElevatedTask;
  264.  
  265.   function GetArgsForElevatedTask: String;
  266.  
  267.     function PrepareParam(const ParamNo: Integer): String;
  268.     begin
  269.       Result := ParamStr(ParamNo);
  270.       if Pos(' ', Result) > 0 then
  271.         Result := AnsiQuotedStr(Result, '"');
  272.     end;
  273.  
  274.   var
  275.     X: Integer;
  276.   begin
  277.     Result := '';
  278.     for X := 1 to ParamCount do
  279.     begin
  280.       if (AnsiUpperCase(ParamStr(X)) = ('/' + RunElevatedTaskSwitch)) or
  281.          (AnsiUpperCase(ParamStr(X)) = ('-' + RunElevatedTaskSwitch)) then
  282.         Continue;
  283.  
  284.       Result := Result + PrepareParam(X) + ' ';
  285.     end;
  286.  
  287.     Result := Trim(Result);
  288.   end;
  289.  
  290. var
  291.   ExitCode: Cardinal;
  292. begin
  293.   if not FindCmdLineSwitch(RunElevatedTaskSwitch) then
  294.     Exit;
  295.  
  296.   ExitCode := ERROR_GEN_FAILURE;
  297.   try
  298.     if not IsElevated then
  299.       ExitCode := ERROR_ACCESS_DENIED
  300.     else
  301.     if Assigned(OnElevateProc) then
  302.       ExitCode := OnElevateProc(GetArgsForElevatedTask)
  303.     else
  304.       ExitCode := ERROR_PROC_NOT_FOUND;
  305.   except
  306.     on E: Exception do
  307.     begin
  308.       if E is EAbort then
  309.         ExitCode := ERROR_CANCELLED
  310.       else
  311.       if E is EOleSysError then
  312.         ExitCode := Cardinal(EOleSysError(E).ErrorCode)
  313.       else
  314.       if E is EOSError then
  315.       else
  316.         ExitCode := ERROR_GEN_FAILURE;
  317.     end;
  318.   end;
  319.  
  320.   if ExitCode = STILL_ACTIVE then
  321.     ExitCode := ERROR_GEN_FAILURE;
  322.   TerminateProcess(GetCurrentProcess, ExitCode);
  323. end;
  324.  
  325. end.
  326.  
  327. Usage:
  328.  
  329. unit Unit1;
  330.  
  331. interface
  332.  
  333. uses
  334.   Windows{....};
  335.  
  336. type
  337.   TForm1 = class(TForm)
  338.     Label1: TLabel;
  339.     Label2: TLabel;
  340.     Label3: TLabel;
  341.     Label4: TLabel;
  342.     Button1: TButton;
  343.     Button2: TButton;
  344.     procedure FormCreate(Sender: TObject);
  345.     procedure Button1Click(Sender: TObject);
  346.     procedure Button2Click(Sender: TObject);
  347.   private
  348.     procedure StartWait;
  349.     procedure EndWait;
  350.   end;
  351.  
  352. var
  353.   Form1: TForm1;
  354.  
  355. implementation
  356.  
  357. uses
  358.   RunElevatedSupport;
  359.  
  360. {$R *.dfm}
  361.  
  362. const
  363.   ArgInstallUpdate     = '/install_update';
  364.   ArgRegisterExtension = '/register_global_file_associations';
  365.  
  366. procedure TForm1.FormCreate(Sender: TObject);
  367. begin
  368.   Label1.Caption := Format('IsAdministrator: %s',        [BoolToStr(IsAdministrator, True)]);
  369.   Label2.Caption := Format('IsAdministratorAccount: %s', [BoolToStr(IsAdministratorAccount, True)]);
  370.   Label3.Caption := Format('IsUACEnabled: %s',           [BoolToStr(IsUACEnabled, True)]);
  371.   Label4.Caption := Format('IsElevated: %s',             [BoolToStr(IsElevated, True)]);
  372.  
  373.   Button1.Caption := 'Install updates';
  374.   SetButtonElevated(Button1.Handle);
  375.   Button2.Caption := 'Register file associations for all users';
  376.   SetButtonElevated(Button2.Handle);
  377. end;
  378.  
  379. procedure TForm1.Button1Click(Sender: TObject);
  380. begin
  381.   StartWait;
  382.   try
  383.     SetLastError(RunElevated(ArgInstallUpdate, Handle, Application.ProcessMessages));
  384.     if GetLastError <> ERROR_SUCCESS then
  385.       RaiseLastOSError;
  386.   finally
  387.     EndWait;
  388.   end;
  389. end;
  390.  
  391. procedure TForm1.Button2Click(Sender: TObject);
  392. begin
  393.   StartWait;
  394.   try
  395.     SetLastError(RunElevated(ArgRegisterExtension, Handle, Application.ProcessMessages));
  396.     if GetLastError <> ERROR_SUCCESS then
  397.       RaiseLastOSError;
  398.   finally
  399.     EndWait;
  400.   end;
  401. end;
  402.  
  403. function DoElevatedTask(const AParameters: String): Cardinal;
  404.  
  405.   procedure InstallUpdate;
  406.   var
  407.     Msg: String;
  408.   begin
  409.     Msg := 'Hello from InstallUpdate!' + sLineBreak +
  410.            sLineBreak +
  411.            'This function is running elevated under full administrator rights.' + sLineBreak +
  412.            'This means that you have write-access to Program Files folder and you''re able to overwrite files (e.g. install updates).' + sLineBreak +
  413.            'However, note that your executable is still running.' + sLineBreak +
  414.            sLineBreak +
  415.            'IsAdministrator: '        + BoolToStr(IsAdministrator, True) + sLineBreak +
  416.            'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
  417.            'IsUACEnabled: '           + BoolToStr(IsUACEnabled, True) + sLineBreak +
  418.            'IsElevated: '             + BoolToStr(IsElevated, True);
  419.     MessageBox(0, PChar(Msg), 'Hello from InstallUpdate!', MB_OK or MB_ICONINFORMATION);
  420.   end;
  421.  
  422.   procedure RegisterExtension;
  423.   var
  424.     Msg: String;
  425.   begin
  426.     Msg := 'Hello from RegisterExtension!' + sLineBreak +
  427.            sLineBreak +
  428.            'This function is running elevated under full administrator rights.' + sLineBreak +
  429.            '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 +
  430.            '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 +
  431.            sLineBreak +
  432.            'IsAdministrator: '        + BoolToStr(IsAdministrator, True) + sLineBreak +
  433.            'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
  434.            'IsUACEnabled: '           + BoolToStr(IsUACEnabled, True) + sLineBreak +
  435.            'IsElevated: '             + BoolToStr(IsElevated, True);
  436.     MessageBox(0, PChar(Msg), 'Hello from RegisterExtension!', MB_OK or MB_ICONINFORMATION);
  437.   end;
  438.  
  439. begin
  440.   Result := ERROR_SUCCESS;
  441.   if AParameters = ArgInstallUpdate then
  442.     InstallUpdate
  443.   else
  444.   if AParameters = ArgRegisterExtension then
  445.     RegisterExtension
  446.   else
  447.     Result := ERROR_GEN_FAILURE;
  448. end;
  449.  
  450. procedure TForm1.StartWait;
  451. begin
  452.   Cursor := crHourglass;
  453.   Screen.Cursor := crHourglass;
  454.   Button1.Enabled := False;
  455.   Button2.Enabled := False;
  456.   Application.ProcessMessages;
  457. end;
  458.  
  459. procedure TForm1.EndWait;
  460. begin
  461.   Cursor := crDefault;
  462.   Screen.Cursor := crDefault;
  463.   Button1.Enabled := True;
  464.   Button2.Enabled := True;
  465.   Application.ProcessMessages;
  466. end;
  467.  
  468. initialization
  469.   OnElevateProc := DoElevatedTask;
  470.   CheckForElevatedTask;
  471. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top