Option Strict On Imports System.Threading Public Class clsThread 'initialisation d'un nouveau thread Dim t As New Thread(AddressOf Job) 'variable de stockage de l'état de la tâche Dim m_tacheOK As Boolean 'initilaisation d'un générateur de nombre aléatoire pour l'exemple Dim rd As New Random(System.DateTime.Now.Millisecond) 'on renseigne ici le nom du thread ainsi que les arguments à passer au thread 'les arguments peuvent contenir un nom d'exécutable à lancer des paramètres etc 'ils peuvent être de type Objet (classe, tableau, collection etc...) Sub New(ByVal Name As String, ByVal Arguments As String) t.Name = Name t.Start(Arguments) End Sub Private Sub Job(ByVal args As Object) 'on caste les arguments qui sont de type Objet par defaut Dim Arguments As String = DirectCast(args, String) 'tache ici à faire 'process.start() .... 'do while process.hasexited = false .... 'j'ai remplacé par un sleep de durée aléatoire pour l'exemple Thread.Sleep(rd.Next(1000, 20000)) 'la tâche est éffectuée : on affecte true à la variable m_tacheOK = True End Sub ReadOnly Property TacheOK() As Boolean Get Return m_tacheOK End Get End Property ReadOnly Property Name() As String Get Return t.Name End Get End Property ReadOnly Property Thread() As Thread Get Return t End Get End Property End Class
Option Strict On Public Class Form1 'liste principale des threads Dim ListeT As New List(Of clsThread) 'timer de contrôle de la liste des threads Dim WithEvents tmr As New Timer 'bouton de lancement manuel d'un thread Dim WithEvents buttonT As New Button 'variable de comptage des threads pour l'exemple Dim m_nb As Integer Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load buttonT.Text = "Lancement" Me.Controls.Add(buttonT) 'lancement de 3 threads (ajout dans la liste principale) For x = 0 To 2 m_nb += 1 ListeT.Add(New clsThread("thread " & m_nb.ToString, "-p X")) Next 'lancement du timer de contrôle tmr.Interval = 500 tmr.Start() End Sub Private Sub tmr_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmr.Tick 'on initialise une nouvelle liste provisoire de threads 'en effet, on ne peut pas modifier une liste(ajout/suppression) au cours d'une boucle for each Dim listets As New List(Of clsThread) 'pour chaque threads dans la liste des threads For Each th As clsThread In ListeT 'si la tâche est terminée If th.TacheOK Then m_nb += 1 Debug.Print(th.Name & " à fini sa tâche. Lancement du thread " & m_nb.ToString) th.Thread.Abort() th = Nothing 'on rajoute un (ou plusieurs) thread qui lance une nouvelle tâche 'remarque : le thread qui à fini (th) et qui est détruit n'est plus ajouté dans la liste. listets.Add(New clsThread("thread " & m_nb.ToString, "-p X")) Else 'sinon on ajoute le thread en fonctionnement dans la liste provisoire listets.Add(th) End If Next 'on actualise la liste principale des threads ListeT = listets End Sub Private Sub buttonT_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles buttonT.Click 'on ajoute un thread manuellement en cliquant sur le bouton m_nb += 1 ListeT.Add(New clsThread("thread " & m_nb.ToString, "-p M")) Debug.Print("Lancement manuel du thread " & m_nb.ToString) End Sub End Class
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionDo Application.DoEvents() Loop Until mDVD_JOB1.HasExited
Sub IDX(ByVal NAME As String, ByVal EPS As String, ByVal SelItem As Integer) Dim FldAudio As Integer = EPS.Split("/")(0) pIDX = New Process() EPS = FormatEPS(EPS) 'je le format 01 ou 001 pour les tests de fin d'exécution pIDX.StartInfo.FileName = Settings.VobSub.Text SubStp = False 'j'enpêche l'arret pIDX.Start() SubId = pIDX.Id 'stockage interger pour utilisation dans le timer If Process.GetProcessById(SubId).Responding Then TimeJob.Enabled = True 'je test la bonne exécution du process et je lance le timer Do Thread.Sleep(50) Application.DoEvents() Loop Until SubStp SubId = -1 ... End Sub Private Sub TimeJob_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimeJob.Tick Dim Found As Boolean = False If SubId > -1 Then 'je liste les process et je check si le mien y est For Each p As Process In Process.GetProcesses If p.Id SubId Then Found True Next 'si il n'y est pas c'est qu'il est fini If Not Found Then SubStp = True 'je stop ma boucle TimeJob.Enabled = False 'je stop le timer End If End If End Sub
Public Class MyForm Private Sub bAUDIO_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bAUDIO.Click ... For i As Integer = 0 To JobQueue.SelectedItems.Count - 1 ... Select Case JobQueue.Items(i).SubItems(1).Text Case "DVD" Dim nItem As New ListViewItem(i) nItem.SubItems.Add(FileName & "#" & Arguments) MyJobList.Items.Add(nItem) 'OK Case "BD" ' End Select Next If MyJobList.Items.Count > 0 Then ListeT.Add(New clsThread(MyJobList.Items(0).SubItems(0).Text, MyJobList.Items(0).SubItems(1).Text)) 'OK MyJobList.Items(0).Remove() 'OK TimeJob.Interval = 500 'OK TimeJob.Start() 'OK End If End Sub Private Sub TimeJob_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TimeJob.Tick Dim listets As New List(Of clsThread) For Each th As clsThread In ListeT If th.TacheOK Then 'OK (Détect True à interval) MsgBox("job ok") ' ne s'affiche pas th.Thread.Abort() th = Nothing ... If MyJobList.Items.Count > 0 Then listets.Add(New clsThread(MyJobList.Items(0).SubItems(0).Text, MyJobList.Items(0).SubItems(1).Text)) MyJobList.Items(0).Remove() Else TimeJob.Stop() ... End If End If Next ListeT = listets End Sub End Class Public Class clsThread ... Private mProcess As Process Private Sub Job(ByVal args As Object) Dim Arguments As String = DirectCast(args, String) mProcess = New Process() mProcess.StartInfo.FileName = Arguments.Split(CChar("#"))(0) mProcess.StartInfo.Arguments = Arguments.Split(CChar("#"))(1) mProcess.Start() 'OK Do While mProcess.HasExited = False 'OK 'Thread.Sleep(50) Application.DoEvents() Loop mProcess.WaitForExit() m_tacheOK = True 'OK End Sub ... End Class
Function VolatileRead(Of T)(ByRef Address As T) As T VolatileRead = Address Threading.Thread.MemoryBarrier() End Function Sub VolatileWrite(Of T)(ByRef Address As T, ByVal Value As T) Threading.Thread.MemoryBarrier() Address = Value End Sub
Private Sub TimeJob_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TimeJob.Tick Dim listets As New List(Of clsThread) For Each th As clsThread In ListeT If VolatileRead(th.TacheOK) Then th.Thread.Abort() th = Nothing listets.Add(New clsThread(MyJobList.Items(0).SubItems(0).Text, MyJobList.Items(0).SubItems(1).Text)) MyJobList.Items(0).Remove() End If Next ListeT = listets End Sub
Cette méthode indique au composant Process d'attendre les gestionnaires d'événements et processus une durée infinie pour s'arrêter. Une application peut alors cesser de répondre.
Dim MyJobList As New ListView(dans la même Form que le timer.)
If mProcess.Responding Then ...Pour générer une erreur (J'ai bien une erreur).
If th.TacheOK Thenaprès il zap la boucle.
Private Sub TimeJob_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TimeJob.Tick Dim listets As New List(Of clsThread) For Each th As clsThread In ListeT MsgBox(th.TacheOK) If th.TacheOK Then ... End If Next ListeT = listets End Sub
VolatileRead(th.TacheOK)
Pas moyen l'appz ne repond plus, si je le supprime.
Do While mProcess.HasExited = False 'OK 'Thread.Sleep(50) Application.DoEvents() Loop