Gestion events problème

[jmg49]

bonjour,

j'ai beau chercher je ne vois plus .....

un petit code d'un ping tool qui renvoit le resultat de la commande dans un EditorGadget , pas moyen que le bouton stop fasse ce qu'il devrait ...
tant que le ping ne tourne pas, mes evenements répondent , fermer par ESC , bouton stop ... je me mélange les pinceaux avec les WaitWindowEvent , WindowEvent ,EventGadget
compliqué tout ça...

Code : Tout sélectionner

;ping tool
;free code
;use at your own risks

Enumeration
#FEN1  
#FEN1_Edit_Ip
#FEN1_Txt_Ip
#FEN1_Ping
#FEN1_Edit_2
#FEN1_Stop
EndEnumeration

MP_Graphics3DWindow(320, 200, 600, 450,"Ping_Test Jmg@2016 Press ESC to Quit", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

SetWindowColor(#FEN1,RGB(0,0,0)) 
TextGadget(#FEN1_Txt_Ip, 20, 50, 80, 25, " Adresse Ip :")
EditorGadget(#FEN1_Edit_Ip, 120, 50, 150, 20)
EditorGadget(#FEN1_Edit_2, 50, 150, 500, 250)

SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))


SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetText(#FEN1_Edit_Ip,"8.8.8.8")

ButtonGadget(#FEN1_Ping, 320, 50, 90, 20, " Ping ")
ButtonGadget(#FEN1_Stop, 420, 50, 90, 20, " Stop ")

Procedure ping()
   
  ip.s = GetGadgetText(#FEN1_Edit_Ip)
  
  While   GetGadgetState(#FEN1_Stop) = 0 
    
    event  = WindowEvent()
    
     ping = RunProgram("ping.exe" ,ip.s  ,"", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii )
  
      While ProgramRunning(ping)
   
        out$ =  ReadProgramString(ping)
       
        AddGadgetItem(#FEN1_Edit_2, 0, out$) 
   
   
  Debug GetGadgetState(#FEN1_Stop)
  
  Wend  
      Wend  
 EndProcedure
 
 
 
  
Repeat 
    
  event  = WindowEvent()
  
  Select Event
  Case #PB_Event_Gadget 
      Select EventGadget()
          
      
    Case #FEN1_Ping
      
       ping()      
      
    Case  #FEN1_Stop 
                 
      Break
      
        
  EndSelect

EndSelect
  
Until GetAsyncKeyState_(#VK_ESCAPE)




  
  
  

[Ar-S]

Salut,
pour que les gens puissent tester, dejà remplace ton mp3Dwindow par

Code : Tout sélectionner

OpenWindow(#FEN1,320, 200, 600, 450,"Ping_Test Jmg@2016 Press ESC to Quit", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

Dans ta procedure tu as un while/wend qui sert a rien, vu que tu te trouve dans une boucle

Code : Tout sélectionner

Procedure ping()
   
  ip.s = GetGadgetText(#FEN1_Edit_Ip)
 
  If   GetGadgetState(#FEN1_Stop) = 0
   
    event  = WindowEvent()
   
     ping = RunProgram("ping.exe" ,ip.s  ,"", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii )
 
      While ProgramRunning(ping)
   
        out$ =  ReadProgramString(ping)
       
        AddGadgetItem(#FEN1_Edit_2, 0, out$)
   
   
  Debug GetGadgetState(#FEN1_Stop)
 
  Wend 
EndIf

EndProcedure

Enfin la commande ping...
Si tu ouvres un simple CMD et que tu ping ta box 192.168.0.1 ou 192.168.1.1 (selon la box), tu ne peux pas arreter le ping en court à moins de faire un CTRL+C... ceci explique peut etre cela.

[jmg49]

l'autre While / Wend sert à relancer le ping tant que la condition GetGadgetState(#FEN1_Stop) = 0 est juste , une fois le bouton stop poussé

GetGadgetState(#FEN1_Stop) = 0 passe à 1 et le ping s'arrête une fois ses itérations terminées , voila pourquoi il est là

avec un ping -t il faut simuler la frappe ctrl +c en effet pour couper, pour l'instant c'est trop compliqué d'où l'utilité du bouton ;

là le bouton stop réagit mais il faut tomber entre les 3 ping et avant qu'il relance; en supprimant le while/wend du début, les 3 pings passés le bouton réagit,

peut être mettre le ping dans un thread séparé , je vais creuser

merci

[Marc56]

Le problème est que ton code ne reviens jamais à la boucle principale.
Un thread peut solutionner.

J'ai élagué un peu et mis en page
(Pense à faire CTRL+A puis CTRL+I de temps à autre, on voit tout de suite les mauvaises imbrications)

Code : Tout sélectionner

;ping tool
;free code
;use at your own risks

Enumeration
    #FEN1 
    #FEN1_Edit_Ip
    #FEN1_Txt_Ip
    #FEN1_Ping
    #FEN1_Edit_2
    #FEN1_Stop
EndEnumeration

OpenWindow(#FEN1, 320, 200, 600, 450,
           "Ping_Test Jmg@2016 Press ESC to Quit", 
           #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

SetWindowColor(#FEN1,RGB(0,0,0))
TextGadget(#FEN1_Txt_Ip, 20, 50, 80, 25, " Adresse Ip :")
EditorGadget(#FEN1_Edit_Ip, 120, 50, 150, 20)
EditorGadget(#FEN1_Edit_2, 50, 150, 500, 250)

SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetText(#FEN1_Edit_Ip,"8.8.8.8")

ButtonGadget(#FEN1_Ping, 320, 50, 90, 20, " Ping ")
ButtonGadget(#FEN1_Stop, 420, 50, 90, 20, " Stop ")


Procedure ping(*Valeur)
    Repeat  
        ping = RunProgram("ping.exe",
                          GetGadgetText(#FEN1_Edit_Ip),
                          "", 
                          #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
        
        While ProgramRunning(ping)       
            out$ =  ReadProgramString(ping)
            AddGadgetItem(#FEN1_Edit_2, 0, out$)
            Debug GetGadgetState(#FEN1_Stop)
        Wend 
    ForEver
EndProcedure


Repeat
    Select WaitWindowEvent(50)
            
        Case #PB_Event_Gadget
            Select EventGadget() 
                    
                Case #FEN1_Ping
                    ID_ThreadPing = CreateThread(@ping(), 1)    
                    
                Case #FEN1_Stop
                    KillThread(ID_ThreadPing)
                    Break  
            EndSelect
            
        Case #PB_Event_CloseWindow
            KillThread(ID_ThreadPing)
            Break
            
    EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

End

Ceci fontionne même sans activer le mode threadsafe.

Ici j'ai utilisé KillThread. C'est déconseillé car ça ne libère pas les ressources utilisées par le thread, il est donc préférable d'utiliser une autre solution (sans doute à base d'un drapeau). J'ai essayé plusieurs solutions, mais ce n'est pas très concluant toujours à cause de la lenteur de la commande.

Une solution doit être possible avec les BindEvent (je n'utilise pas trop) qui peut normalement intercepter le bouton stop à tout moment

Il existe plusieurs paramètres à ping.exe qui sous Windows envoie par défaut 4 pings et retourne le résultat,
notamment ping -t [ip] qui boucle en continu.

PS. Le code donné par Ar-S n'effectue qu'une seule boucle puis s'arrête.



Edit: ooops, je découvre que le killthread ferme entièrement le programme principal et non pas le thread seul

[jmg49]

ok, j'étais en train de faire de manière similaire et en effet c'est déjà beaucoup mieux ,

merci pour le ctrl A ctrl I ! c'est plus présentable

j'ai rajouté quelques if pour tester si le thread est lancé avec le kill car 2 clics sur le bouton stop faisait planter le prog,

Code : Tout sélectionner

Repeat
  Select WaitWindowEvent(50)
      
    Case #PB_Event_Gadget
      Select EventGadget()
          
        Case #FEN1_Ping
          ID_ThreadPing = CreateThread(@ping(), 1)   
          
        Case #FEN1_Stop
          If IsThread(ID_ThreadPing)= 1
          KillThread(ID_ThreadPing)
          EndIf
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      
      If IsThread(ID_ThreadPing)= 1
        KillThread(ID_ThreadPing)
      EndIf
      Break
      
      
      
      
      
  EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

là ça tourne impec

merci bien

[Marc56]

Parfait
Très bonne idée de tester le thread pour ne pas renvoyer plusieurs fois le même

J'ai aussi trouvé mon erreur (pourquoi le programme quittait complètement en 'killant' le thread au lieu de simplement arrêter celui-ci): un 'Break' en trop juste après le stop thread qui faisait donc quitter la boucle principale

Code : Tout sélectionner

                Case #FEN1_Stop
                    KillThread(ID_ThreadPing)
                    Break ; <--- Meuh non, pas ici, sinon on sort complètement! 

Comme quoi: le nez sur l'écran on voit plus les erreurs bêtes
(sans oublier les vieux réflexes de langage C et son instruction switch qui nécessite un break)

Vraiment bien mais démoralisant PB chaque fois qu'un programme à un comportement bizarre, c'est presque toujours une simple faute d'inattention

[jmg49]

je vais essayer de fixer ce problème de "non-kill" de thread , il semble que Fred déconseille fortement l'utilisation de killthread() en effet , c'est une solution de contournement, déjà ça force le retour à la boucle main mais les ressources restent affectées

[Ollivier]

ça ne force rien du tout : il suffit de savoir s'en servir.

Je vous recommande ce sujet.

[Marc56]

Proposition qui remplace le killthread() par un 'flag', comme recommandé dans la doc

KillThread()
Cette fonction est très dangereuse, ne l'utilisez que si nécessaire, car quand un thread est tué, il n'a aucune chance de libérer ses propres ressources mémoires, sa pile, etc. Il est possible d'utilser un 'flag' comme une variable globale pour dire au thread de se terminer lui-même tout en prenant en charge la libération de ses propres ressources.

Code : Tout sélectionner

;ping tool
;free code
;use at your own risks

EnableExplicit

Enumeration
    #FEN1 
    #FEN1_Edit_Ip
    #FEN1_Txt_Ip
    #FEN1_Ping
    #FEN1_Edit_2
    #FEN1_Stop
EndEnumeration

Global ID_ThreadPing
Global Run.c

OpenWindow(#FEN1, 320, 200, 600, 450,
           "Ping_Test Jmg@2016 Press ESC to Quit", 
           #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

SetWindowColor(#FEN1,RGB(0,0,0))
TextGadget(#FEN1_Txt_Ip, 20, 50, 80, 25, " Adresse Ip :")
EditorGadget(#FEN1_Edit_Ip, 120, 50, 150, 20)
EditorGadget(#FEN1_Edit_2, 50, 150, 500, 250)

SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetText(#FEN1_Edit_Ip,"8.8.8.8")

ButtonGadget(#FEN1_Ping, 320, 50, 90, 20, " Ping ")
ButtonGadget(#FEN1_Stop, 420, 50, 90, 20, " Stop ")


Procedure ping(*Valeur)
    Protected ping
    Protected out$
    Repeat  
        ping = RunProgram("ping.exe",
                          GetGadgetText(#FEN1_Edit_Ip),
                          "", 
                          #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
        
        While ProgramRunning(ping)
            If Run = 0
                CloseProgram(ping)
                ProcedureReturn 
            EndIf
            
            out$ =  ReadProgramString(ping)
            AddGadgetItem(#FEN1_Edit_2, 0, out$)
            Debug GetGadgetState(#FEN1_Stop)
        Wend 
    ForEver
EndProcedure


Repeat
    Select WaitWindowEvent(50)
            
        Case #PB_Event_Gadget
            Select EventGadget() 
                    
                Case #FEN1_Ping
                    Run = 1
                    ID_ThreadPing = CreateThread(@ping(), 23)
                    
                Case #FEN1_Stop
                    Run = 0
                      
            EndSelect
            
        Case #PB_Event_CloseWindow
            Break
            
    EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

End

[jmg49]

=> ollivier , en effet je n'ai pas appris du coup je ne sais pas m'en servir, merci pour le lien

=> Marc56 , ça tourne bien avec le flag, le thread se ferme correctement et libère les ressources, je veux pas être pénible mais ça fonctionne pour les 3 itérations du ping standard, si on spécifie un -n 1500 par exemple , le thread ne se fermera que lorsqu'on on aura repris la main .....

c'est pour une question d'affichage et de lisibilité, le gadget edit incrémente les lignes en mettant la dernière reçue en première position




quand il y a une perte de paquet c'est mieux,

j'ai rajouté un 2 ème thread pour un multi-ping avec changement de couleur quand l'ip n'est pas ou plus joignable , par contre , à quoi donc sert le 23 dans le

CreateThread(@ping(), 23) ??

Merci à vous tous

Code : Tout sélectionner

;ping tool
;free code
;use at your own risks

Enumeration
  #FEN1
  #FEN1_Edit_Ip
  #FEN1_Txt_Ip
  #FEN1_Ping
  #FEN1_Edit_2
  #FEN1_Stop
  ;-------------------------------------------;  
  #FEN1_Edit_Ip2
  #FEN1_Txt_Ip2
  #FEN1_Ping2
  #FEN1_Edit_3
  #FEN1_Stop2
  
  
  
EndEnumeration


Global ID_ThreadPing
Global ID_ThreadPing2

Global Run.c
Global Run2.c


OpenWindow(#FEN1, 320, 200, 1200, 650,
           "Ping_Test Jmg@2016 Press ESC to Quit", 
           #PB_Window_SystemMenu |
           #PB_Window_ScreenCentered)
LoadFont(1,"Arial",11)
SetWindowColor(#FEN1,RGB(0,0,0))
TextGadget(#FEN1_Txt_Ip, 20, 50, 80, 28, " Adresse Ip :")
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))
SetGadgetFont(#FEN1_Txt_Ip, FontID(1))



EditorGadget(#FEN1_Edit_Ip, 120, 50, 150, 20)
SetGadgetFont(#FEN1_Edit_Ip, FontID(1))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))
SetGadgetText(#FEN1_Edit_Ip,"8.8.8.8")


EditorGadget(#FEN1_Edit_2, 50, 150, 500, 250)
SetGadgetFont(#FEN1_Edit_2, FontID(1))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))


ButtonGadget(#FEN1_Ping, 320, 50, 90, 23, " Ping ")
SetGadgetFont(#FEN1_Ping, FontID(1))
ButtonGadget(#FEN1_Stop, 420, 50, 90, 23, " Stop ")
SetGadgetFont(#FEN1_Stop, FontID(1))

;-------------------------------------------------------------------------------------

TextGadget(#FEN1_Txt_Ip2, 620, 50, 80, 28, " Adresse Ip :")
SetGadgetFont(#FEN1_Txt_Ip2, FontID(1))
SetGadgetColor(#FEN1_Txt_Ip2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip2, #PB_Gadget_FrontColor, RGB(255,255,255))


EditorGadget(#FEN1_Edit_Ip2, 740, 50, 150, 20)
SetGadgetFont(#FEN1_Edit_Ip2, FontID(1))
SetGadgetColor(#FEN1_Edit_Ip2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip2, #PB_Gadget_FrontColor, RGB(255,255,255))
SetGadgetText(#FEN1_Edit_Ip2,"8.8.8.8")


EditorGadget(#FEN1_Edit_3, 650, 150, 500, 250)
SetGadgetColor(#FEN1_Edit_3, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_3, #PB_Gadget_FrontColor, RGB(255,255,255))
SetGadgetFont(#FEN1_Edit_3, FontID(1))

ButtonGadget(#FEN1_Ping2, 940, 50, 90, 23, " Ping ")
SetGadgetFont(#FEN1_Ping2, FontID(1))
ButtonGadget(#FEN1_Stop2, 1040, 50, 90, 23, " Stop ")
SetGadgetFont(#FEN1_Stop2, FontID(1))

;-------------------------------------------------------------------------------------




Procedure ping(*Valeur)
  Protected ping
  Protected out$
  
  Repeat 
    ping = RunProgram("ping.exe",
                      GetGadgetText(#FEN1_Edit_Ip) ,
                      "",
                      #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
    
    While ProgramRunning(ping)
      
      If Run = 0
        CloseProgram(ping)
        ProcedureReturn
      EndIf
      
      
      out$ =  ReadProgramString(ping)
      AddGadgetItem(#FEN1_Edit_2, 0, out$)
      position = FindString(out$, "attente")
      position2 = FindString(out$, "TTL")
      
      For r =1 To 100
        
        
        
        If position = r
          
          SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,00,00)) 
          
          
          
        EndIf 
        
        
        
        If position2 = r
          SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))
          
        EndIf
        
      Next
    Wend
  ForEver
EndProcedure

Procedure ping2(*Valeur)
  
  Protected ping2
  Protected out2$
  
  Repeat 
    ping2 = RunProgram("ping.exe",
                       GetGadgetText(#FEN1_Edit_Ip2) ,
                       "",
                       #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
    
    While ProgramRunning(ping2)   
      
      If Run2 = 0
        CloseProgram(ping2)
        ProcedureReturn
      EndIf
      out2$ =  ReadProgramString(ping2)
      AddGadgetItem(#FEN1_Edit_3, 0, out2$)
      position3 = FindString(out2$, "attente")
      position4 = FindString(out2$, "TTL")
      
      For g= 1 To 100
        
        
        
        If position3 = g
          
          SetGadgetColor(#FEN1_Edit_3, #PB_Gadget_FrontColor, RGB(255,00,00)) 
          
          
          
        EndIf 
        
        If position4 = g 
          SetGadgetColor(#FEN1_Edit_3, #PB_Gadget_FrontColor, RGB(255,255,255))
          
        EndIf
      Next
      
    Wend
  ForEver
EndProcedure



Repeat
  Select WaitWindowEvent(50)
      
    Case #PB_Event_Gadget
      Select EventGadget()
          
        Case #FEN1_Ping
          Run = 1
          ID_ThreadPing = CreateThread(@ping(), 23)   
          
        Case #FEN1_Stop
          Run = 0
          
          
        Case   #FEN1_Ping2
          Run2 = 1
          
          ID_ThreadPing2 = CreateThread(@ping2(), 1)
          
        Case #FEN1_Stop2
          Run2 = 0
          
          
      EndSelect
      
      
      
      
    Case #PB_Event_CloseWindow
      
      
      Break
      
      
      
      
  EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

End

[Marc56]

Précède alors CloseProgram() par KillProgram()
Les deux sont nécessaires pour libérer proprement les ressources
http://www.purebasic.com/french/documen ... ogram.html
(KillProgram doit avoir le même effet que KillThread ? mais CloseProgram se charge alors de nettoyer ?)

Ci-dessous j'ai ajouté -n 1500

Code : Tout sélectionner

  Repeat
      ping = RunProgram("ping.exe",
                        GetGadgetText(#FEN1_Edit_Ip) + " -n 1500" ,
                        "",
                        #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
      
      While ProgramRunning(ping)
          
          If Run = 0
              KillProgram(ping)
              CloseProgram(ping)
              ProcedureReturn
          EndIf

Pour le 23, dixit
http://www.purebasic.com/french/documen ... hread.html
*Valeur La valeur transmise à la procédure de thread en tant que paramètre. C'est à vous de décider de son utilisation.

Honnêtement je ne sais pas quelle est la raison Extension future ?

Le bon nombre étant bien-sur 42

[Ollivier]

@Marc56

Merci pour la précision de la doc indiquant de bien se méfier de KillThread(). Cependant, une info, même des plus sérieuses reste à prendre avec précaution, notamment, pour en cerner les précisions essentielles.

KillThread() va tout "moucher", comme son nom l'indique. La mémoire du thread va être libérée, "de force". C'est sûrement ce qui t'a poussé à préciser la doc, puisque j'indique texto "ça ne force rien", ce qui est le contraire de ce que je précise ici, et qui correspond à la doc.

En fait, KillThread n'est pas réellement utile, sauf cas de maintien d'une application-mère exigeant l'arrêt de ses threads sous-jacents de nature partielle comme totale.

Et *Valeur, dans le cas usuel de ce sujet doit servir de pointeur vers un tampon de communication entre l'application-mère et tel ou tel thread sous-jacent.

Exemple :

Code : Tout sélectionner

Stucture MonThread
DoitTerminer.I
EstTermine.I
Autre.Autre
EndStructure

Au lieu d'utiliser KillThread(), on va, avec ça, mettre dans l'application-mère :

Code : Tout sélectionner

*ValeurLambda\DoitTerminer = #True

Ainsi, dans le thread qui aura été créé ainsi :

Code : Tout sélectionner

CreateThread(@LeThreadEnQuestion(), *ValeurLambda.MonThread)

On peut questionner régulièrement (toutes les 16 millisecondes par exemple) de la manière assez simple :

Code : Tout sélectionner

If *Valeur\DoitTerminer
; Ici, sauvegarde des données qui nécessitent d'être sauvegardées
*Valeur\EstTermine = 1
ProcedureReturn
EndIf

La sous-structure "Autre", c'est plus important que prévu, car l'un des buts d'un thread c'est d'être strictement cloisonné, sur le plan de la mémoire. Dans un système hautement excluant, *Valeur va servir à mettre à disposition les zones mémoire "communes" nécessaires en indiquant ce que l'on souhaite voir inclus.

[Ollivier]

@jmg49

En réalité, il n'y a pas forcément besoin de thread : envoie un chr(3) à ton programme pour le calmer un peu...

[Marc56]

@jmg49: Voici la version 1 de ton programme en mode passage de valeur que j'ai réalisé après avoir (je crois) enfin compris l'histoire du paramètre de CreateThread() grace aux explications d'Ollivier.

J'ai ajouté le paramètre pour envoyer 1500 pings et voir si la tâche s'arrête bien à n'importe quel moment et non pas juste entre deux relances.

Code : Tout sélectionner

;ping tool
;free code
;use at your own risks

EnableExplicit

Enumeration
    #FEN1 
    #FEN1_Edit_Ip
    #FEN1_Txt_Ip
    #FEN1_Ping
    #FEN1_Edit_2
    #FEN1_Stop
EndEnumeration

Global ID_ThreadPing
Global Run.c

OpenWindow(#FEN1, 320, 200, 600, 450,
           "Ping_Test Jmg@2016 Press ESC to Quit", 
           #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

SetWindowColor(#FEN1,RGB(0,0,0))
TextGadget(#FEN1_Txt_Ip, 20, 50, 80, 25, " Adresse Ip :")
EditorGadget(#FEN1_Edit_Ip, 120, 50, 150, 20)
EditorGadget(#FEN1_Edit_2, 50, 150, 500, 250)

SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Txt_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_2, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_BackColor, RGB(0,0,0))
SetGadgetColor(#FEN1_Edit_Ip, #PB_Gadget_FrontColor, RGB(255,255,255))

SetGadgetText(#FEN1_Edit_Ip,"8.8.8.8")

ButtonGadget(#FEN1_Ping, 320, 50, 90, 20, " Ping ")
ButtonGadget(#FEN1_Stop, 420, 50, 90, 20, " Stop ")


Procedure ping(*Valeur)
    Protected ping
    Protected out$
    Repeat  
        ping = RunProgram("ping.exe",
                          GetGadgetText(#FEN1_Edit_Ip) + " -n 1500",
                          "", 
                          #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
        
        While ProgramRunning(ping)
            If Run = 0
                ProcedureReturn 
            EndIf
            
            out$ =  ReadProgramString(ping)
            AddGadgetItem(#FEN1_Edit_2, 0, out$)
        Wend 
    ForEver
EndProcedure


Repeat
    Select WaitWindowEvent(50)
            
        Case #PB_Event_Gadget
            Select EventGadget() 
                    
                Case #FEN1_Ping
                    Run = 1
                    ID_ThreadPing = CreateThread(@ping(), Run)
                    
                Case #FEN1_Stop
                    Run = 0
                      
            EndSelect
            
        Case #PB_Event_CloseWindow
            Break
            
    EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

End

PS: J'utilise Process Explorer pour voir en temps réel la création / suppression des taches (il est mieux que le gestionnaire de tâches de Windows)
https://technet.microsoft.com/en-us/sys ... lorer.aspx


@Ollivier: si tu pouvais nous donner la même version avec Chr(3) (ETX), ça m’intéresse.

Merci

[Zorro]

Marc , lis les commentaires de ce code

en gros actuellement t passe en parametre un pointeur
mais dans le code tu utilises une variable local "Run"
mais tu ne passes pas la valeur du pointeur passé en paramètre , je pense que du coup ça le fais pas

lis mes commentaires

Code : Tout sélectionner

Procedure ping(*Valeur) ; valeur est une variable (pointeur de variable ) que tu passes en paramètre
; a mon avis ta variable Run ne sera pas renseignée !!
; il faudrai simplement ajouter ceci ici :
*Run=*valeur ; << on remplis le pointeur (ou la variable ) avec le parametre "*valeur" passé lors de l'appel

    Protected ping
    Protected out$
    Repeat 
        ping = RunProgram("ping.exe",
                          GetGadgetText(#FEN1_Edit_Ip) + " -n 1500",
                          "",
                          #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide | #PB_Program_Ascii)
       
        While ProgramRunning(ping)
            If Run = 0 ; <-------------- et ici utiliser  *Run et pas "Run"
                ProcedureReturn
            EndIf
           
            out$ =  ReadProgramString(ping)
            AddGadgetItem(#FEN1_Edit_2, 0, out$)
        Wend
    ForEver
EndProcedure



; Epb

il ne faut pas se focaliser sur le Thread , un Thread c'est une procedure comme toutes les autres !!

la seule différence c'est qu'on ne peut transmettre qu'un seul paramètre (je me demande d'ailleurs pourquoi une tel limite mais bon )

tu appel donc un thread, comme si tu appelais une procedure
seule la façon d'ecrire l'appel change , puisqu'on Transmet le seul parametre possible (variable ou pointeur comme tu veux !! )
et qu'on utilise la commande CreateThread(Adresse de la procedure, parametre a passer )

de cette façon : (exemple utilisant une variable au lieu d'un pointeur )

1- appel de la procedure "AlertThread(toto)"

Code : Tout sélectionner

CreateThread(@AlertThread(), toto)

2- dans la procedure "AlertThread(toto)"
nous avons :

Code : Tout sélectionner

Procedure AlertThread(Parameter)
toto=Parameter ; ici toto est local donc ont le remplis avec le parametre pour pouvoir l'utiliser dans la procedure
  Repeat
    Debug toto ; <--- ici on peut afficher le contenu de toto, qui est remplis par le parametre , bref comme une procedure normale !!
    Delay(2000)
  ForEver

EndProcedure

ps : dans l'absolu rien n'empeche le passage de plusieurs parametres a un Thread , mais faut alors ruser

Code : Tout sélectionner

; Activez TreadSafe !!!
Declare alertthread(parameter)

plusieurs_parametre.s="riri,fifi,loulou"

CreateThread(@AlertThread(), @plusieurs_parametre.s)

MessageRequester("Info", "Toutes les 2 secondes on affiche les parametres transmis"+#LF$+"Click pour finir le Programme", 0) 



; zone Procedures
Procedure AlertThread(Parameter)
plusieurs_parametre.s=Peeks(Parameter)
  Repeat
   Debug StringField(plusieurs_parametre.s,1,",")
	Debug StringField(plusieurs_parametre.s,2,",")
	Debug StringField(plusieurs_parametre.s,3,",")
    Delay(2000)
  ForEver

EndProcedure

a propos de KillThread :

ça ne sert a rien de vouloir utiliser cette fonction !!
Fred a bien expliqué qu'un Thread se Termine lorsqu'on sort de la procedure !!
donc un simple ProcedureReturn suffit !!


voici un exemple , au bout de 3 affichage le thread se termine :
ici j'utilise une variable Static avec un compteur, mais ce pourrai etre un changement de valeur dans le parametre ...

Code : Tout sélectionner

; Activez TreadSafe !!!
Declare alertthread(parameter)

plusieurs_parametre.s="riri,fifi,loulou"

CreateThread(@AlertThread(), @plusieurs_parametre.s)

MessageRequester("Info", "Toutes les 2 secondes on affiche les parametres transmis"+#LF$+"Click pour finir le Programme", 0) 



; zone Procedures
Procedure AlertThread(Parameter)
		Static compteur
		plusieurs_parametre.s=Peeks(Parameter)
		Repeat
				Debug StringField(plusieurs_parametre.s,1,",")
				Debug StringField(plusieurs_parametre.s,2,",")
				Debug StringField(plusieurs_parametre.s,3,",")
				Delay(2000)
				compteur=compteur+1
				if compteur=3 ; apres 3 affichage , le tread n'affichera plus rien !! 
				Debug  "fin du Thread ! "
						ProcedureReturn
				Endif
		ForEver
		
EndProcedure

derniere chose , il faut toujours activer le comutateur "ThreadSafe" lorsqu'on utilise des Threads !!
meme si ça peut marcher sans , tu ne peux pas savoir a l'avance, le cirque que cela peut eventuellement produire en Ram
surtout si tu utilises des Chaine$