begin process at 2010 02 10 12:38:46
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Système

 > UTILITAIRE POUR LANCER UN PROGRAMME DEPUIS UN AUTRE COMPTE (RUN AS)

UTILITAIRE POUR LANCER UN PROGRAMME DEPUIS UN AUTRE COMPTE (RUN AS)


 Information sur la source

Note :
Aucune note
Catégorie :Système Classé sous :runas, administrateur, createprocesswithlogonw Niveau :Débutant Date de création :23/07/2008 Date de mise à jour :24/07/2008 21:02:30 Vu / téléchargé :6 069 / 365

Auteur : Forman

Ecrire un message privé
Commentaire sur cette source (26)
Ajouter un commentaire et/ou une note

 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

  • 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.
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.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
  • RunAs.dprTélécharger ce fichier [Réservé aux membres club]Voir ce fichier8 212 octets
  • RunAs.exe.renameTélécharger ce fichier [Réservé aux membres club]50 176 octets

Télécharger le zip


 Historique

23 juillet 2008 19:01:54 :
No comment
24 juillet 2008 11:30:10 :
Rajout de l'extension '.dll' au nom de librairie des fonctions importées, pour fonctionner sous Win 2000.
24 juillet 2008 21:02:31 :
Ajout d'une astuce amusante que je viens de trouver, pour que la console gère correctement les caractères accentués (ce que Delphi ne fait pas par défaut).

 Sources du même auteur

Source avec Zip TRADUCTION DE DOKAN EN DELPHI: UN DRIVER "USER-MODE" POUR DI...
Source avec Zip Source avec une capture TASK MANAGER EN MODE TEXTE (ÉMULATION MODE 03H)
Source avec Zip Source avec une capture CHRONOMÈTRE POUR LE THÉ
Source avec Zip Source avec une capture DÉMONSTRATION DE LA GESTION DES OBJETS EN MÉMOIRE PAR DELPHI...
Source avec Zip COMPOSANT RUNONCE: AUTORISER UN SEUL LANCEMENT D'UNE APPLICA...

 Sources de la même categorie

Source avec Zip Source avec une capture GLIBWMI VCL COMPONENT LIBRARY 1.6B par Neftali
Source avec Zip Source avec une capture UNITÉ DE SUPPORT VISTA par Bacterius
Source avec Zip Source avec une capture NETTOYEUR AUTOMATIQUE DE VOS DISQUES par diglas
Source avec Zip Source avec une capture LES VALUE'S FADERS par blueperfect
Source avec Zip Source avec une capture COUNTERS, UNITÉ DE CALCUL DE PERFORMANCE par Bacterius

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture UAC (USER ACCOUNT CONTROL) - EXÉCUTER UNE APPLICATION EN TAN... par ni69
Source avec Zip EXECUTER EN TEMPS QUE par fbalien
Source avec Zip Source avec une capture ETEINDRE PC A DISTANCE par elguevel

Commentaires et avis

Commentaire de Forman le 23/07/2008 19:08:57

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).

Commentaire de MAURICIO le 24/07/2008 10:39:08

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+

Commentaire de pascal99 le 24/07/2008 11:08:15

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

Commentaire de Forman le 24/07/2008 11:27:28

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       :-)

Commentaire de MAURICIO le 24/07/2008 11:31:33

Salut Forman,

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

A+

Commentaire de pascal99 le 24/07/2008 11:52:01

C'est a l'appel de RunProcessAs qu'il y a un pb.
A priori t est vide

Commentaire de Forman le 24/07/2008 12:13:12

