Guest User

runas Admin Elevated UAC ShellExecute Delphi

a guest
Nov 14th, 2013
2,050
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

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×