我正在尝试在VB.NET中编写一个Windows窗体应用程序，它将一些文件从目录中解压缩并将它们上传到服务器。我的问题是应用程序一直锁定我并进入“无响应”模式。我做了一些阅读并确定我需要使用某种类型的多线程。我阅读了有关BackgroundWorker的内容并开始尝试实现它。我在使其正常工作时遇到了一些麻烦。我有一些时间在Sub中运行名为ProcessFiles的进程。这是我尝试实现BackgroundWorker的地方。我计划使用多个BackgroundWorkers，因为我有多个耗时的过程。我还想在屏幕上显示状态消息并尝试使用ReportProgress执行此操作，但无法使其正常工作。还有一个定时器，它以一定的间隔进行检查，以查看是否已将新的.zip文件放入目录中以进行拾取。我在下面发布了我的代码。在此先感谢您的帮助。
Imports System.IO
Imports System.IO.Compression
Imports Microsoft.VisualBasic.Strings
Imports System.ComponentModel
Imports System.Threading
Public Class Form1
Private bw1 As BackgroundWorker
Private de1 As AutoResetEvent
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
End Sub
Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
Me.btnStart.Enabled = False
Me.btnStop.Enabled = True
'Go ahead and manually tick the timer right off the bat to start checking for files
Timer1_Tick(Me, e)
'Once the first tick has occurred, start the timer if needed
If Timer1.Enabled = False Then
WriteToFile("Timer started")
'Timer1.Start()
End If
End Sub
Private Sub btnChooseZipFileLoc_Click(sender As Object, e As EventArgs) Handles btnChooseZipFileLoc.Click
Me.fbdZipFileLocation.ShowDialog()
Me.txtZipFileLoc.Text = Me.fbdZipFileLocation.SelectedPath
End Sub
Private Sub btnChooseExtractToLoc_Click(sender As Object, e As EventArgs) Handles btnChooseExtractToLoc.Click
Me.fbdExtractTo.ShowDialog()
Me.txtExtractToLoc.Text = Me.fbdExtractTo.SelectedPath
End Sub
Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
Me.btnStart.Enabled = True
Me.btnStop.Enabled = False
Timer1.Stop()
End Sub
Private Sub ProcessFiles()
Dim creationTime As DateTime = DateTime.Now
Dim LinuxDestinationPath As String = "\\IMMTerSrv\Bit_Stmts\Test"
Dim LinuxFileCount As Integer
Dim ZipFileTempFolderPath As String = String.Empty
Dim PDFCopyFileCount As Integer = 0
Dim XMLCopyFileCount As Integer = 0
bw1 = New BackgroundWorker()
bw1.WorkerReportsProgress = True
bw1.WorkerSupportsCancellation = True
AddHandler bw1.DoWork, AddressOf bw1_DoWork
AddHandler bw1.ProgressChanged, AddressOf bw1_ProgressChanged
AddHandler bw1.RunWorkerCompleted, AddressOf bw1_RunWorkerCompleted
de1 = New AutoResetEvent(False)
ZipFileTempFolderPath = Me.txtZipFileLoc.Text.TrimEnd("\") + "\ZipFileTemp"
'If ZipFileTemp folder does not exist, create it and copy all .zip files into it
'Files will only get copied in once that way.
'Once a file is complete, it will be moved out into the complete folder
'This provides a way to keep up with which files have been finished and and which ones have not
If System.IO.Directory.Exists(ZipFileTempFolderPath) = False Then
System.IO.Directory.CreateDirectory(ZipFileTempFolderPath)
Dim di As New DirectoryInfo(Me.txtZipFileLoc.Text)
For Each zipfi In di.GetFiles
'If the zip file is not already there, then copy it
If File.Exists(ZipFileTempFolderPath.TrimEnd("\") + "\" + zipfi.Name) = False Then
System.IO.File.Copy(zipfi.FullName, ZipFileTempFolderPath.TrimEnd("\") + "\" + zipfi.Name)
End If
Next
End If
Dim diZipFileTemp As New DirectoryInfo(ZipFileTempFolderPath)
'This gets all files with the oldest created being first
Dim fiArr As FileInfo() = diZipFileTemp.GetFiles().OrderBy(Function(fi) fi.CreationTime).ToArray()
Dim fri As FileInfo
'This begins the process looping thru each .zip file
For Each fri In fiArr
'Before we start processing a new file, we need to check the
'time of day to see if we should proceed to the next file or not
If DetermineFileProcessStatus() = True Then 'If the function returns true, then continue processing the file. Otherwise, do no process.
'Get the single oldest .zip file
'Build string location
Dim CopyZipFilesFrom As String = Me.txtExtractToLoc.Text.TrimEnd("\") + "\" + Strings.Left(fri.Name, fri.Name.Length - 4)
'Only get .zip files
If fri.Extension = ".zip" Then
'Unzip files
If System.IO.Directory.Exists(CopyZipFilesFrom) = False Then
If Not bw1.IsBusy Then
bw1.RunWorkerAsync(fri)
de1.WaitOne()
End If
End If
End If
'The unzip process has ended
'Dim diUZ As New DirectoryInfo(CopyZipFilesFrom.TrimEnd("\") + "\" + Strings.Left(fri.Name, fri.Name.Length - 4))
'Reset file counts
PDFCopyFileCount = 0
XMLCopyFileCount = 0
Dim diUZ As New DirectoryInfo(CopyZipFilesFrom)
'Copy all .pdf files first
For Each fiUZ In diUZ.GetFiles("*.pdf")
fiUZ.MoveTo(LinuxDestinationPath + fiUZ.Name)
PDFCopyFileCount += 1
Next
'Next copy all .xml files
For Each fiUZ In diUZ.GetFiles("*.xml")
fiUZ.MoveTo(LinuxDestinationPath + fiUZ.Name)
XMLCopyFileCount += 1
Next
'Once all of the files have been moved into Linux for archiving, we can
'delete the zip file from the temp directory. This will allow the user to know which files have been completed all the way through in case
'the program crashes.
Dim ZipFileCompletePath As String = Me.txtZipFileLoc.Text.TrimEnd("\") + "\" + "ZipFileComplete"
If System.IO.Directory.Exists(ZipFileCompletePath) = False Then
System.IO.Directory.CreateDirectory(ZipFileCompletePath)
End If
fri.MoveTo(ZipFileCompletePath + "\" + fri.Name)
'Now that all files have been copied from the .zip file, we need to wait until there are less than or equal to 500 files in the linux directory
'before another mass copy is started. Even though these files have been copied into the directory, they still all need to process and this can take
'a couple of additional hours to do.
Do
LinuxFileCount = Directory.GetFiles(LinuxDestinationPath).Count()
Loop Until LinuxFileCount <= 500
Else
Exit Sub
End If
Next fri
Timer1.Stop()
'Close the program because everything has completed
Me.Close()
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If DetermineFileProcessStatus() = True Then
If Timer1.Enabled = True Then
Timer1.Stop()
End If
ProcessFiles()
Timer1.Start()
End If
End Sub
Private Function DetermineFileProcessStatus() As Boolean
Select Case DateTime.Now.Date.DayOfWeek.ToString
Case "Saturday"
If DateTime.Now.TimeOfDay >= New TimeSpan(13, 0, 0) Then
Return True
Else
Return False
End If
Case "Sunday"
If DateTime.Now.TimeOfDay <= New TimeSpan(22, 0, 0) Then
'ProcessFiles()
Return True
Else
Return False
End If
Case Else 'Monday thru Friday
If DateTime.Now.TimeOfDay >= New TimeSpan(9, 0, 0) AndAlso DateTime.Now.TimeOfDay <= New TimeSpan(22, 0, 0) Then
'If DateTime.Now.TimeOfDay >= New TimeSpan(14, 0, 0) AndAlso DateTime.Now.TimeOfDay <= New TimeSpan(22, 0, 0) Then
Return True
Else
Select Case DateTime.Now.Date.DayOfWeek.ToString
Case "Friday"
If DateTime.Now.TimeOfDay < New TimeSpan(14, 0, 0) Then 'It is Friday before 14:00
Else 'Since it has gotten to this point it must be a Friday between 22:00:01 and 23:59:59
End If
Case Else
End Select
Return False
End If
End Select
End Function
'Public Delegate Sub SetLabelTextDelegate(ByVal LabelObject As Label, ByVal Value As String)
'Public Sub SetLabelText(ByVal LabelObject As Label, ByVal Value As String)
' Try
' If LabelObject.InvokeRequired Then
' Dim dlg As New SetLabelTextDelegate(AddressOf SetLabelText)
' dlg.Invoke(LabelObject, Value)
' Else
' LabelObject.Text = Value
' End If
' Catch ex As Exception
' Throw ex
' End Try
'End Sub
Private Sub setLabelText(ByVal text As String)
bw1.ReportProgress(0, text) 'You can write any int as first argument as far as will not be used anyway
End Sub
Private Sub bw1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs)
Me.lblStatus.Text = e.UserState
Me.lblStatus.Update()
End Sub
Private Sub bw1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs)
Try
If e.Cancel = False Then
Dim fi As System.IO.FileInfo
fi = e.Argument
If IsNothing(fi) = False Then
bw1.ReportProgress(0, "Testing....")
UnzipFile(fi.FullName)
e.Result = fi.FullName
End If
End If
Catch ex As Exception
Finally
de1.Set()
End Try
End Sub
Private Sub UnzipFile(ByVal ZipFileFullName As String)
'setLabelText("File " + ZipFileFullName + " is in the process of unzipping!")
'bw1.ReportProgress(0, "File " + ZipFileFullName + " is in the process of unzipping!")
ZipFile.ExtractToDirectory(ZipFileFullName, Me.txtExtractToLoc.Text)
End Sub
Private Sub bw1_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs)
Dim ZipFileFullName As String
ZipFileFullName = e.Result
'setLabelText(lblStatus, ZipFileFullName + " has been unzipped successfully!")
End Sub'