Hola,

A ver, tengo un richtextbox que "printa" información hasta finalizar el búcle FOR

Lo que pasa es que mi form se cuelga, no puedo tocar NADA,
Lo que necesito es poder detener (detener del todo) el proceso o mantenerlo en espera (Pause) mediante un botón, o un evento de teclado, o las dos cosas!, pero preferiblemente un botón que esté destinado a pausar el proceso, y otro botón destinado a detener el proceso por completo.

¿Alguien me puede indicar como hacerlo porfavor? No lo quiero hecho, quiero aprender a hacerlo pero no se por donde buscar!

Muchas gracias.

    Public Sub MediaInfoWorkWithFilesInDir(ByVal aDir As DirectoryInfo)
 
        Dim aFile As FileInfo
        For Each aFile In aDir.GetFiles()
            If accepted_extensions.ToLower.Contains(aFile.Extension.ToLower) Then
 
                MI.Open(aFile.FullName)
 
                Dim Pos As Integer = 0
                To_Display = Nothing
                While Pos < MI.Count_Get(StreamKind.Audio)
                    To_Display += "| " + MI.Get_(StreamKind.Audio, Pos, "Format")
                    System.Math.Max(System.Threading.Interlocked.Increment(Pos), Pos - 1)
                End While
 
                consolebox.AppendText("Processing: " + aFile.ToString() + To_Display.ToString() + vbNewLine)
                consolebox.SelectionStart = consolebox.Text.Length
                consolebox.ScrollToCaret()
 
            End If
        Next
    End Sub
 

Muchas gracias Nov!

Y si lo que quiero es Pausar el proceso también puedo usar el backgroundworker? en esa referencia no explican como Pausar, solamente Detener.

Osea, pausar y que al volver a darle al botón se retome "el proceso" desde le punto en el que se pausó... ¿Es posible?

usa un simple Thread y listo, eso evita que se te cuelge la aplicacion en esos procesos.

De verdad, llevo todo el día sin poder progresar con mi form, no consigo meter los subs de "organize function" region en un nuevo thread para que no me bloquee la app.

Estoy harto de hacer borrón y cuenta nueva, sin ayuda no puedo hacer esto...

He leido decenas de ejemplos, pero en ninguno tratan un caso parecido al mío, solo son threads con un "FOR" y eso no me sirve para nada,
Entiendo más o menos como funciona el backgroundworker, pero como son 3 subs, es que me pierdo porque necesito pasarle un argumento al thread, al trasladar la region a un nuevo thread...

Espero la bondad de alguien para que me inserte toda la region de "organize function" para que trabaje en un nuevo thread

---

Este es el form completo:

PD: Hay un thread por ahí suelto en el form, pero solo lo puse para tenerlo a mano, para hacer mis experimentos  

Al pinchar en el start button llama a la función de "organize function", que como ya digo, son 3 subs.

Imports System.IO
Imports System.Threading
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports Ookii.Dialogs
 
 
 
 
    Public Class Form1
 
#Region "Declarations"
 
        ' Extensions
        Dim accepted_extensions As String = ".264 .3gp .asf .asx .avi .avc .bsf .bdmv .divx .dv .evo .f4v .flv .hdmov .m1v .m2t .m2ts .m2v .m4v .mkv .mov .mp4 .mpeg .mpg .mpv4 .mts .ogm .ogv .qt .rmvb .swf .ts .vob .webm .wmv"
 
        ' Options
        Dim attribs As Boolean
        Dim playlist As Boolean
        Dim multitrack As Boolean
        Dim metadata As Boolean
        Dim wordcase As Boolean
        Dim lowercase As Boolean
        Dim ac3 As Boolean
        Dim dts As Boolean
        Dim wav As Boolean
 
        ' Outputs
        Dim output As String
        Dim To_Display As String
 
        ' MediaInfo
        Dim MI As MediaInfo
 
        ' Backgroundworker
        Dim paused As Boolean = False
 
        ' Others
        Dim processedfiles As Integer = Nothing
        Dim totalfiles As Integer = Nothing
        Dim problems As Integer = Nothing
        Dim NameOfDirectory As String = Nothing
        Dim aFile As FileInfo
 
        'Highlighted ranges
        Dim a As Integer
    Dim b As Integer
 
 
 
