Discussion :

[sevyc64]

Salut à tous,

Je tente de faire fonctionner un bout de code sous D2010, mais je n'y arrive pas. Le but est de lancer un exécutable externe avec récupération, au moins, du code retour.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function RunWithExitCode ( CommandLine : String ) : LongWord ;
var
PipeIn : THandle;
PiPeOut : THandle;
Security : TSecurityAttributes;
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
Buffer:array[0..4096] of Char;
NbRead:DWORD;
txt:Tstrings;
cmd:string;
 
begin
 cmd := commandline;
 With Security do begin
   nlength := SizeOf(TSecurityAttributes) ;
   binherithandle := true;
   lpsecuritydescriptor := nil;
  end;
  CreatePipe(PipeIn,PiPeOut,@Security,0);
  FillChar(StartupInfo, SizeOf(TStartupInfo),0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow := SW_SHOW;
  StartupInfo.hStdInput := PipeIn;
  StartupInfo.hStdOutput:= PiPeOut;
  StartupInfo.hStdError := PiPeOut;
  CreateProcess(nil,PChar(cmd),nil,nil,false,0,nil,nil,StartupInfo,ProcessInfo);
  WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
  CloseHandle(PiPeOut);
  while ReadFile(PipeIn,Buffer,4096,NbRead,nil) do txt.Add(Buffer);
  CloseHandle(PipeIn);
End;

Je me mange systématiquement une exception de violation d’accès à l’exécution de CreateProcess

Violation d'accès à l'adresse 7784B733 dans le module 'kernel32.dll'. Ecriture de l'adresse 004F03BC

Je n'arrive pas à comprendre d'où ça vient.
J'ai pourtant l'habitude (mais pas en Delphi) d'utiliser CreateProcess, j'ai pas souvenir d'avoir déjà buter sur ce problème.

j'avais aussi testé ce code, mais c'est identique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Var
   StartupInfo : TStartupInfo;
   ProcessInfo : TProcessInformation;
Begin
  FillChar(StartupInfo,SizeOf(StartupInfo),#0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  If Not CreateProcess( nil, PChar(CommandLine), nil, nil, True, 0, Nil, Nil, StartupInfo, ProcessInfo) Then
    RaiseLastOSError;
  // Attente de la fin du processus.
  WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
  // Récupération du code de sortie.
  GetExitCodeProcess(ProcessInfo.hProcess,Result);

L'appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  cmd := 'C:\Windows\notepad.exe';
  memo1.Lines.Append(IntToStr(runwithexitcode(cmd)));

Notepad n'est qu'un exemple. Le logiciel devra fonctionner aussi bien sur plateforme 32 bits que 64 bits, et lancer aussi bien des applications 32 que 64 bits (notamment le gbak et gfix de firebird).

[Andnotor]

Je pense que le problème vient de STARTF_USESTDHANDLES. Dans le premier cas, tu crées les pipes mais sans définir bInheritHandles à TRUE et dans le deuxième cas, tu fais l'inverse.

Mais pour avoir simplement le code de sortie, ceci suffit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
function RunAndWait(const AppName :string; const Params :string = ''; const ShowWindow :word = SW_SHOW) :Cardinal;
var
  ProcessInfo :TProcessInformation;
  StartupInfo :TStartupInfo;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.wShowWindow := ShowWindow;
 
  if CreateProcess(nil, PChar(AppName +' '+Params), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then
  begin
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  end
  else Result := 0;  //ou autre
end;

ou par ShellExecuteEx :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
function RunAndWait(aVerb, aApp, aParams :string; aShow :integer): cardinal;
var
  Info: TShellExecuteInfo;
 
begin
  FillChar(Info, SizeOf(Info), 0) ;
  Info.cbSize       := SizeOf(TShellExecuteInfo);
  Info.fMask        := SEE_MASK_NOCLOSEPROCESS;
  Info.lpFile       := PChar(aApp);
  Info.lpParameters := PChar(aParams);
  Info.lpVerb       := PChar(aVerb);
  Info.nShow        := aShow;
 
  if ShellExecuteEx(@Info) then
  begin
    WaitForSingleObject(Info.hProcess, INFINITE);
    GetExitCodeProcess(Info.hProcess, Result);
    CloseHandle(Info.hProcess);
  end
  else Result := 0;
end;

[sevyc64]

Ok, je regarderais tes codes demain.

Pour le coup des flags, au départ j'étais parti sur le second code que j'ai donné, et sans aucun flags, mais j'avais aussi la même erreur. Donc pas sur que ça vienne de là.

Par contre, j'ai essayé mes codes, les deux, sur exactement les mêmes machines, mais compilé avec Delphi 6, et là ça passe. Du coup je m'oriente plus, à l'intuition, vers un problème de droit ou de sécurité mais sans avancer pour autant

[sevyc64]

Bon, j'ai un peu de nouveau. La solution avec ShellExecute marche à un détail près, je ne récupère pas les messages d'erreurs que les applis lancées peuvent laisser. Car je suis devant un cas particulier avec GFix notamment, qui me renvoie un code 0 (pas d'erreur) mais qui pourtant affiche un message de base corrompu.


Je suis donc reparti sur CreateProcess avec le code ci-dessous. Ce matin, ce code veut marcher sauf que je récupère pas mon texte, je récupère des caractères chinois à la place. Et ce sur toutes les machines testées pour le moment
(compilation sous Delphi 10, pas testé sous Delphi 6)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Function RunWithExitCode ( const app,params : String ) : LongWord ;
var
PipeIn : THandle;
PiPeOut : THandle;
Security : TSecurityAttributes;
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
Buffer:array[0..4096] of Char;
NbRead:DWORD;
cmd:string;
 
begin
  FillChar(buffer, SizeOf(buffer),0);
  cmd := app + ' ' + params;
 
 With Security do begin
   nlength := SizeOf(TSecurityAttributes) ;
   binherithandle := true;
   lpsecuritydescriptor := nil;
  end;
  CreatePipe(PipeIn,PiPeOut,@Security,0);
  FillChar(StartupInfo, SizeOf(TStartupInfo),0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow := SW_SHOW;
  StartupInfo.hStdInput := PipeIn;
  StartupInfo.hStdOutput:= PiPeOut;
  StartupInfo.hStdError := PiPeOut;
  if CreateProcess(nil,PChar(cmd),nil,nil,true,0,nil,nil,StartupInfo,ProcessInfo) then
  begin
    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,Result);
    CloseHandle(PiPeOut);
  end
  else
  begin
     memolog.Lines.Add('Echec lancement application, code erreur : ' + IntToStr(GetLastError));
    Result := 999999;
  end;
  while ReadFile(PipeIn,Buffer,4096,NbRead,nil) do
    memolog.Lines.Add(Buffer);
  CloseHandle(PipeIn);
End;

[Andnotor]

Char est Unicode par défaut depuis D2009. Déclare le buffer en AnsiChar.

[sevyc64]

Bien vu

Il me reste plus qu'à gérer les cas ou il n'y a pas d'erreur en apparence, mais en apparence seulement. Mais ça c'est une autre histoire.