Alors dans ce cas-là il faut peut-être remplacer PWideChar(wDomain) par nil dans l'appel de CreateProcessWithLogon
(si le "t" dont tu parles c'est bien la variable locale de la fonction RunProcessAs).

Commentaire de pascal99 le 24/07/2008 13:13:08

non, c'est le t de la procedure Main.

voici mes parametres : ---U mon_profil ---D EU ---P mon_mdp dir.exe

b etant equal a ParamCount (=7), t est vide.
en effet :
- SetLength(t,ParamCount-b)=0
- on ne passe jamais dans  for a:=b+1 to ParamCount do t[a-b-1]:=ParamStr(a);

Commentaire de Forman le 24/07/2008 13:27:46

Oui, mais ça ne devrait pas poser problème pour autant, le cas est prévu.

RunProcessAs devrait être lancée avec les paramètres suivants dans ton cas:
Command='dir.exe'
Parameters=[]
UserName='mon_profil'
Password='mon_mdp'
Domain=''
WorkingDirectory=''
Wait=false

Ensuite avec la séquence:
      wCommandLine:=Command;
      for a:=Low(Parameters) to High(Parameters) do
        wCommandLine:=wCommandLine+' '+FormatParam(Parameters[a]);
On a:
wCommandLine='cmd.exe'
(en effet Low(Parameters)=0 et High(Parameters)=-1 puisque le tableau est vide)

C'est peut-être là-dedans que se situe le problème:
      if Domain='' then begin
        n:=SizeOf(t);
        if not GetComputerNameW(t,n) then
          OSError('Could not get computer name');
        wDomain:=t;
      end
Si la fonction GetComputerNameW n'a pas fonctionné correctement (exemple: pas de zéro terminal à la fin de la chaine) l'affectation wDomain=t peut poser problème.

Est-ce que tu peux essayer, si tu as le temps, de changer:
  t:array[0..MAX_PATH] of WideChar;
en:
  t:array[0..MAX_PATH] of Char;
et de remplacer:
GetComputerNameW(t,n)
par:
GetComputerName(t,n)
(sans le W donc, comme la version unicode)

Je ne vois pas trop à part ça ce qui pourrait causer une violation d'accès en lecture.

Commentaire de pascal99 le 24/07/2008 13:39:51

Ca ne change rien (exactement la meme erreur)
en mode debug, l'erreur se produit sur le Begin de RunProcessAs.

function RunProcessAs(Command:string;Parameters:array of string;Username,Password:string;Domain:string='';WorkingDirectory:string='';Wait:Boolean=False):Cardinal;

var
  a:Integer;
  n:Cardinal;
  h:THandle;
  p:Pointer;
  PI:TProcessInformation;
  SI:TStartupInfo;
  //t:array[0..MAX_PATH] of WideChar;
  t:array[0..MAX_PATH] of Char;
  wUser,wDomain,wPassword,wCommandLine,wCurrentDirectory:WideString;
begin                                              <-- ici
Writeln('Debug');
Sleep(10000);
  ZeroMemory(@PI,SizeOf(PI));
  ZeroMemory(@SI,SizeOf(SI));
...

Commentaire de Forman le 24/07/2008 13:55:55

Dans ce cas la seule explication que je vois c'est que l'erreur vient du code avant d'appeler RunProcessAs. Si tu as le temps, pourrais-tu remplacer l'appel à la fonction main (tout à la fin du programme, dans le begin...end principal) par l'appel à cette fonction-là, après avoir renseigné le bon user/pass, et me dire ce qui se passe:

procedure Main2;
var
  t:array of string;
  Username,Password,Domain,WorkingDir:string;
begin
  Username:='...';
  Password:='...';
  Domain:='';
  WorkingDir:='';
  SetLength(t,0);
  RunProcessAs('dir.exe',t,Username,Password,Domain,WorkingDir);
end;

J'ai essayé avec ta ligne de commande (---U mon_profil ---D EU ---P mon_mdp dir.exe) et pourtant chez moi ça fonctionne nickel

Commentaire de Forman le 24/07/2008 13:57:10

ah oui, et aussi avec celle ci:

procedure Main3;
var
  Username,Password,Domain,WorkingDir:string;
begin
  Username:='...';
  Password:='...';
  Domain:='';
  WorkingDir:='';
  RunProcessAs('dir.exe',['/?'],Username,Password,Domain,WorkingDir);
end;

Commentaire de pascal99 le 24/07/2008 14:21:31

Main2 et Main3 : plus de plantage mais j'ai une autre erreur :
Error: Could not log user in
Le client ne dispose pas d'un privilÞge nÚcessaire.


Commentaire de Forman le 24/07/2008 14:27:45

L'erreur dont tu parles est normale je pense.

Donc vraisemblablement l'erreur se situe dans le parsing des arguments. Je vais relire attentivement et peut-être en faire une autre version. Ceci dit, j'ai peur que le problème vienne d'une spécifité de Win2k au niveau de la génération des ParamCount/ParamStr depuis la ligne de commande.

Commentaire de pascal99 le 24/07/2008 14:39:12

Si ca peux t'aider :
ParamCount=7
ParamStr(0): C:\Delphi\RUN-AS\RunAs.exe
ParamStr(1): ---U
ParamStr(2): mon_profil
ParamStr(3): ---D
ParamStr(4): EU
ParamStr(5): ---P
ParamStr(6): mon_mdp
ParamStr(7): dir.exe

Commentaire de pascal99 le 24/07/2008 15:28:04

Dans Main j'ai mis des writeln des variables juste avant l'appel a RunProcessAs

    writeln('ParamStr(b): ',ParamStr(b));
    writeln('Username: ',Username);
    writeln('Password: ',Password);
    writeln('Domain: ',Domain);
    writeln('WorkingDir: ',WorkingDir);
    ExitCode:=RunProcessAs(ParamStr(b),t,Username,Password,Domain,WorkingDir);

ParamStr(b): dir.exe
Username: mon_profil
Password: mon_mdp
Domain: EU
WorkingDir:
Error: Violation d'accÞs Ó l'adresse 00403998 dans le module 'RunAs.exe'. Lecture de l'adresse FFFFFFF7

Commentaire de Forman le 24/07/2008 15:44:14

J'ai fait un "fix" de ParamStr et ParamCount au cas où le problème viendrait de là. Si tu mets ça en début de programme ça remplacera les fonctions existantes de Delphi.

var
  GCommandLine:array of string;
  GCommandLineParsed:Boolean=False;

procedure ParseCommandLine;
(*
  Parse program command-line and extract arguments, strip quotes.
*)
var
  s:string;
  p:PChar;
  c:Char;
  t,u:Boolean;

  procedure AddCurrentString;
  begin
    SetLength(GCommandLine,High(GCommandLine)+2);
    GCommandLine[High(GCommandLine)]:=s;
    s:='';
  end;

begin
  if GCommandLineParsed then
    Exit;
  p:=GetCommandLine;
  s:='';
  t:=False;
  u:=False;
  SetLength(GCommandLine,0);
  repeat
    c:=p^;
    case c of
      #0..' ':begin
        if u and not t then
          AddCurrentString;
        u:=False;
      end;
      '''','"':begin
        if t then
          AddCurrentString;
        t:=not t;
        u:=False;
      end;
    else
      s:=s+c;
      u:=True;
    end;
    Inc(p);
  until c=#0;
  GCommandLineParsed:=True;
end;

function ParamCount:Integer;
(*
  Fix for Win2000
*)
begin
  ParseCommandLine;
  Result:=High(GCommandLine);
end;

function ParamStr(const Index:Integer):string;
(*
  Fix for Win2000
*)
begin
  ParseCommandLine;
  Assert((Index>=0) and (Index<=High(GCommandLine)),'Invalid parameter index ('+IntToStr(Index)+')');
  Result:=GCommandLine[Index];
end;

Autre piste: peut-être que c'est le ExitCode:= qui pose problème. As-tu essayé de faire seulement
RunProcessAs(ParamStr(b),t,Username,Password,Domain,WorkingDir);
?

Commentaire de pascal99 le 24/07/2008 16:21:44

Exactement la meme erreur que ce soit avec la 1ere piste, la 2eme ou les 2 en meme temps.

Je doit t'avouer que je n'y comprends rien car dans Main, juste avant l'appel a RunProcessAs j'ai forcé toutes les variables comme dans Main2 et j'ai tj la meme erreur :-(

Commentaire de Forman le 24/07/2008 16:41:40

C'est vraiment incompréhensible. Peut-être un bug du compilateur pour le code qui s'occupe du passage des paramètres à la fonction?

Essaie peut-être de passer les paramètres à la fonction RunProcessAs en tant que 'var' ou 'const' (surtout le array of string). Ou même de changer la convention d'appel (stdcall).

Et avec l'exe compilé que j'ai mis dans le zip, ça plante aussi?

Commentaire de pascal99 le 24/07/2008 18:55:52

la je suis sur une machine en Vista SP1 et ca fonctionne nickel avec le prog actuellement dans le zip.
Pour le Win2K, je ne pourrais retester que lundi.

En attendant, bon week-end.
Pascal99

Commentaire de Forman le 24/07/2008 19:39:40

Bon week-end toi aussi, et merci pour ton aide.

Forman

Commentaire de pascal99 le 28/07/2008 09:49:26

Bonjour Forman,
1) j'ai essayé avec ton .exe sous Win2K et il n'y a plus le plantage.
Tu as compilé ton prog avec quelle version ? (moi c'etait avec Delphi Pro 5).

2) Maintenant, quelque soit le profil que j'utilise, le message d'erreur est :
Error: Could not log user in
Le client ne dispose pas d'un privilÞge nÚcessaire.

Win2K n'a pas l'air d'aimer to prog.

a+
Pascal99


Commentaire de Forman le 28/07/2008 12:48:54

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

Commentaire de pascal99 le 28/07/2008 13:10:48

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

Commentaire de Forman le 28/07/2008 13:18:19

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

Commentaire de Forman le 28/07/2008 13:24:54

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

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Administrateur BDE & Access [ par Vinch ] Salut à tous,J'ai créer une BD sous Access2002 (XP) et je l'ai convertie au format 97, puis j'ai créer un alias avec un driver natif MSACCESS. Tout s' A propos du Intraweb & Delphi 7 [ par cboulhrouz ] Bonjour, J'ai un problème, je developpe un site en utilisant le composant Intraweb du Delphi 7 en utilisant une base de données MS Access, j'ai d administrateur bde [ par yoghisan ] Voulant m'initier aux bases de donnees, j'ai trop par hazard un site faisant une initiation.http://www.iglooduhack.com/delphi_bdd_conn_bde.phpEt je su interaction entre la console de commande et une appli Delphi [ par emmanuelgo ] salut &#224; tous.je souhaite cr&#233;er une application en delphi qui lance une commade dans la console de commande...jusque l&#224; tou va bien grac administrateur BDE [ par koaiz ] Salut les mecs Peut-on utiliser une application qui comporte des table de base de donnee sans avoire a installer l'administrateur BDE dans la machinep Administrateur BDE [ par trezeled ] Bonjour,Je dois installer une application utilisant des bases Paradox à des utilisateurs, pour ces bases j'utilise des alias défini dans l'administrat réseau [ par zerouti ] salut tous le monde, j'ai devlopper une appliaction de masterisation (elle mermet à l'administrateur de donnée les périphériques, ou bloquer, les appl Session administrateur [ par PHIL63 ] Bonsoir à tous et bonne année :)J'aurais aimé connaitre la méthode pour savoir si un utilisateur utilise une session administrateur ou bien si il util Développement sur 2 comptes un administrateur l'autre utilisateur simple [ par yvessimon ] Bonjour, J'ai pris l'habitude de développer sur le compte administrateur du PC. Je viens de créer un compte utilisateur pour d'autres développements. Droits administrateur limités [ par AEC1 ] Bonjours, j'ai installé une application base de données paradox7 sur une machine qui est reliée à un réseau Intranet d'entreprise. pas de problème pou


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,796 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales