win serlo por ejecutar ejecuta desde cómo como carpeta cambiar administrador abrir delphi delphi-2010

delphi - serlo - ejecutar cmd como administrador windows 10



usar shell ejecute para ejecutar cmd como administrador (4)

Necesito ejecutar cmd en un botón, haga clic como administrador. Funciona. Pero necesito ejecutarlo como un administrador. ¿Cómo se hace esto?

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


Este es un código de ejemplo para usar ShellExecute + runas para ejecutar rutinas elevadas (es decir, bajo la cuenta de administrador completo). Debería funcionar con UAC habilitado / deshabilitado + en versiones anteriores de Windows (antes de 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.

Uso:

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.


Reemplace el verbo open con las runas como se muestra a continuación. De todos modos, trata de evitar la codificación de rutas:

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

También puede agregar a su botón el ícono del escudo configurando la propiedad ElevationRequired en True.


ShellExecute/Ex() con el verbo "runas" es la única forma oficial de iniciar un proceso elevado programable, especialmente si el ejecutable que se está ejecutando no tiene su propio manifiesto UAC para invocar elevación.

Sin embargo, esa no es la única manera de comenzar un proceso elevado. Eche un vistazo al siguiente artículo, que explica en detalle la elevación y ofrece implementaciones alternativas, como CreateProcessElevated() y ShellExecuteElevated() , que son más flexibles:

Vista UAC: La Guía Definitiva


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;

// Ejemplo

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