Tester si un process est actif et l'arrêter

Version imprimable

14/08/2022, 15h21
sematimo

Tester si un process est actif et l'arrêter

Bonjour à tous,

Je voudrais savoir comment tester si un process est actif et si oui comment l'arrêter.

Sous Windows, ça passe par l'énumération des processus, la récupération de la tâche principale (la première trouvée) du(des) processus souhaité(s) et une demande d'arrêt de cette tâche par WM_QUIT qui nous fait sortir proprement de sa boucle de messages.

Code:

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
44
45
46
47
procedure KillProcesses(aFileName: string);
var
  Handle  :THandle;
  Process :TProcessEntry32;
  Thread  :TThreadEntry32;
 
begin
  aFileName := ExtractFileName(aFileName);
 
  Process.dwSize := SizeOf(TProcessEntry32);
  Thread.dwSize  := SizeOf(TThreadEntry32);
 
  Handle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD, 0);
 
  if Handle <> INVALID_HANDLE_VALUE then
  try
    // Enumération des processus
    if Process32First(Handle, Process) then
    repeat
      // Trouvé ?
      if not SameText(Process.szExeFile, aFileName) then Continue;
 
      // Enumération des tâches
      if Thread32First(Handle, Thread) then
      repeat
        // Est-ce qu'elle appartient au processus ?
        if Thread.th32OwnerProcessID <> Process.th32ProcessID then Continue;
 
        // Arrêt propre de la tâche
        PostThreadMessage(Thread.th32ThreadID, WM_QUIT, 0, 0);
 
        // On peut s'arrêter là puisque la première trouvée est la principale
        Break;
 
      until not Thread32Next(Handle, Thread);
 
    until not Process32Next(Handle, Process);
 
  finally
    CloseHandle(Handle);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  KillProcesses('notepad.exe');
end;

Evidemment si l'application est lancée plusieurs fois, toutes les instances seront terminées. Si on voulait cibler spécifiquement un processus lancé par notre application, on pourrait soit compléter le test en contrôlant le processus parent :

Code:

1
2
// Trouvé ?
if not SameText(Process.szExeFile, aFileName) or (Process.th32ParentProcessID <> GetCurrentProcessID) then Continue;

soit récupérer et stocker le ProcessID après ShellExecuteEx ce qui nous éviterait la boucle TH32CS_SNAPPROCESS.

Sous Linux... aucune idée ;)

15/08/2022, 17h18
jurassic pork
Hello,
en python c'est plus facile et en plus c'est multi-plateforme avec le module psutil :
Code:

1 2 3 4 5 6 7 8 9 import psutil PROC_NAME = "abc.exe" for proc in psutil.process_iter(): # check whether the process to kill name matches if proc.name() == PROC_NAME: proc.kill() #
A noter que l'on peut utiliser du python dans lazarus avec le package pythonForLazarus présent dans le Online Package Manager mais il faut qu'il y ait au moins une version embarquée de python installée dans l'O.S.

Ami calmant, J.P

Bonjour

J'ai testé mais message erreur Handle :THandle , avec Windows dans uses.

Voilà mon problème, j'ai des pages de lecture enregistrées que je sélectionne dans une liste et j'ai un process pour écouter la page sélectionnée avec wmplayer.
Code:

1 2 3 4 5 6 7 8 9 procedure Tform1.ProcExec(title: string); begin AProcess := TProcess.Create(nil); AProcess.Executable:= 'c:\Program Files\Windows Media Player\wmplayer.exe'; AProcess.Parameters.Add(title); AProcess.ShowWindow:=swoHIDE; aprocess.Execute; aprocess.Free; end;
Je veux pouvoir lancer une autre page même si la première n'est pas lue entièrement.
Jusque là pas de problème, je relance le process avec la nouvelle page et elle est lue.
Mais je voudrais que lorsque je quitte l'application, le process s'arrête, que wmplayer soit fermé.

J'ai essayé ça mais rien :
Code:

1 2 3 4 AProcess.Executable := 'c:\windows\system32\cmd.exe'; AProcess.Parameters.Add('/c'); AProcess.Parameters.Add('Taskkill /IM C:\Program Files\Windows Media Player\wmplayer.exe /F'); AProcess.Execute;

16/08/2022, 07h00
Jipété

Citation:

Envoyé par sematimo

j'ai testé mais message erreur Handle :THandle , avec windows dans uses

C'est quoi exactement le message d'erreur, parce que là, franchement... :roll:

2 pièce(s) jointe(s)

Hello,
on peut aussi commander windows media player en utilisant son objet COM.
Voici un petit projet (en pièce jointe) qui ouvre un mp3 ou une liste de lecture m3u et qui lit le fichier chargé dans windows media player.

Code:

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  EditBtn;
 
