Discussion :

[bvsud]

Bonjour, à tous

Pour les copies de fichiers, par exemple, j'utilise beaucoup les Threads API. J'ai écrit ce test de fin de Thread, lequel ne fonctionne pas.

Code :

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

1
2
3
4
 
  // Variables globales
  ThreadID : DWord;
  Handle_Thrd : THANDLE;

Code du Thread (qui ne fait rien, d'ailleurs : c'est juste pour le test) :

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
 
// Toutes les demies-secondes, un label affiche + ou -
Function Thrd_Vide( lpParam : Pointer ) : LongWord ; stdcall ;
Var
  i : integer;
 
begin
  i := 0;
 
  while i < 1 do  // Boucle infinie
    begin
      if AnsiCompareText(Form1.Lab_Aff_Thrd.Caption, '+') = 0 then
        begin
          Form1.Lab_Aff_Thrd.Caption := '-';
        end
      Else
        begin
          Form1.Lab_Aff_Thrd.Caption := '+';
        end;
      Sleep(500);
    end;
 
// Pas de ExitThread(); C'est voulu : c'est peut-être une erreur, mais je veux pouvoir le stopper moi-même, pour le test.
end;

Je "tue" le Thread :

Code :

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

1
2
3
4
5
 
procedure TForm1.Btn_StopClick(Sender: TObject);
begin
  TerminateThread(Handle_Thrd, 0);
end;

Test de l'activité du Thread elle-même :

Code :

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

1
2
3
4
5
6
7
 
procedure TForm1.Btn_Tst_ThrdClick(Sender: TObject);
begin
  if Tst_Thrd_Actif(Handle_Thrd) = True then Aff_Ds_StatusBar('THREAD ACTIF', @Form1.StatusBar)
  Else Aff_Ds_StatusBar('THREAD TERMINE', @Form1.StatusBar)
 
end;

Problème : même après avoir tué le Thread, ma fonction me retourne systématiquement qu'il est actif. Ce qui est faux.