#End Region
 
 
    Dim t As New Thread(AddressOf ThreadProc)
 
    Public Sub ThreadProc()
        Dim i As Integer
        For i = 0 To 90
            If paused = True Then MsgBox("SUSPEND")
            MsgBox(i)
            ' Yield the rest of the time slice.
            Thread.Sleep(1500)
        Next
    End Sub
 
 
 
 
 
 
 
#Region "Properties"
 
        ' Folder textbox
        Public Property userSelectedFolderPath() As String
            Get
                Return foldertextbox.Text
            End Get
            Set(value As String)
                foldertextbox.Text = value
            End Set
        End Property
 
        ' Metadata textbox
        Public Property userSelectedFolderPathmetadata() As String
            Get
                Return metadatatextbox.Text
            End Get
            Set(value As String)
                metadatatextbox.Text = value
            End Set
        End Property
 
        ' Paused backgroundworker
        Public Property IsPaused() As Boolean
            Get
                Return paused
            End Get
            Set(value As Boolean)
                paused = value
            End Set
        End Property
 
#End Region
 
#Region "Load / Close"
 
        ' Load
        Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
            ' Options checkboxes
            If My.Settings.delattribs Then attrib_checkbox.Checked = True
            If My.Settings.genplaylists Then playlist_checkbox.Checked = True
            If My.Settings.findmultitracks Then multitrack_checkbox.Checked = True
            If My.Settings.findac3 Then ac3_checkbox.Checked = True
            If My.Settings.finddts Then dts_checkbox.Checked = True
            If My.Settings.findwav Then wav_checkbox.Checked = True
            If My.Settings.findmetadata Then metadata_checkbox.Checked = True
            If My.Settings.renwordcase Then wordcase_checkbox.Checked = True
            If My.Settings.renlowercase Then lowercase_checkbox.Checked = True
 
            ' Folder button
            If Not My.Computer.FileSystem.DirectoryExists(My.Settings.folderpath) Then
                foldertextbox.Text = "Select a folder..."
                My.Settings.folderpath = Nothing
                My.Settings.Save()
            Else
                foldertextbox.Text = My.Settings.folderpath
                start_button.Enabled = True
                ' Total files label
                NameOfDirectory = userSelectedFolderPath
                gettotalfiles(NameOfDirectory)
                totalfiles_label.Text = totalfiles.ToString() + " Total video files"
            End If
 
            If Not My.Computer.FileSystem.DirectoryExists(My.Settings.metadatafolder) Then
                metadatatextbox.Text = "Select a folder to save the converted videos without metadata..."
                My.Settings.metadatafolder = Nothing
                My.Settings.Save()
            Else
                metadatatextbox.Text = My.Settings.metadatafolder
            End If
 
            ' MediaInfo Instance
            MI = New MediaInfo
 
        End Sub
 
#End Region
 
#Region "Get Total files Function"
 
        Public Sub gettotalfiles(Directory)
            totalfiles = 0
            Dim MyDirectory As DirectoryInfo
            MyDirectory = New DirectoryInfo(NameOfDirectory)
            gettotalfilesWorkWithDirectory(MyDirectory)
        End Sub
 
        Public Sub gettotalfilesWorkWithDirectory(ByVal aDir As DirectoryInfo)
            Dim nextDir As DirectoryInfo
            gettotalfilesWorkWithFilesInDir(aDir)
            For Each nextDir In aDir.GetDirectories
                gettotalfilesWorkWithDirectory(nextDir)
            Next
        End Sub
 
        Public Sub gettotalfilesWorkWithFilesInDir(ByVal aDir As DirectoryInfo)
            Dim aFile As FileInfo
            For Each aFile In aDir.GetFiles()
                If accepted_extensions.ToLower.Contains(aFile.Extension.ToLower) Then totalfiles += 1
            Next
        End Sub
 
#End Region
 
