Sujet Précédent Sujet Suivant

Problème DoEvents

Résolu
Nicolas H. Messages postés 36 Date d'inscription vendredi 19 octobre 2001 Statut Membre Dernière intervention 26 mai 2016 - 25 juil. 2011 à 23:30
 Utilisateur anonyme - 3 août 2011 à 01:05
Bonjour,

Je développe un petit GUI pour le backup de mes DVD (méthode perso).

Dans cette appz je lance plusieurs process x264 et je récupère les infos via le code de riadhh05 (http://www.vbfrance.com/codes/REDIRECTION-APPLICATION-CONSOLE-VERS-TEXTBOX_44925.aspx).

Mon problème est qu'en plus des process x264, je lance d'autre fonction comme l'enco du son, la génération de D2V ou la génération d'IDX, via une autre exécution de process avec encore une foi des DoEvents.

Si un job x264 se termine et lance le suivant pendant un rip son le DoEvents semble être redirigé vars le process x264 et bloque l'enco son suivant jusqu'à la fin du process x264.

Je viens de trouver qq info sur les threads qui semble pas mal.

Ceci devrait je pense résoudre mon problème mais après test du code ([VB.NET 2008] EXECUTION MULTITHREAD DE PLUSIEURS FONCTION À L'AIDE D'UN MANAGER DE THREAD) de ShadowTzu.

Le système bouffe pas mal ressource ~32% du CPU alors que mon DoEvents (defect) lui ne demande que 10 à 13% du CPU.

Qqu aurait-il une idée des ressources et de la fiabilité des threads ou comment je peux gérer ma redirection de DoEvents.


Désolé pour la tartine,
Nico
A voir également:

27 réponses

Précédent
  • 1
  • 2
Réponse 21 / 27
Nicolas H. Messages postés 36 Date d'inscription vendredi 19 octobre 2001 Statut Membre Dernière intervention 26 mai 2016 1
2 août 2011 à 23:02
Voici ma Form pour faire court, j'ai supp les btn et function inutilisé.

clsThread : 

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 mProcess As Process

    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)
        mProcess = New Process()
        mProcess.StartInfo.FileName = Arguments.Split(CChar("#"))(0)
        mProcess.StartInfo.Arguments = Arguments.Split(CChar("#"))(1)
        mProcess.Start()
        Do While mProcess.HasExited = False
        Loop
        mProcess.WaitForExit()
        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



Form : 


#Region " Imports "

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.Diagnostics
Imports System.IO
Imports System.Threading

#End Region

Public Class Queue

    Friend mMKV_MERGE As MKV_MERGE

    Dim ListeT As New List(Of clsThread)

    Dim MyJobList As New ListView

    Dim ChkOpt As Integer = -1

    Dim D2GId, AudioId, SubId, MergeId As Integer

    Dim D2GStp, AudioStp, SubStp, MergeStp As Boolean

#Region " UP/DOWN "

    Private Sub UP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UP.Click
        MoveUPItem(JobQueue)
    End Sub

    Private Sub DOWN_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DOWN.Click
        MoveDOWNItem(JobQueue)
    End Sub

#End Region

#Region " CLEAR/DELETE "

    Private Sub CLEAR_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CLEAR.Click
        JobQueue.Items.Clear()
    End Sub

    Private Sub DELETE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DELETE.Click
        For Each SelItem As ListViewItem In JobQueue.SelectedItems
            SelItem.Remove()
        Next
    End Sub

#End Region

#Region " SAVE/LOAD "

    Private Sub SAVEJob_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SAVEJob.Click
        SaveJobQueue()
    End Sub

    Private Sub LOADJob_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LOADJob.Click
        JobQueue.Items.Clear()
        LoadJobQueue()
    End Sub

#End Region