Traduction de la doc de Microsoft au sujet de STILL_ACTIVE (un angliciste sera le bienvenu :
API GetExitCodeThread().
"Important. La fonction GetExitCodeThread renvoie un code d'erreur valide défini par l'application uniquement après la fin du thread.
Par conséquent, L'application ne doit pas utiliser STILL_ACTIVE (259) comme un code d'erreur.
Si un thread retourne STILL_ACTIVE (259) comme un code d'erreur, les applications qui testent
Pour cette valeur pourrait interpréter cela signifie que le thread est toujours en cours d'exécution et continuer à tester l'achèvement du thread après le thread "A terminé", ce qui pourrait mettre l'application dans une boucle infinie.


Et avec la fonction GetExitCodeProcess(), idem. Heu...

[bvsud]

Peut-être résolu... Mais j'aimerais un avis.

Nouveau code de la fonction :

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
Function Tst_Thrd_Actif(Handle_Thread : THANDLE) : boolean;
Var
  Code_Retour_Thrd : DWord;
  Ptr_Code : ^Cardinal;
  Retour_Fonction : boolean;  // Code de retour de l'API

begin

  Code_Retour_Thrd := 0;
  Ptr_Code := Addr(Code_Retour_Thrd);

  Retour_Fonction := GetExitCodeThread(Handle_Thread, Ptr_Code^);
  if Code_Retour_Thrd AND STILL_ACTIVE = STILL_ACTIVE then  // Je me trompais sur le ET logique !
    begin
      Tst_Thrd_Actif := True;
      Exit;
    end;

  if Retour_Fonction = False then Tst_Thrd_Actif := False;  
  { Si la fonction a échoué, en principe (c'est ce qui me gêne : « en principe ») c'est que le Thread n'est plus actif. }

end;

En tout cas, cette fois, ça fonctionne. Est-il bien nécessaire, si GetExitCodeThread () retourne False, de farfouiller dans Code_Retour_Thrd ?

[Invité]

Je suis pas spécialement a l'aise avec les thread écrit comme ca mais si tu as une version de Delphi supérieur à XE7 tu peux remplacer ca en 2 secondes avec une TTask (ou Futur si tu veux un retour) ce qui te permettrais de changer simplement son statut pour l'arrêter et d'avoir une possibilité de notification quand elle est terminée.

[bvsud]

Bonsoir, Retwas :hello:

"Je suis pas spécialement a l'aise avec les thread écrit comme ca (...)" : je te comprends Je ne rivalise pas avec les cracks du forum. Mais, pour de simples copies de fichiers, les threads API suffisent largement. En revanche, contrairement aux classes, on ne peut pas appeler le même thread une deuxième fois : la synchronisation devient un casse-tête.

Je suis sous XE7. Je me suis écrit des threads pour des composants système Jedi que j'utilise énormément, threads que je n'ai pas encore convertis en classes. JvSearchFiles, et le SHFileOperations. D'autre threads API, aussi.

Selon toi : je me gourre, ou bien ma fonction est correcte ?

[Andnotor]

C'est un thread de test mais autant le rappeler : on n'accède jamais à un élément de la VCL sans synchronisation

L'implémentation de GetExitCodeThread est un peu complexe ici.
ExitCode est une valeur et non une suite de bits. Inutile d'appliquer un masque.
Ne pas oublier aussi que cette fonction peut échouer si le handle est invalide (tester le retour).

Code :

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

1
2
3
4
5
6
7
8
function CheckThreadRunning(aHandle :THandle) :string;
var
  ExitCode :dword;
begin
  if GetExitCodeThread(aHandle, ExitCode) and (ExitCode = STILL_ACTIVE)
  then Result := 'THREAD ACTIF'
  else Result := 'THREAD TERMINE';
end;

On pourrait aussi tester cela à l'aide d'une fonction de synchronisation :

Code :

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

1
2
3
4
5
6
function CheckThreadRunning(aHandle :THandle) :string;
begin
  if WaitForSingleObject(aHandle, 0) = WAIT_TIMEOUT
  then Result := 'THREAD ACTIF'
  else Result := 'THREAD TERMINE';
end;

Dans tous les cas lorsque le thread se termine (naturellement ou forcé), il faut libérer le handle :

Code :

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

1
2
3
4
begin
  TerminateThread(Handle_Thrd, 0);
  CloseHandle(Handle_Thrd);
end;

En revanche, contrairement aux classes, on ne peut pas appeler le même thread une deuxième fois : la synchronisation devient un casse-tête.

Chaque thread a son handle. WaitForSingleObject pour un seul thread (un seul handle) et WaitForMultipleObjects pour un tableau de handle.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
var
  Handles :array[0..2] of THandle;
  i       :integer;
begin
  Handles[0] := CreateThread(..);
  Handles[1] := CreateThread(..);
  Handles[2] := CreateThread(..);
 
  WaitForMultipleObjects(Length(Handles), @Handles, TRUE, INFINITE);
 
  for i := 0 to High(Handles) do
    CloseHandle(Handles[i]);
end;

Rien n'empêche d'appeler GetExitCodeThread sur chaque handle après WaitForMultipleObjects pour connaître leur code de sortie, voire de faire ce contrôle dès qu'un thread se termine si bWaitAll de WaitForMultipleObjects est FALSE.


A noter que depuis XE7 (je crois), il est aussi possible de paralléliser le code d'une boucle. Ici, chaque copie se fait dans une tâche séparée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
uses System.Threading;
 
procedure TForm1.CopyFiles;
var
  Files :array[0..1] of string;
begin
  Files[0] := 'File1.txt';
  Files[1] := 'File2.txt';
 
  TParallel.For(0, High(Files), procedure(I: integer)
                                begin
                                  CopyFile(PChar(Files[i]), ...);
                                end);
end;

[bvsud]

Bonjour, AndNotor

Voilà ce que j'appelle de l'information

J'ai corrigé les TerminateThread () en refermant le Handle. Et je vais potasser tout cela.

Juste deux petites questions.

1) Si le rhread s'est planté, ou bien a été arrêté avec TerminateThread(), ce n'est pas le programmeur qui a implémenté ExitThread(). Le thread le ferait tout seul ? L'OS lui attribuerait donc systématiquement un code de retour ?

2) Un détail m'échappe. Dans la fonction que tu écris :

Code :

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

1
2
3
4
5
6
7
8
9
 
function CheckThreadRunning(aHandle :THandle) :string;
var
  ExitCode :dword;
begin
  if GetExitCodeThread(aHandle, ExitCode) and (ExitCode = STILL_ACTIVE)
  then Result := 'THREAD ACTIF'
  else Result := 'THREAD TERMINE';
end;

applique bien un masque (AND) sur le DWord ExitCode. Et là, c'est l'OS qui affecte une valeur à ExitCode. Donc, on a donc bien besoin de de tester STILL_ACTIVE ? En tout cas pour cette fonction.

Je vais tester ta fonction en booléen :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
function CheckThreadRunning(aHandle :THandle) : boolean; 
var
  ExitCode :dword;
 
begin
  if GetExitCodeThread(aHandle, ExitCode) and (ExitCode = STILL_ACTIVE)
  then Result := True
  else Result := False; 
end;

Ca devrait fonctionner de la même façon.

[Roland Chastain]

Bonjour !

C'est un thread de test mais autant le rappeler : on n'accède jamais à un élément de la VCL sans synchronisation

Si je puis me permettre, ton message mériterait de devenir un article, ou une série de QR dans la FAQ (je viens de lire en diagonale la section sur les threads : rien n'y est dit, sauf erreur de ma part, au sujet de la fonction GetExitCodeThread).

Et en attendant, sans vouloir te commander, si tu avais le temps de poster un exemple complet, je pense qu'il y aurait des amateurs (moi par exemple).