无法取消申请

Question

我有一个应用程序可以将文件复制到不同的目录中。由于应用程序是运行ning 如果我单击 BtnExit_Click 按钮没有任何反应。我只能在运行完成所有要复制的文件后退出应用程序。

这是我的代码

Private Sub BtnExit_Click(sender As Object, e As EventArgs) Handles btnExit.Click
    BackgroundWorker1.CancelAsync()
    Me.Close()
End Sub

后台工作者：

Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
    Me.txtImgCount.Text = iCount
    Me.txtImgCount.Update()
    Me.fileCount.Text = fCount
    Me.fileCount.Update()
    Me.txtTotal.Update()
    Me.Label8.Text = statusText
    Me.Label8.Update()
    Application.DoEvents()
    Try
        Me.RichTextBox1.Text &= (fileFilename)
        Application.DoEvents()
    Catch ei As DivideByZeroException
        Debug.WriteLine("Exception caught: {0}", ei)
    Finally
    End Try

    Try
        Me.RichTextBox1.Text &= (imgFilename)
        Application.DoEvents()
    Catch ea As DivideByZeroException
        Debug.WriteLine("Exception caught: {0}", ea)
    Finally
    End Try
End Sub

Private Sub BackgroundWorker1_DoWork(sender As Object, e As   System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
    RunCopyFiles()
End Sub


 Private Sub RunCopyFiles()
    BackgroundWorker1.WorkerReportsProgress = True

    Dim sFileToFind As String
    Dim location As String
    'Dim File As String
    statusText = "Initiating"
    status = "Initiating..."
    'Directory Files are located in
    location = txtFolderPath.Text
    'Directory ICN files are located in
    imgLocation = txtSearchICN.Text
    'Directory files are to copied into
    MoveLocation = CopyToPath

    createImgFldr = MoveLocation & "\Figures"
    createReportFldr = MoveLocation & "\Reports"
    createXMLFldr = MoveLocation & "\XML files"

    'Create Figures Folder
    If Not IO.Directory.Exists(createImgFldr) Then
        IO.Directory.CreateDirectory(createImgFldr)
        ' MsgBox("folder created" & createFolder)
    End If
    'Create Reports folder
    If Not IO.Directory.Exists(createReportFldr) Then
        IO.Directory.CreateDirectory(createReportFldr)
        'MsgBox("folder created" & createReportFldr)
    End If
    'Create XML folder
    If Not IO.Directory.Exists(createXMLFldr) Then
        IO.Directory.CreateDirectory(createXMLFldr)
        ' MsgBox("folder created" & createFolder)
    End If

    'Text file with list of file names
    Dim filesToCopy = txtFileName.Text
    orphanedFiles = MoveLocation & "\Reports\OrphanedFilesItems.txt"
    ' Create or overwrite the file.
    System.IO.File.Create(orphanedFiles).Dispose()

    ListofGraphics = MoveLocation & "\Reports\ListOfGraphics.txt"
    ' Create or overwrite the file.  
    System.IO.File.Create(ListofGraphics).Dispose()

    Dim removDupBuildLog = MoveLocation & "\Reports\RemvoeDup.txt"
    Dim ListLog = MoveLocation & "\Reports\ListOfGraphics.txt"
    ListofFiles = MoveLocation & "\Reports\ListOfFiles.txt"
    ' Create or overwrite the file.  
    System.IO.File.Create(ListofFiles).Dispose()

    MissingFiles = MoveLocation & "\Reports\MissingGraphicList.txt"
    ' Create or overwrite the file.  
    System.IO.File.Create(MissingFiles).Dispose()
    Dim FILE_NAME As String

    FILE_NAME = txtFileName.Text
    Dim fileNames = System.IO.File.ReadAllLines(FILE_NAME)

    status = "Copying SGML\XML Files"
    statusText = "Copying SGML\XML Files..."
    fCount = 0
    For i = 0 To fileNames.Count() - 1
        Dim fileName = fileNames(i)
        sFileToFind = location & "\" & fileName & "*.*"

        Dim paths = IO.Directory.GetFiles(location, fileName, IO.SearchOption.AllDirectories)
        If Not paths.Any() Then
            System.IO.File.AppendAllText(orphanedFiles, fileName & vbNewLine)
        Else
            For Each pathAndFileName As String In paths
                If System.IO.File.Exists(pathAndFileName) = True Then
                    Dim sRegLast = pathAndFileName.Substring(pathAndFileName.LastIndexOf("\") + 1)
                    Dim toFileLoc = System.IO.Path.Combine(createXMLFldr, sRegLast)
                    Dim moveToFolder = System.IO.Path.Combine(MoveLocation, "XML files", sRegLast)

                    'if toFileLoc = XML file exists move it into the XML files folder
                    If System.IO.File.Exists(toFileLoc) = False Then
                        System.IO.File.Copy(pathAndFileName, moveToFolder)
                        System.IO.File.AppendAllText(ListofFiles, sRegLast & vbNewLine)
                        Application.DoEvents()
                        fileFilename = (fileName) + vbCrLf
                        fCount = fCount + 1
                        'fileCount.Text = fCount
                    End If
                End If
            Next
        End If
        BackgroundWorker1.ReportProgress(100 * (i + 1) / fileNames.Count)
    Next
    CreateGraphicsFunction()
    GetImages()
    Application.UseWaitCursor = False
    Application.DoEvents()
End Sub

Answer 1

如果您查看 BackgroundWorker Class 文档中的代码示例，您会发现它在每次循环中都会检查 worker.CancellationPending 属性。

因此您需要进行一些更改：

Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
    Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)
    RunCopyFiles(worker, e)
End Sub

Private Sub RunCopyFiles(worker As BackgroundWorker, e As DoWorkEventArgs)
    ... other code here

    For Each pathAndFileName As String In paths
        ... other code here
        If worker.CancellationPending Then
            e.Cancel = True
            Exit Sub
        End If
    Next

也许在 ReportProgress(...) 之后再进行一次检查。

此外，您还需要设置 backgroundWorker1.WorkerSupportsCancellation = True。

Application.UseWaitCursor = False 不应该在 worker 中 - 把它放在调用 backgroundWorker1.RunWorkerAsync().

的代码中

正如 LarsTech 在评论中所写，您应该删除对 Application.DoEvents() 的所有调用：它的问题在 Use of Application.DoEvents().

中列出

最后，请确保您使用的是 Option Strict On。

无法取消申请

Unable to cancel application

vb.net

backgroundworker

exit