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

Soyez le premier à donner votre avis sur cette source.

Vue 22 728 fois - Téléchargée 872 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

Messages postés
213
Date d'inscription
dimanche 5 janvier 2003
Statut
Membre
Dernière intervention
6 janvier 2011
1
Bon binnnnnnnnn ça marche pas chez moi non plus pourtant cela m'aurait été for utile, j'ai quand même 2 warning à la compilation sur des variables non trouvés
Dommage dites moi si vous avez du mieux....
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
Je viens de chercher sur Google des infos concernant CreateProcessWithLogon et win2k et en résumé j'ai pu lire plusieurs fois:
"it works on a w2k workstation, but doesnt work on a win2k server"

On peut apparemment arriver à faire fonctionne LogonUser (chez toi ça ne passe même pas ce stade) en changeant les stratégies locales de sécurité dans le panneau de configuration, mais CreateProcessWithLogonW ne fonctionne pas pour autant. J'ai aussi lu que quelqu'un aurait peut-être réussi en créant un service à la place.

A++, Forman
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
Là je crois que tu as à peu près tout essayé... effectivement la conclusion ça doit être que ça ne marche pas sous win2k :-(

A++, Forman
Messages postés
24
Date d'inscription
mercredi 10 septembre 2003
Statut
Membre
Dernière intervention
20 janvier 2009

Le win2K est sur mon PC au boulot. Nous sommes sur le domaine EU (Europe)
- Si je ne mets pas le nom de domaine : meme message.
- Si je ne mets pas de domaine mais qu'en utilisateur de mets domaine/utilisateur, domaine\utilisateur ou utilisateur@domaine : meme message.
- Si je prends un profil administrateur local (sur mon PC) que ce soit avec en domaine le nom de mon PC ou sans domaine : meme message.

Je ne sais plus quoi tester. Si tu as une idée...

a+ Pascal
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
Bonjour Pascal99,

Pour le 1) il semblerait donc que depuis le début ce soit un bug du compilateur! Dans ce cas-là, un truc tout bête: essaie de désactiver les optimisations dans les options su projet. Parfois j'ai eu de grosses surprises comme ça. Pour info j'utilise Delphi 7.

Pour le 2) j'ai vu que tu spécifiais explicitement le nom de domaine. Que se passe-t-il si tu ne le mets pas? Il faut prendre garde aussi que les mots de passe doivent être case-sensitive.

A bientôt
Forman
Afficher les 27 commentaires

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.