#Region "Option checkboxes"
        ' attributtes checkbox
        Private Sub attrib_button_CheckedChanged(sender As Object, e As EventArgs) Handles attrib_checkbox.CheckedChanged
            If attrib_checkbox.Checked = True Then
                attribs = True
                My.Settings.delattribs = True
            Else
                attribs = False
                My.Settings.delattribs = False
            End If
            My.Settings.Save()
        End Sub
 
        ' playlist checkbox
        Private Sub playlist_button_CheckedChanged(sender As Object, e As EventArgs) Handles playlist_checkbox.CheckedChanged
            If playlist_checkbox.Checked = True Then
                playlist = True
                My.Settings.genplaylists = True
            Else
                playlist = False
                My.Settings.genplaylists = False
            End If
            My.Settings.Save()
        End Sub
 
        ' multitrack checkbox
        Private Sub multitrack_button_CheckedChanged(sender As Object, e As EventArgs) Handles multitrack_checkbox.CheckedChanged
            If multitrack_checkbox.Checked = True Then
                multitrack = True
                My.Settings.findmultitracks = True
            Else
                multitrack = False
                My.Settings.findmultitracks = False
            End If
            My.Settings.Save()
        End Sub
 
        ' AC-3 checkbox
        Private Sub ac3_button_CheckedChanged(sender As Object, e As EventArgs) Handles ac3_checkbox.CheckedChanged
            If ac3_checkbox.Checked = True Then
                ac3 = True
                My.Settings.findac3 = True
            Else
                ac3 = False
                My.Settings.findac3 = False
            End If
            My.Settings.Save()
        End Sub
 
        ' DTS checkbox
        Private Sub dts_button_CheckedChanged(sender As Object, e As EventArgs) Handles dts_checkbox.CheckedChanged
            If dts_checkbox.Checked = True Then
                dts = True
                My.Settings.finddts = True
            Else
                dts = False
                My.Settings.finddts = False
            End If
            My.Settings.Save()
        End Sub
 
        ' WAV checkbox
        Private Sub wav_button_CheckedChanged(sender As Object, e As EventArgs) Handles wav_checkbox.CheckedChanged
            If wav_checkbox.Checked = True Then
                wav = True
                My.Settings.findwav = True
            Else
                wav = False
                My.Settings.findwav = False
            End If
            My.Settings.Save()
        End Sub
 
        ' Metadata checkbox
        Private Sub metadata_checkbox_CheckedChanged(sender As Object, e As EventArgs) Handles metadata_checkbox.CheckedChanged
            If metadata_checkbox.Checked = True Then
                metadatatextbox.Enabled = True
                metadatabutton.Enabled = True
                metadata = True
                My.Settings.findmetadata = True
            Else
                metadatatextbox.Enabled = False
                metadatabutton.Enabled = False
                metadata = False
                My.Settings.findmetadata = False
            End If
            My.Settings.Save()
        End Sub
 
        ' Word-case
        Private Sub wordcase_checkbox_CheckedChanged(sender As Object, e As EventArgs) Handles wordcase_checkbox.CheckedChanged
            If wordcase_checkbox.Checked = True Then
                wordcase = True
                lowercase = False
                lowercase_checkbox.Checked = False
                My.Settings.renwordcase = True
            Else
                wordcase = False
                My.Settings.renwordcase = False
            End If
            My.Settings.Save()
        End Sub
 
        ' Lower-case
        Private Sub lowercase_checkbox_CheckedChanged(sender As Object, e As EventArgs) Handles lowercase_checkbox.CheckedChanged
            If lowercase_checkbox.Checked = True Then
                lowercase = True
                wordcase = False
                wordcase_checkbox.Checked = False
                My.Settings.renlowercase = True
            Else
                lowercase = False
                My.Settings.renlowercase = False
            End If
            My.Settings.Save()
        End Sub
 
#End Region
 
#Region "Folder buttons"
 
        ' Folder button
        Public Sub C1Button3_Click(sender As Object, e As EventArgs) Handles folderbutton.Click
            Dim folderselect As New VistaFolderBrowserDialog
            folderselect.ShowNewFolderButton = True
            If folderselect.ShowDialog.ToString() = "OK" Then
                userSelectedFolderPath = folderselect.SelectedPath
                My.Settings.folderpath = folderselect.SelectedPath
                My.Settings.Save()
                NameOfDirectory = userSelectedFolderPath
                gettotalfiles(NameOfDirectory)
                totalfiles_label.Text = totalfiles.ToString() + " Total video files"
                start_button.Enabled = True
            End If
        End Sub
 
        ' Metadata folder button
        Public Sub metadatabutton_Click(sender As Object, e As EventArgs) Handles metadatabutton.Click
            Dim metadatafolderselect As New VistaFolderBrowserDialog
            metadatafolderselect.ShowNewFolderButton = True
            If metadatafolderselect.ShowDialog.ToString() = "OK" Then
                userSelectedFolderPathmetadata = metadatafolderselect.SelectedPath
                My.Settings.metadatafolder = metadatafolderselect.SelectedPath
                My.Settings.Save()
            End If
        End Sub
 