#Region " Manage Action "

    Private Sub bD2GDGI_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bD2GDGI.Click
        'pas utilisé dans le test
    End Sub

    Private Sub bAUDIO_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bAUDIO.Click
        If JobQueue.SelectedItems.Count = 0 Then Exit Sub
        cJOB.Text = "EXTRACTION OF AUDIO STREAM FOR SELECTED JOB"
        DisableAll()
        ProgressBar1.Maximum = JobQueue.SelectedItems.Count
        ProgressBar1.Value = 0
        For i As Integer = 0 To JobQueue.SelectedItems.Count - 1
            If JobQueue.SelectedItems(i).SubItems(5).Text = "OK" Then
                Continue For
            End If
            Dim NAME, EPS As String
            NAME = JobQueue.SelectedItems(i).SubItems(0).Text
            EPS = FormatEPS(JobQueue.SelectedItems(i).SubItems(2).Text)
            Select Case JobQueue.Items(i).SubItems(1).Text
                Case "DVD"
                    If My.Computer.FileSystem.DirectoryExists(Settings.PjFld.Text & "\DVD" & NAME & "\Episode " & EPS & "\DVD_VOLUME\VIDEO_TS") Then
                        Dim FileName, Arguments, FldAudio, UseFabProfile, AudioType, AudioLang As String
                        Dim UseFab = JobQueue.SelectedItems(i).SubItems(8).Text
                        Select Case UseFab
                            Case "6"
                                FileName = Settings.Fab6.Text
                            Case "7"
                                FileName = Settings.Fab7.Text
                            Case "8"
                                FileName = Settings.Fab8.Text
                            Case "8 Qt"
                                FileName = Settings.Fab8Qt.Text
                        End Select
                        FldAudio = EPS.Split("/")(0)
                        UseFabProfile = JobQueue.SelectedItems(i).SubItems(10).Text
                        AudioType = JobQueue.SelectedItems(i).SubItems(9).Text
                        AudioLang = JobQueue.SelectedItems(i).SubItems(11).Text
                        Arguments = "/MODE ""DVDGENERIC"" /SRC """ & Settings.PjFld.Text & "\DVD" & NAME & "\Episode " & EPS & "\DVD_VOLUME\VIDEO_TS"" /DEST """ & Settings.PjFld.Text & "\DVD" & NAME & "\Audio" & FldAudio & """ /PROFILE """ & UseFabProfile & """ /AUDIO """ & AudioLang & """ /AUDIOTYPE """ & AudioType & """ /CLOSE"
                        Dim nItem As New ListViewItem(JobQueue.SelectedItems(i).Index)
                        nItem.SubItems.Add(FileName & "#" & Arguments)
                        MyJobList.Items.Add(nItem)
                    End If
                Case "BD"
                    '
                Case Else
                    Exit Select
            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))
            MyJobList.Items(0).Remove()
            TimeJob.Interval = 500
            TimeJob.Start()
        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 VolatileRead(th.TacheOK) Then   ' ou th.TacheOK
                th.Thread.Abort()
                th = Nothing
                ' if my file exist then write OK items(t.name)
                ProgressBar1.Value = ProgressBar1.Value + 1
                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()
                    EnableAll()
                End If
            End If
        Next
        ListeT = listets
    End Sub

    Private Sub bSUBTITLE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bSUBTITLE.Click
        'pas utilisé dans le test
    End Sub

    Private Sub bMERGE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bMERGE.Click
        'pas utilisé dans le test
    End Sub

#End Region

#Region " Move UP Item "

    Private Sub MoveUPItem(ByRef List As ListView)
        'pas utilisé dans le test
    End Sub

#End Region

#Region " Move DOWN Item "

    Private Sub MoveDOWNItem(ByRef List As ListView)
        'pas utilisé dans le test
    End Sub

#End Region

#Region " Format EPS "

    Public Function FormatEPS(ByVal EPS As String) As String
        Dim EP0 As Integer = EPS.Split("/")(0)
        Dim EP1 As Integer = EPS.Split("/")(1)
        If EP1 < 10 Then Return EP0
        If EP1 >= 10 And EP1 < 100 Then Return Format(EP0, "00")
        If EP1 >= 100 And EP1 < 1000 Then Return Format(EP0, "000")
    End Function

#End Region

#Region " Build a D2V "

    Private pD2V As Process

    Public Function D2V(ByVal NAME As String, ByVal EPS As String) As Boolean
        'pas utilisé dans le test
    End Function

#End Region

#Region " Build a DGI "

    Private pDGI As Process

    Public Function DGI(ByVal NAME As String, ByVal EPS As String) As Boolean
        'pas utilisé dans le test
    End Function

#End Region

#Region " Build IDX/SUB "

    Private pIDX As Process

    Sub IDX(ByVal NAME As String, ByVal EPS As String, ByVal SelItem As Integer)
        'pas utilisé dans le test
    End Sub

#End Region

#Region " Build a MKV for DVD "

    Private pMKVM As Process

    Sub MKVM_DVD(ByVal Opts As Integer, ByVal NAME As String, ByVal EPS As String, ByVal fEPS As String, ByVal RATIO As String)
        'pas utilisé dans le test
    End Sub

    Sub StartMerge(ByVal Application_Name As String, ByVal Arguments As String)
        'pas utilisé dans le test
    End Sub

    Sub StopMerge()
        'pas utilisé dans le test
    End Sub

#End Region

#Region " AES Encrypt/Decrypt "

    Public Function AES_Encrypt(ByVal input As String, ByVal pass As String) As String
        'pas utilisé dans le test
    End Function

    Public Function AES_Decrypt(ByVal input As String, ByVal pass As String) As String
        'pas utilisé dans le test
    End Function

#End Region

#Region " Save/Load JobQueue "

    Sub SaveJobQueue()
        'pas utilisé dans le test
    End Sub

    Public Sub LoadJobQueue(Optional ByVal First As Boolean = False)
        'pas utilisé dans le test
    End Sub

#End Region

#Region " Enable / Disable All "

    Sub EnableAll()
        Panel1.Visible = False
        JobQueue.Enabled = True
        bMERGE.Enabled = True
        bSUBTITLE.Enabled = True
        bAUDIO.Enabled = True
        bD2GDGI.Enabled = True
        LOADJob.Enabled = True
        SAVEJob.Enabled = True
        CLEAR.Enabled = True
        DELETE.Enabled = True
        DOWN.Enabled = True
        UP.Enabled = True
        JobQueue.Refresh()
        JobQueue.Focus()
    End Sub

    Sub DisableAll()
        UP.Enabled = False
        DOWN.Enabled = False
        DELETE.Enabled = False
        CLEAR.Enabled = False
        SAVEJob.Enabled = False
        LOADJob.Enabled = False
        bD2GDGI.Enabled = False
        bAUDIO.Enabled = False
        bSUBTITLE.Enabled = False
        bMERGE.Enabled = False
        JobQueue.Enabled = False
        Panel1.Visible = True
    End Sub

#End Region

    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

End Class
0
Réponse 22 / 27
Nicolas H. Messages postés 36 Date d'inscription vendredi 19 octobre 2001 Statut Membre Dernière intervention 26 mai 2016 1
2 août 2011 à 23:15
Je viens de voir le problème. 

            If VolatileRead(th.TacheOK) Then
                ...
            Else
                listets.Add(th)  'j'ai oublié ceci
            End If


Sorry.
0
Réponse 23 / 27
Nicolas H. Messages postés 36 Date d'inscription vendredi 19 octobre 2001 Statut Membre Dernière intervention 26 mai 2016 1
2 août 2011 à 23:29
Tout fonctionne comme je le voulais.

Un tout grand MERCI à vous deux pour votre aidé et votre patience.

Je vais creuser le cross thread pour mettre à jour mes TextBox du thread principal maintenant et voir pour killer mon process si on ferme l'appz.
0
Réponse 24 / 27
NHenry Messages postés 15151 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 4 septembre 2024 159
2 août 2011 à 23:32
Bonjour,

D'accord, si ton problème est résolu, pense à mettre "Réponse acceptée".

---------------------------------------------------------------------
[list][*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu, pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 25 / 27
Nicolas H. Messages postés 36 Date d'inscription vendredi 19 octobre 2001 Statut Membre Dernière intervention 26 mai 2016 1
2 août 2011 à 23:40
C'est déjà fait.

Je garde aussi tes deux fonctions, si il peut y avoir des problèmes sans.

Un bug en moins.
0
Réponse 26 / 27
Utilisateur anonyme
3 août 2011 à 00:55
Je vais creuser le cross thread pour mettre à jour mes TextBox du thread principal maintenant

Toujours la même méthode dans la form du thread principal : 
Delegate Sub DelegateMiseAJour(ByVal Texte As String)
'....
texte = "blabla"
'....
If Me.InvokeRequired Then
    Me.Invoke(New DelegateMiseAJour(AddressOf SubMiseAJour), texte)
Else
    SubMiseAJOur(texte)
End If

Private Sub SubMiseAJOur(Texte as String)
    Textbox1.Text = Texte
end Sub

Bonne nuit.
0
Réponse 27 / 27
Utilisateur anonyme
3 août 2011 à 01:05
et voir pour killer mon process si on ferme l'appz.

Rajoute une methode (Sub KillProcess) à la classe clsThread
et met juste : 
if not myprocess.hasexited then myprocess.Kill()

et appelle cette méthode avant la fermeture du projet : 
for each th as clsThread in ListeT
    th.KillProcess
next
0

Discussions similaires

DoEvents, à quoi sa sert exactement ???
tn1 -
tn1 -

3 réponses
limites dans vba excel
Pascal79A -
Pascal79A -

2 réponses
à quoi sert DoEvents?
zwarul -
Kevin.Ory -

3 réponses
EQUIVALENT DE DOEVENTS EN VB.NET
cs_reyman -
reyman -

2 réponses
Rafraichissement Doevents en VB.NET
matteli -
remilafouine -

10 réponses
Rejoignez-nous