Utilitaire pour lancer un programme depuis un autre compte (run as)

Soyez le premier à donner votre avis sur cette source.

Vue 22 335 fois - Téléchargée 827 fois

Description

J'avoue que ce n'est guère innovant mais si comme moi vous êtes un parano de la sécurité et que vous utilisez un compte à droits limités dans votre vie de tous les jours il peut être utile d'avoir ce petit utilitaire pour lancer un programme en tant qu'utilisateur d'un autre compte.

Il est prévu pour fonctionner en ligne de commande, typiquement dans un batch, pour lancer des programmes qui nécessitent des privilèges administrateurs sans avoir à se fatiguer à ouvrir une session admin. Voici la grammaire d'usage (les arguments entre crochets sont optionnels):
RunAs [---U Username] [---D Domain] [---P Password] [---W WorkingDirectory] Command [Params]

Exemple, pour lancer une défragmentation depuis un compte restreint (cette solution demande explicitement le mot de passe puisqu'il n'est pas spécifié avec ---P):
C:\Delphi\Sources\RunAs.exe ---U Administrateur "C:\Program Files\Defraggler\Defraggler.exe"

Tous les arguments situés après le nom de la commande sont passés en arguments à la commande. Par exemple, pour lancer une invite de commande sur le disque D:
RunAs ---U Administrateur ---P MotDePasse cmd /K d:

