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 ?

[retwas]

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.

[Andnotor]

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 ?

Si le thread devait se planter, il y a de forte chance pour que ExitCode reste à STILL_ACTIVE. A toi de protéger cela par un try..except.
Par contre avec TerminateThread, c'est toi qui fourni le code de sortie (2ème paramètre).

2) Un détail m'échappe. Dans la fonction que tu écris :
...
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.

Bien sûr. Je disais simplement qu'on ne travaille pas sur les bits de ExitCode mais sur sa valeur entière. Code_Retour_Thrd AND STILL_ACTIVE = STILL_ACTIVE équivaut à Code_Retour_Thrd = STILL_ACTIVE

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

[Roland Chastain]

Je viens de relire plus attentivement la QR sur les threads Win32. Franchement, ça n'aide pas beaucoup...

P.-S. En plus le code ne se compile même pas (avec 10.1 Berlin).

[dcc32 Erreur] faqcreatethread.dpr(37): E2003 Identificateur non déclaré : 'HANDLE'
[dcc32 Erreur] faqcreatethread.dpr(43): E2010 Types incompatibles : 'NativeUInt' et 'Pointer'

[bvsud]

Bonjour

Ca marche. Je vais envoyer un exemple de code

Je l'envoie à un modérateur, ou en PJ dans ce sujet ?

[Roland Chastain]

Je vais envoyer un exemple de code

Je l'envoie à un modérateur, ou en PJ dans ce sujet ?

Il me semble qu'une pièce jointe, ce serait très bien.

[bvsud]

Voilà. En PJ.

[Roland Chastain]

Voilà. En PJ.

Merci pour le code.

[Andnotor]

Si je puis me permettre, ton message mériterait de devenir un article, ou une série de QR dans la FAQ

Est-ce bien nécessaire de développer sur les API alors qu'il y a maintenant tellement de possibilités sous Delphi pour du multi-tâches ?
Peut-être une fois serait-il utile de comparer toutes ces techniques, CreateThread, TThread (instancié ou anonyme), ITask, IFuture, TParallele.For.

@bvsub

Quelques petites remarques sur ton exemple :

Code :

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

1
2
3
4
5
6
While (WaitForSingleObject(Handle_Thrd_Compteur, 100) <> 0) do
begin
  Application.ProcessMessages;
  Sleep(100);
  Form1.Refresh;
end;

Tester <> 0 (qu'il serait mieux d'écrire WAIT_OBJECT_0) ne pose pas de problème ici puisque tout est fait dans la même procédure (la même tâche). Par contre si la tâche principale devait attendre sur d'autres tâches créées dans un thread secondaire, elles pourraient déjà s'être terminées (et les handles libérés) avant la synchro. Le retour de WaitForSingleObject sera WAIT_FAILED et on ne sortira jamais de la boucle. Mieux vaut la conditionner par = WAIT_TIMEOUT.

Sleep(100) n'est pas utile, WaitForSingleObject(..., 100) est déjà une pause de 100 ms (si timeout)

Form1.Refresh est inutile aussi puisqu'il y a un Application.ProcessMessages qui a déjà vidé la pile de messages, WM_PAINT compris.

Code :

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

1
2
While WaitForSingleObject(Handle_Thrd_Compteur, 100) = WAIT_TIMEOUT do
  Application.ProcessMessages;

Et à nouveau, ne pas modifier Form1 depuis le thread et désactiver le bouton pour ne pas lancer Lancer_Thrd une deuxième fois. Le premier handle ne serait pas libéré puisque Handle_Thrd_Compteur serait réaffecté et les synchros échoueraient. Bref, le début des ennuis !

[Roland Chastain]

Est-ce bien nécessaire de développer sur les API alors qu'il y a maintenant tellement de possibilités sous Delphi pour du multi-tâches ?

Personnellement, je m'intéresse de plus en plus aux API (dont j'avais horreur au début). D'abord je trouve que c'est lorsqu'on fait quelque chose en passant par les API qu'on comprend le mieux ce qui se passe. Ensuite, j'utilise plusieurs compilateurs (Delphi, Free Pascal, Free Basic) et lorsque j'apprends à faire quelque chose par les API avec un compilateur, je peux aussitôt m'en servir avec les autres. Enfin, pour mes projets personnels je cherche à maîtriser la technique de communication par les pipes, qui est utilisée dans les programmes d'échecs : et là il n'y a pas d'autre moyen que d'utiliser les API.

Peut-être une fois serait-il utile de comparer toutes ces techniques, CreateThread, TThread (instancié ou anonyme), ITask, IFuture, TParallele.For.

Je trouve que c'est un sujet très intéressant. Si tu veux te lancer, je te propose volontiers mes services comme relecteur-testeur.

[foetus]

Je tiens à signaler que sous Windows, les fonctions WaitForXXXObject - XXXEvent sont une histoire ancienne depuis Vista et les Condition Variables.

En gros, on va lier un évènement à un verrou pour avoir des opérations atomiques.

Mais je ne sais pas s'il y a le support en Delphi . Peut-être via la Jedi Windows API

[Andnotor]

Je tiens à signaler que sous Windows, les fonctions WaitForXXXObject - XXXEvent sont une histoire ancienne depuis Vista et les Condition Variables.

Effectivement si on parle d'accès concurrents mais ici ce n'est pas le cas, bvsub veut simplement attendre que des tâches indépendantes l'une de l'autre soient terminées. WaitForXXXObject est parfait pour cela.

Les WaitForXXXObject et events sont toujours d'actualité pour des synchronisations inter-processus

Mais je ne sais pas s'il y a le support en Delphi

Il y a mais je ne peux pas te dire depuis quand.

[Roland Chastain]

Il y a des exemples de conditions variables dans le livre XE2 Foundations :

https://github.com/ms301/delphi-foun...Multithreading

[bvsud]

Bonjour à tous, et merci pour toutes vos réponses

Ci-joint, un exemple un peu plus complet, mais plus bourrin que si j'avais lu les codes ci-dessus (TIMEOUT , etc). Je viens à peine de les apercevoir.

Le code, avec suspension, reprise, etc. En PJ.