无法取消申请

Question

我有一个将文件复制到不同目录的应用程序。当我单击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 & "ReportsOrphanedFilesItems.txt"
' Create or overwrite the file.
System.IO.File.Create(orphanedFiles).Dispose()
ListofGraphics = MoveLocation & "ReportsListOfGraphics.txt"
' Create or overwrite the file.  
System.IO.File.Create(ListofGraphics).Dispose()
Dim removDupBuildLog = MoveLocation & "ReportsRemvoeDup.txt"
Dim ListLog = MoveLocation & "ReportsListOfGraphics.txt"
ListofFiles = MoveLocation & "ReportsListOfFiles.txt"
' Create or overwrite the file.  
System.IO.File.Create(ListofFiles).Dispose()
MissingFiles = MoveLocation & "ReportsMissingGraphicList.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 SGMLXML Files"
statusText = "Copying SGMLXML 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 类文档中的代码示例，您会发现它每次通过循环检查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

也许在报告进度(...(之后再做一次检查。

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

Application.UseWaitCursor = False不应该在工作线程中 - 将其放在调用backgroundWorker1.RunWorkerAsync()的代码中。

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

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