Si on ne précise ni le username, ni le password ils seront demandés (le password sera masqué, puisque vraisemblablement c'est le but recherché dans ce cas-là).

Pour les feignants j'ai mis l'exe compilé, il faudra bien sûr changer son extension.

Source / Exemple :


program RunAs;

{$APPTYPE CONSOLE}

uses
  SysUtils,Windows,StrUtils;

const
  LOGON_WITH_PROFILE=$00000001;

function CreateProcessWithLogon(lpUsername        :PWideChar;
                                lpDomain          :PWideChar;
                                lpPassword        :PWideChar;
                                dwLogonFlags      :DWORD;
                                lpApplicationName :PWideChar;
                                lpCommandLine     :PWideChar;
                                dwCreationFlags   :DWORD;
                                lpEnvironment     :Pointer;
                                lpCurrentDirectory:PWideChar;
                                var lpStartupInfo :TStartupInfo;
                                var lpProcessInfo :TProcessInformation):BOOL;stdcall;external 'advapi32.dll' name 'CreateProcessWithLogonW';

function CreateEnvironmentBlock(var lpEnvironment:Pointer;hToken:THandle;bInherit:BOOL):BOOL;stdcall;external 'userenv.dll';
function DestroyEnvironmentBlock(pEnvironment:Pointer):BOOL;stdcall;external 'userenv.dll';

function TextOut(var t:TTextRec):Integer;
(*
  Hack to fix the standard TextOut proc shipped with Delphi, that correctly handles non-standard character sets
  for console output (eg 'é' 'ç' etc...)

  • )
var Dummy:Cardinal; begin CharToOem(t.Buffer,t.Buffer); if t.BufPos=0 then Result:=0 else begin if WriteFile(t.Handle,t.BufPtr^,t.BufPos,Dummy,nil) then Result:=0 else Result:=GetLastError; t.BufPos:=0; end; end; procedure FixupConsoleCharset; (* Activate console hack for non-standard characters
  • )
begin Write(''); TTextRec(Output).FlushFunc:=@TextOut; end; procedure Error(s:string); begin raise Exception.Create(s); end; procedure OSError(s:string); (* Raise the last system error with an additional prefix message
  • )
begin raise Exception.Create(s+#13#10+SysErrorMessage(GetLastError)); end; function FormatParam(s:string):string; (* Enclose into quotes (if not already) the string if it contains white space and return it, otherwise return the string itself.
  • )
var a:Integer; t:Boolean; begin Result:=s; t:=False; for a:=Length(s) downto 1 do if s[a] in [' ',#32] then begin t:=True; Break; end; if t and not (s[1] in ['''','"']) then Result:='"'+s+'"'; end; function RunProcessAs(Command:string;Parameters:array of string;Username,Password:string;Domain:string='';WorkingDirectory:string='';Wait:Boolean=False):Cardinal; (* Execute the Command with the given Parameters, Username, Domain, Password and Working Directory. Parameters containing white spaces are automatically embraced into quotes before being sent to avoid having them splitted by the system. If either Domain or Working Directory are empty the current one will be used instead. If Wait is specified the function will wait till the command is completely executed and will return the exit code of the process, otherwise zero. Suitable Delphi exceptions will be thrown in case of API failure.
  • )
var a:Integer; n:Cardinal; h:THandle; p:Pointer; PI:TProcessInformation; SI:TStartupInfo; t:array[0..MAX_PATH] of WideChar; wUser,wDomain,wPassword,wCommandLine,wCurrentDirectory:WideString; begin ZeroMemory(@PI,SizeOf(PI)); ZeroMemory(@SI,SizeOf(SI)); SI.cb:=SizeOf(SI); if not LogonUser(PChar(Username),nil,PChar(Password),LOGON32_LOGON_INTERACTIVE,LOGON32_PROVIDER_DEFAULT,h) then OSError('Could not log user in'); try if not CreateEnvironmentBlock(p,h,True) then OSError('Could not access user environment'); try wUser:=Username; wPassword:=Password; wCommandLine:=Command; for a:=Low(Parameters) to High(Parameters) do wCommandLine:=wCommandLine+' '+FormatParam(Parameters[a]); if Domain='' then begin n:=SizeOf(t); if not GetComputerNameW(t,n) then OSError('Could not get computer name'); wDomain:=t; end else wDomain:=Domain; if WorkingDirectory='' then wCurrentDirectory:=GetCurrentDir else wCurrentDirectory:=WorkingDirectory; if not CreateProcessWithLogon(PWideChar(wUser),PWideChar(wDomain),PWideChar(wPassword),LOGON_WITH_PROFILE,nil,PWideChar(wCommandLine),CREATE_UNICODE_ENVIRONMENT,p,PWideChar(wCurrentDirectory),SI,PI) then OSError('Could not create process'); try if Wait then begin WaitForSingleObject(PI.hProcess,INFINITE); if not GetExitCodeProcess(PI.hProcess,Result) then OSError('Could not get process exit code'); end else Result:=0; finally CloseHandle(PI.hProcess); CloseHandle(PI.hThread); end; finally DestroyEnvironmentBlock(p); end; finally CloseHandle(h); end; end; function FindStr(s:string;t:array of string):Integer; (* Return the (case-insensitive) index of s into the array t, otherwise -1
  • )
var a:Integer; begin Result:=-1; for a:=Low(t) to High(T) do if AnsiUpperCase(t[a])=AnsiUpperCase(s) then begin Result:=a; Exit; end; end; function WaitChar:Char; (* Wait till a character is typed in the console, and return its value
  • )
var h:THandle; n:Cardinal; r:TInputRecord; begin h:=GetStdHandle(STD_INPUT_HANDLE); repeat ReadConsoleInput(h,r,1,n); until (n=1) and (r.EventType=KEY_EVENT) and (r.Event.KeyEvent.bKeyDown); Result:=r.Event.KeyEvent.AsciiChar; end; function ReadlnMasked(var s:string):Boolean; (* Read a string from the console input with masked characters, till either ENTER or ESCAPE is given. Return True if that was ENTER.
  • )
var c:Char; const EndChars:set of char=#13,#27; begin s:=''; repeat c:=WaitChar; if not (c in EndChars) then begin s:=s+c; Write('*'); end; until c in EndChars; Result:=c=#13; WriteLn; end; procedure Main; (* Main program, parse and process arguments, print usage if no arguments, ask for username or password if not specified and launch the desired process
  • )
var a,b:Integer; t:array of string; Username,Password,Domain,WorkingDir:string; function ExtractNext:string; (* Extract the next command-line argument, in respect of the previous flag
  • )
begin Inc(b); if b>ParamCount then raise Exception.Create('Missing argument after '+ParamStr(b-1)); Result:=ParamStr(b); end; procedure Parse; (* Parse the command-line flags
  • )
