1. 技术文章
  2. use shell execute to run cmd as Admin

use shell execute to run cmd as Admin

由 江枫思渺然 提交于 2019-12-20 17:29:14

问题


I need to run cmd on a button click as admin. It works. but I need to run it as an admin. How is this done?

 ShellExecute(Handle, 'open', 'c:\Windows\system32\cmd.exe', nil, nil, SW_SHOWNORMAL)

回答1:


Replace the open verb with the runas as shown below. Anyway, try to avoid path hardcoding:

uses
  ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'runas', 'cmd.exe', nil, nil, SW_SHOWNORMAL);
end;

You can also add to your button the shield icon by setting the ElevationRequired property to True.




回答2:


ShellExecute/Ex() with the "runas" verb is the only official way to start an elevated process programmably, especially if the executable being run does not have its own UAC manifest to invoke elevation.

However, that is not the only way to start an elevated process. Have a look at the following article, which explains elevation in detail and offers alternative implementations, like CreateProcessElevated() and ShellExecuteElevated(), which are more flexible:

Vista UAC: The Definitive Guide




回答3:


This is sample code to use ShellExecute + runas to run routines elevated (i.e. under full administrator account). It should work with both UAC enabled/disabled + in older Windows versions (before Windows Vista).

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.

Usage:

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.



回答4:


uses ShellApi, ...;

function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
var
  sei: TShellExecuteInfoA;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := Handle;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PAnsiChar(Path);
  sei.lpParameters := PAnsiChar(Params);
  sei.nShow := SW_SHOWNORMAL;
  Result := ShellExecuteExA(@sei);
end;

// Example

RunAsAdmin(Handle, 'c:\Windows\system32\cmd.exe', '');


来源：https://stackoverflow.com/questions/15319158/use-shell-execute-to-run-cmd-as-admin

标签
Delphi
delphi-2010
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!