type
  { TForm1 }
  TForm1 = class(TForm)
    Bt_Play: TButton;
    Bt_Stop: TButton;
    Button3: TButton;
    Fichier: TFileNameEdit;
    Memo1: TMemo;
    procedure Bt_PlayClick(Sender: TObject);
    procedure Bt_StopClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FichierChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 uses comobj;
 
 var player: olevariant;
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Bt_PlayClick(Sender: TObject);
var
  i : integer;
  ext: string;
  Fic : String;
 begin
    player.controls.play;
    bt_Play.Enabled := False;
    bt_Stop.Enabled := True;
end;
 
 
procedure TForm1.Bt_StopClick(Sender: TObject);
begin
   player.controls.stop;
   bt_Stop.Enabled := False;
   bt_Play.Enabled := True;
end;
 
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
end;
 
procedure TForm1.FichierChange(Sender: TObject);
var i: integer;
var ext: String;
begin
  player.controls.stop;
  bt_Play.Enabled := True;
  ext :=  ExtractFileExt(Fichier.FileName);
  player.url:=olevariant(Fichier.FileName);
  player.controls.stop;
  If ext = '.m3u' then
     begin
      Memo1.Append('Nom de la liste de lecture : ' + player.currentPlaylist.Name);
      Memo1.Append('Nombre de morceaux : '  + inttostr(player.currentPlaylist.count));
     end;
  For i := 0 To player.currentPlaylist.Count - 1  do
     begin
      Memo1.Append(player.currentPlaylist.Item(i).Name);
     end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
      player:=CreateOleObject('Wmplayer.OCX.7');
end;
 
end.

Pièce jointe 623832

Ami calmant (J.P sans T)

16/08/2022, 07h26
sematimo

Le message :

Citation:

unit1.pas(141,3) Error: Duplicate identifier "Handle"

alors que je n'utilse handle que dans la fonction de Andnotor.

J'ai lazarus 2.2.2. FPC 3.2.2.

Autre truc, je fais une recherche avec FindFist et depuis que j'ai ajouté Windows dans les uses j'ai un message d'erreur :

Citation:

unit1.pas(389,19) Error: Incompatible type for arg no. 1: Got "TRawbyteSearchRec", expected "QWord"

Si j'enlève Windows des uses ce message disparaît.

J'ai testé le source de jurassic pork en enlevant le pack Python et modifiant '.m3u' en '.mp3'.
16/08/2022, 08h57
Roland Chastain

Bonjour !

Vous pourriez remplacer Handle par Handle1 et FindFirst par SysUtils.FindFirst.
16/08/2022, 09h07
sematimo

En testant le source de jurassic pork j'ai un temps relativement long avant le début de la lecture et les premières phrases sont saccadées.
En remplaçant handle par hanlde1 je n'ai plus le message mais j'ai ça :

Citation:

unit1.pas(131,12) Error: Identifier not found "TProcessEntry32"
unit1.pas(131,27) Error: Error in type definition
unit1.pas(132,12) Error: Identifier not found "TThreadEntry32"
unit1.pas(132,26) Error: Error in type definition
unit1.pas(137,11) Error: Illegal qualifier
unit1.pas(137,28) Error: Identifier not found "TProcessEntry32"
unit1.pas(138,10) Error: Illegal qualifier
unit1.pas(138,28) Error: Identifier not found "TThreadEntry32"
unit1.pas(140,13) Error: Identifier not found "CreateToolHelp32Snapshot"
unit1.pas(140,38) Error: Identifier not found "TH32CS_SNAPPROCESS"
unit1.pas(140,60) Error: Identifier not found "TH32CS_SNAPTHREAD"
unit1.pas(145,8) Error: Identifier not found "Process32First"
unit1.pas(148,31) Error: Illegal qualifier
unit1.pas(151,10) Error: Identifier not found "Thread32First"
unit1.pas(154,19) Error: Illegal qualifier
unit1.pas(154,49) Error: Illegal qualifier
unit1.pas(157,34) Error: Illegal qualifier
unit1.pas(162,17) Error: Identifier not found "Thread32Next"
unit1.pas(164,15) Error: Identifier not found "Process32Next"
unit1.pas(171,18) Error: method identifier expected
16/08/2022, 10h37
Roland Chastain
Comme ça, ça devrait aller mieux.
Code:

1 2 3 uses //... Windows, jwatlhelp32;
16/08/2022, 13h16
Guesset

Bonjour,

En complément, l'ordre des uses est important. Si une unité redéfinit un objet, une variable, un type, c'est la dernière définition qui l'emporte.
Donc uses windows, unit1, unit2, .. unitn; n'a pas le même effet que uses unit1, unit2, .. unitn, windows;

Salutations
16/08/2022, 13h53
sematimo

Effectivement en plaçant jwatlhelp32 et windows en tête des uses, aucun problème, tout fonctionne.
merci à tous.
Je coche résolu.