var t:Boolean; begin t:=True; while t and (b<=ParamCount) do begin case FindStr(ParamStr(b),['---U','---P','---D','---W']) of 0:Username:=ExtractNext; 1:Password:=ExtractNext; 2:Domain:=ExtractNext; 3:WorkingDir:=ExtractNext; else t:=False; end; if t then Inc(b); end; if b>ParamCount then raise Exception.Create('Missing command name'); end; begin if ParamCount=0 then begin WriteLn('Usage: ',ChangeFileExt(ExtractFileName(ParamStr(0)),''),' [---U Username] [---D Domain] [---P Password] [---W WorkingDirectory] Command [Params]'); ExitCode:=0; Exit; end; b:=1; Username:=''; Password:=''; Domain:=''; WorkingDir:=''; Parse; if Username='' then begin Write('Username: '); ReadLn(Username); end; if Password='' then begin Write('Password for ',Username,': '); if not ReadLnMasked(Password) then Error('Aborted'); end; SetLength(t,ParamCount-b); try for a:=b+1 to ParamCount do t[a-b-1]:=ParamStr(a); ExitCode:=RunProcessAs(ParamStr(b),t,Username,Password,Domain,WorkingDir); finally SetLength(t,0); end; end; begin ExitCode:=-1; try FixupConsoleCharset; Main; except on e:Exception do begin WriteLn('Error: ',e.Message); WriteLn('(Press any key to continue)'); WaitChar; end; end; end.

Conclusion :


Rien de compliqué au niveau de la programmation, niveau débutant.

Si ça intéresse quelqu'un il y a une fonction équivalente à Readln pour les strings, mais qui affiche des étoiles à la place des caractères tapés.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Forman
Messages postés
663
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1 -
J'ai oublié de le préciser: il faut au moins Win NT ou XP pour que ça fonctionne (je ne sais pas si ça marche toujours sous vista). En outre, il n'est pas possible de lancer en même temps plusieurs commandes d'un autre compte avec ce système (il faut attendre que la première soit terminée avant d'en lancer une autre).
cs_MAURICIO
Messages postés
2233
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5 -
Salut Forman,

je trouve la source interessante (c' est très bien écrit) même si je log toujours en admin.
Ça va servir en tout cas pour les mordus de la sécu.

A+
cs_pascal99
Messages postés
26
Date d'inscription
mercredi 10 septembre 2003
Statut
Membre
Dernière intervention
20 janvier 2009
-
Bonjour,
j'ai testé ton prog en Win2K et il me dit que "userenv" est introuvable.
En effet il manque les ".dll" dans les external.

Une fois recompilé, a l'execution d'une commande dir j'ai le message :
Error: Violation d'accÞs Ó l'adresse 00403908 dans le module 'RunAs.exe'. Lecture de l'adresse FFFFFFF7
cs_Forman
Messages postés
663
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1 -
Mauricio: Merci. Moi j'ai arrêté définitivement le mode admin depuis que j'ai vu que ça rendait 99.99% des virus et assimilés inopérants. J'ai déjà fait le test de lancer des exe infectés depuis un compte restreint, parfois le PC plante mais jamais le truc n'a eu la possibilité de s'installer durablement. Et une fois que tu as bien configuré les différentes permissions d'accès en fonction de l'usage que tu souhaites sur ton compte restreint, ça reste quand même raisonnablement pratique.

Pascal: Bonjour,
je n'ai pas la possibilité de tester sous Win2K chez moi. Est-ce que tu as des détails sur l'endroit où se produit la violation?

Par exemple en rajoutant
Writeln('Debug');
Sleep(10000);
au tout début de la fonction RunProcessAs, est-ce que tu le vois s'afficher dans la console ou est-ce que ça plante avant?

Merci pour les '.dll' déjà en tout cas :-)
cs_MAURICIO
Messages postés
2233
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5 -
Salut Forman,

je suis tout à fait d' accord avec toi, c' est juste une mauvaise habitude ^^

A+

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.