#End Region
 
#Region "Append text function"
 
        ' Append Text
        Private Sub AppendText(box As RichTextBox, color As Color, text As String)
            Dim start As Integer = box.TextLength
            box.AppendText(text)
            Dim [end] As Integer = box.TextLength
 
            ' Textbox may transform chars, so (end-start) != text.Length
            box.[Select](start, [end] - start)
            If True Then
                box.SelectionColor = color
                ' could set box.SelectionBackColor, box.SelectionFont too.
            End If
            box.SelectionLength = 0
            ' clear
        End Sub
 
#End Region
 
 
 
 
#Region "Organize function"
 
        Public Sub MediaInfo(Directory)
            Dim MyDirectory As DirectoryInfo
            MyDirectory = New DirectoryInfo(NameOfDirectory)
            MediaInfoWorkWithDirectory(MyDirectory)
        End Sub
 
        Public Sub MediaInfoWorkWithDirectory(ByVal aDir As DirectoryInfo)
            Dim nextDir As DirectoryInfo
            MediaInfoWorkWithFilesInDir(aDir)
        For Each nextDir In aDir.GetDirectories
            If playlist = True Then
                Using writer As StreamWriter = New StreamWriter(aDir.FullName & "\" & nextDir.Name & "\" & nextDir.Name & ".m3u", False, System.Text.Encoding.UTF8)
                    'overwrite existing playlist
                End Using
            End If
            MediaInfoWorkWithDirectory(nextDir)
        Next
        End Sub
 
        Public Sub MediaInfoWorkWithFilesInDir(ByVal aDir As DirectoryInfo)
 
            Dim aFile As FileInfo
 
            For Each aFile In aDir.GetFiles()
 
                If accepted_extensions.ToLower.Contains(aFile.Extension.ToLower) Then
 
                    ' print output
                    AppendText(consolebox, Color.Yellow, "Processing: ")
                    AppendText(consolebox, Color.White, aFile.ToString() + vbNewLine)
                    consolebox.ScrollToCaret()
                    processedfiles += 1
                    totalfiles_label.Text = "Processed " + processedfiles.ToString() + " of " + totalfiles.ToString() + " total video files"
 
                    ' Attributes
                    If attribs = True Then
                        aFile.Attributes = (aFile.Attributes And Not FileAttributes.ReadOnly And Not FileAttributes.Hidden And Not FileAttributes.System And Not FileAttributes.Archive)
                    End If
 
                    ' Rename to Word-Case
                    If wordcase = True Then
                        Dim renamestr As String = StrConv(aFile.Name, VbStrConv.ProperCase)
                        My.Computer.FileSystem.RenameFile(aFile.FullName, renamestr + "_FILMEN")
                        My.Computer.FileSystem.RenameFile(aFile.FullName + "_FILMEN", renamestr)
                    End If
 
                    ' Rename to Lower-Case
                    If lowercase = True Then
                        Dim renamestr As String = StrConv(aFile.Name, VbStrConv.Lowercase)
                        My.Computer.FileSystem.RenameFile(aFile.FullName, renamestr + "_FILMEN")
                        My.Computer.FileSystem.RenameFile(aFile.FullName + "_FILMEN", renamestr)
                    End If
 
                    ' Playlists
                    If playlist = True Then
                        Using writer As StreamWriter = New StreamWriter(aFile.DirectoryName.ToString() & "\" & aDir.Name & ".m3u", True, System.Text.Encoding.UTF8)
                            writer.WriteLine(aFile.FullName.ToString())
                        End Using
                    End If
 
                    ' MEDIAINFO:  (ac3, dts, wav and multitrack)
                    If ac3 = True Or dts = True Or wav = True Or multitrack = True Then
 
                        MI.Open(aFile.FullName)
 
                        Dim Pos As Integer = 0
                        To_Display = Nothing
 
                        ' multitrack
                        If multitrack = True Then
                            If MI.Count_Get(StreamKind.Audio) > 1 Then
                                results_box.AppendText("Multi Track: " + aFile.FullName.ToString() + vbNewLine)
                                results_box.SelectionStart = results_box.Text.Length
                                results_box.ScrollToCaret()
                                problems += 1
                                problems_label.Text = problems.ToString() + " problems found"
                            End If
                        End If
 
                        While Pos < MI.Count_Get(StreamKind.Audio)
 
                            ' AC-3
                            If ac3 = True Then
                                If MI.Get_(StreamKind.Audio, Pos, "Format").ToString() = "AC-3" Then
                                    results_box.AppendText("AC3 Track: " + aFile.FullName.ToString() + vbNewLine)
                                    results_box.SelectionStart = results_box.Text.Length
                                    results_box.ScrollToCaret()
                                    problems += 1
                                    problems_label.Text = problems.ToString() + " problems found"
                                End If
                            End If
 
                            ' DTS
                            If dts = True Then
                                If MI.Get_(StreamKind.Audio, Pos, "Format").Contains("DTS") Then
                                    results_box.AppendText("DTS Track: " + aFile.FullName.ToString() + vbNewLine)
                                    results_box.SelectionStart = results_box.Text.Length
                                    results_box.ScrollToCaret()
                                    problems += 1
                                    problems_label.Text = problems.ToString() + " problems found"
                                End If
                            End If
 
                            ' WAV
                            If wav = True Then
                                If MI.Get_(StreamKind.Audio, Pos, "Format").Contains("PCM") Then
                                    results_box.AppendText("WAV Track: " + aFile.FullName.ToString() + vbNewLine)
                                    results_box.SelectionStart = results_box.Text.Length
                                    results_box.ScrollToCaret()
                                    problems += 1
                                    problems_label.Text = problems.ToString() + " problems found"
                                End If
                            End If
 
                            System.Math.Max(System.Threading.Interlocked.Increment(Pos), Pos - 1)
                        End While
                    End If
 
                    If metadata = True Then
                        Dim ffmpeg_process As New Process()
                        Dim ffmpeg_startinfo As New ProcessStartInfo()
                        ffmpeg_startinfo.FileName = "cmd.exe "
                        ffmpeg_startinfo.Arguments = "/C ffmpeg.exe -y -i " & ControlChars.Quote & aFile.FullName.ToString() & ControlChars.Quote & " -f ffmetadata " & ControlChars.Quote & "%TEMP%\" & aFile.Name.ToString() & "_metadata.txt" & ControlChars.Quote & " >NUL 2>&1 && Type " & ControlChars.Quote & "%TEMP%\" & aFile.Name.ToString() & "_metadata.txt" & ControlChars.Quote & "| FINDSTR /I " & ControlChars.Quote & "^INAM ^title" & ControlChars.Quote & " >NUL && Echo FOUND && EXIT || Echo NOT FOUND && Exit"
                        ffmpeg_startinfo.UseShellExecute = False
                        ffmpeg_startinfo.CreateNoWindow = True
                        ffmpeg_startinfo.RedirectStandardOutput = True
                        ffmpeg_startinfo.RedirectStandardError = True
                        ffmpeg_process.EnableRaisingEvents = True
                        ffmpeg_process.StartInfo = ffmpeg_startinfo
                        ffmpeg_process.Start()
                        ffmpeg_process.WaitForExit()
 
                        Dim readerStdOut As IO.StreamReader = ffmpeg_process.StandardOutput
                        Dim FINDstdOut As String = ffmpeg_process.StandardOutput.ReadToEnd
 
                        If FINDstdOut.Contains("FOUND") Then
                            AppendText(consolebox, Color.Red, "TAGS FOUND! Removing tags, please wait..." & vbNewLine)
                            Dim relative_dir As String = aDir.FullName.ToString().Replace(aDir.Root.ToString(), "\")
                            Dim ffmpegconvert_process As New Process()
                            Dim ffmpegconvert_startinfo As New ProcessStartInfo()
                            ffmpegconvert_startinfo.FileName = "cmd.exe "
                            ffmpegconvert_startinfo.Arguments = "/C MKDIR " & ControlChars.Quote & userSelectedFolderPathmetadata & relative_dir & ControlChars.Quote & " 2>NUL & ffmpeg.exe -y -i " & ControlChars.Quote & aFile.FullName.ToString() & ControlChars.Quote & " -c copy -map_metadata -1 " & ControlChars.Quote & userSelectedFolderPathmetadata & relative_dir & "\" & aFile.Name.ToString() & ControlChars.Quote & " >NUL 2>&1 & Exit"
                            ffmpegconvert_startinfo.UseShellExecute = False
                            ffmpegconvert_startinfo.CreateNoWindow = True
                            ffmpegconvert_startinfo.RedirectStandardOutput = True
                            ffmpegconvert_startinfo.RedirectStandardError = True
                            ffmpegconvert_process.EnableRaisingEvents = True
                            ffmpegconvert_process.StartInfo = ffmpegconvert_startinfo
                            ffmpegconvert_process.Start()
                            ffmpegconvert_process.WaitForExit()
                            'Dim ffmpegconvertreaderStdOut As IO.StreamReader = ffmpegconvert_process.StandardOutput
 
                        End If
 
                        Do While readerStdOut.EndOfStream = False
                            consolebox.AppendText(readerStdOut.ReadLine() + vbNewLine)
                            consolebox.SelectionStart = consolebox.Text.Length
                            consolebox.ScrollToCaret()
                        Loop
 
                    End If
                End If
            Next
 
        End Sub
 
#End Region
 
 
 
 
 
 
 
 
 
 
        ' start button
        Private Sub Button2_Click(sender As Object, e As EventArgs) Handles start_button.Click
 
 
 
            If metadata = True And metadatatextbox.Text = "Select a folder to save the converted videos without metadata..." Then
                MsgBox("You must select a folder for the saved metadata videos...", , "Filmen v1.0")
            Else
                If ac3 = False And dts = False And wav = False And multitrack = False And playlist = False And attribs = False And wordcase = False And metadata = False And lowercase = False Then
                    MsgBox("You must select at least one option...", , "Filmen v1.0")
                Else
 
                    consolebox.Clear()
 
                    ' pause / cancel button ON
                    pause_button.Enabled = True
                    cancel_button.Enabled = True
 
 
 
                t.Start()
 
 
 
                    ' Total files label
                    processedfiles = 0
                    totalfiles_label.Text = totalfiles.ToString() + " Total video files"
 
                    ' Problems label
                    problems = 0
                    problems_label.Text = "0 problems found"
 
                    ' Attempt message
                    consolebox.AppendText(vbNewLine + "[+] Attempting to organize your videos in 3...")
                    consolebox.Refresh()
                    consolebox.SelectionStart = consolebox.Text.Length
                    consolebox.ScrollToCaret()
                    Thread.Sleep(750)
                    consolebox.AppendText(vbNewLine + "[+] Attempting to organize your videos in 2...")
                    consolebox.Refresh()
                    consolebox.SelectionStart = consolebox.Text.Length
                    consolebox.ScrollToCaret()
                    Thread.Sleep(750)
                    consolebox.AppendText(vbNewLine + "[+] Attempting to organize your videos in 1..." + vbNewLine + vbNewLine)
                    consolebox.Refresh()
                    consolebox.SelectionStart = consolebox.Text.Length
                    consolebox.ScrollToCaret()
                    Thread.Sleep(750)
 
                    ' Organization process
                    NameOfDirectory = userSelectedFolderPath
                    MediaInfo(NameOfDirectory)
                    consolebox.AppendText(vbNewLine + "[+] Organization finalized!" + vbNewLine)
                    consolebox.Refresh()
                    consolebox.SelectionStart = consolebox.Text.Length
                    consolebox.ScrollToCaret()
 
                    ' pause / cancel button OFF
                    pause_button.Enabled = False
                    cancel_button.Enabled = False
 
                End If
            End If
        End Sub
 
    Private Sub pause_button_Click(sender As Object, e As EventArgs) Handles pause_button.Click
        paused = True
    End Sub
End Class