SevenZipSharp: Events not firing - vb.net

I have the following problem with SevenZipSharp. I want to compress a list(of String) containing filenames with full path. My code works fine, but only the last event(zip.CompressionFinished) is firing. Neither fFileCompressionStarted nor fCompressing is firing. What am I doing wrong?
Even if I set breakpoints in the event-subs or type "Stop", nothing happens.
Here is my code:
Dim working As Boolean
Private Sub start()
Dim zip As New SevenZipCompressor
zip.ArchiveFormat = OutArchiveFormat.SevenZip
zip.CompressionMode = CompressionMode.Create
zip.CompressionLevel = CompressionLevel.Fast
zip.CompressionMethod = CompressionMethod.Lzma2
zip.DirectoryStructure = True
zip.FastCompression = True
zip.IncludeEmptyDirectories = True
zip.PreserveDirectoryRoot = True
zip.TempFolderPath = System.IO.Path.GetTempPath()
AddHandler zip.FileCompressionStarted, AddressOf fFileCompressionStarted
AddHandler zip.Compressing, AddressOf fCompressing
AddHandler zip.CompressionFinished, AddressOf Compress_Finished
working = True
Label10.Text = "Startup..."
Application.DoEvents()
zip.BeginCompressFiles(filename, flist.ToArray)
While working = True
Threading.Thread.Sleep(250)
Application.DoEvents()
End While
End Sub
Private Sub fFileCompressionStarted(ByVal sender As Object, ByVal e As SevenZip.FileNameEventArgs)
Debug.Print(("Compressing " + e.FileName + e.PercentDone.ToString))
Label10.Text = e.FileName
MsVistaProgressBar1.Value = e.PercentDone
Application.DoEvents()
End Sub
Private Sub fCompressing(sender As Object, e As SevenZip.ProgressEventArgs)
MsVistaProgressBar1.Value = e.PercentDone
Application.DoEvents()
End Sub
Private Sub Compress_Finished(sender As Object, e As EventArgs)
MsVistaProgressBar1.Value = 0
Label10.Text = "Ready."
working = False
Application.DoEvents()
End Sub

Sorry to dig up this old question, but I was struggling with the same issue yesterday. I found that setting FastCompression to False will cause the events to fire properly.

Related

Loop ping and computer status by the network

I've got a very basic program which use the IP or Hostname of a computer on the network and ping it in order to know if the computer is online or offline by doing a scan every 10 sec and can be started and stopped by a button, and the loop is making the program freeze.
note: The program is still in development.
Public Class PingerFrm
Dim WorkBool As Boolean
Dim StateStr As String
Dim IPStr As String
Private Sub StartBtn_Click(sender As Object, e As EventArgs) Handles StartBtn.Click
WorkBool = True
IPStr = IPTxtBox.Text
Do While WorkBool = True
If My.Computer.Network.Ping(IPStr) Then
StateStr = ("Online")
Else
StateStr = ("Offline")
End If
StateLbl.Text = StateStr
Threading.Thread.Sleep(10000)
Loop
End Sub
Private Sub StopBtn_Click(sender As Object, e As EventArgs) Handles StopBtn.Click
WorkBool = False
End Sub
End Class
Does anyone see what I'm doing wrong or have any ideas ?
The problem is that you have the UI in a busy loop. Take a look at this
Private Async Sub StartBtn_Click(sender As Object, e As EventArgs) Handles StartBtn.Click
WorkBool = True
IPStr = IPTxtBox.Text
If Net.IPAddress.TryParse(IPStr, Nothing) Then
Dim t As Task
t = Task.Run(Sub()
Dim stateCHGD As Boolean = False
StateStr = ""
Do While WorkBool
If My.Computer.Network.Ping(IPStr) Then
If StateStr <> "Online" Then
stateCHGD = True
StateStr = "Online"
End If
Else
If StateStr <> "Offline" Then
stateCHGD = True
StateStr = "Offline"
End If
End If
If stateCHGD Then
stateCHGD = False
Me.BeginInvoke(Sub()
StateLbl.Text = StateStr
End Sub)
End If
Threading.Thread.Sleep(10000)
Loop
End Sub)
Await t
End If
End Sub

How to show MsgBox after finishing unzip process

I have this code:
Private Sub KickoffExtract()
actionStatus.Text = "Se instaleaza actualizarea.. va rugam asteptati."
lblProgress.Text = "Se extrage..."
Dim args(2) As String
args(0) = GetSettingItem("./updUrl.info", "UPDATE_FILENAME")
args(1) = extractPath
_backgroundWorker1 = New System.ComponentModel.BackgroundWorker()
_backgroundWorker1.WorkerSupportsCancellation = False
_backgroundWorker1.WorkerReportsProgress = False
AddHandler Me._backgroundWorker1.DoWork, New DoWorkEventHandler(AddressOf Me.UnzipFile)
_backgroundWorker1.RunWorkerAsync(args)
End Sub
Private Sub UnzipFile(ByVal sender As Object, ByVal e As DoWorkEventArgs)
Dim extractCancelled As Boolean = False
Dim args() As String = e.Argument
Dim zipToRead As String = args(0)
Dim extractDir As String = args(1)
Try
Using zip As ZipFile = ZipFile.Read(zipToRead)
totalEntriesToProcess = zip.Entries.Count
SetProgressBarMax(zip.Entries.Count)
AddHandler zip.ExtractProgress, New EventHandler(Of ExtractProgressEventArgs)(AddressOf Me.zip_ExtractProgress)
zip.ExtractAll(extractDir, Ionic.Zip.ExtractExistingFileAction.OverwriteSilently)
End Using
Catch ex1 As Exception
MessageBox.Show(String.Format("Actualizatorul a intampinat o problema in extragerea pachetului. {0}", ex1.Message), "Error Extracting", MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1)
End Try
End Sub
Private Sub SetProgressBarMax(ByVal n As Integer)
If ProgBar.InvokeRequired Then
ProgBar.Invoke(New Action(Of Integer)(AddressOf SetProgressBarMax), New Object() {n})
Else
ProgBar.Value = 0
ProgBar.Maximum = n
ProgBar.Step = 1
End If
End Sub
Private Sub zip_ExtractProgress(ByVal sender As Object, ByVal e As ExtractProgressEventArgs)
If _operationCanceled Then
e.Cancel = True
Return
End If
If (e.EventType = Ionic.Zip.ZipProgressEventType.Extracting_AfterExtractEntry) Then
StepEntryProgress(e)
ElseIf (e.EventType = ZipProgressEventType.Extracting_BeforeExtractAll) Then
End If
End Sub
Private Sub StepEntryProgress(ByVal e As ExtractProgressEventArgs)
If ProgBar.InvokeRequired Then
ProgBar.Invoke(New ZipProgress(AddressOf StepEntryProgress), New Object() {e})
Else
ProgBar.PerformStep()
System.Threading.Thread.Sleep(100)
nFilesCompleted = nFilesCompleted + 1
lblProgress.Text = String.Format("{0} din {1} fisiere...({2})", nFilesCompleted, totalEntriesToProcess, e.CurrentEntry.FileName)
Me.Update()
End If
End Sub
and this code on a button:
If Not File.Exists("./" + GetSettingItem("./updUrl.info", "UPDATE_FILENAME")) Then
MessageBox.Show("Actualizarea nu s-a descarcat corespunzator.", "Nu se poate extrage", MessageBoxButtons.OK)
End If
If Not String.IsNullOrEmpty("./" + GetSettingItem("./updUrl.info", "UPDATE_FILENAME")) And
Not String.IsNullOrEmpty(extractPath) Then
If Not Directory.Exists(extractPath) Then
Directory.CreateDirectory(extractPath)
End If
nFilesCompleted = 0
_operationCanceled = False
btnUnzip.Enabled = False
KickoffExtract()
End If
How can I show a message after completing the UnZip process? I tried
If ProgBar.Maximum Then
MsgBox("finish")
End If
but it doesn't work. I'm using dotnetzip 1.9, and the most of the code is from UnZip example.
If you check the documentation of BackgroundWorker you will notice that there are two events that can be linked to an event handler in your code.
One of them is the RunWorkerCompleted and in the MSDN page they say
Occurs when the background operation has completed, has been canceled,
or has raised an exception.
So, it is just a matter to write an event handler and bind the event.
AddHandler Me._backgroundWorker1.RunWorkerCompleted, New RunWorkerCompletedEventHandler(AddressOf Me.UnzipComplete)
and then
Private Sub UnzipComplete(ByVal sender As System.Object, _
ByVal e As RunWorkerCompletedEventArgs)
If e.Cancelled = True Then
MessageBox.Show("Canceled!")
ElseIf e.Error IsNot Nothing Then
MessageBox.Show("Error: " & e.Error.Message)
Else
MessageBox.Show("Unzip Completed!")
End If
End Sub

VB.NET: Code runs without error, but does not add item to listbox

I've got this embedded CMD on my form which I created using another person's code and everything works right. Inside one of the Private Subs (that seems to run every time a new line is written in the CMD output textbox), I've got a line which adds a item to a listbox (listboxs name is txtPlayerList) on another form labelled Status.
When this area of the code runs, it doesn't throw up any errors (and if I put a msgbox() on the same line, the msgbox() works). If I put the add to listbox line on form_load it works perfectly?
Here is my code, I've included everything from that form just in case (it is in the third sub from the top with the asterisks and comment "Get players and maybe other stuff as well"
Imports System.IO
Public Class Console
Public WithEvents MyProcess As Process
Private Delegate Sub AppendOutputTextDelegate(ByVal text As String)
Public LastLine As String
Public LastLineFormatted As String
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim LocalpathParent As String = Application.StartupPath() + "\MCserver"
'loads embed cmd
Me.AcceptButton = ExecuteButton
MyProcess = New Process
With MyProcess.StartInfo
.FileName = "CMD.EXE"
.UseShellExecute = False
.CreateNoWindow = True
.RedirectStandardInput = True
.RedirectStandardOutput = True
.RedirectStandardError = True
.WorkingDirectory = LocalpathParent
End With
MyProcess.Start()
MyProcess.BeginErrorReadLine()
MyProcess.BeginOutputReadLine()
AppendOutputText("Process Started at: " & MyProcess.StartTime.ToString)
'Resize with parent mdi container. Needs to be anchored & StartPosition = manual in properties
Me.WindowState = FormWindowState.Maximized
End Sub
Private Sub MyProcess_ErrorDataReceived(ByVal sender As Object, ByVal e As System.Diagnostics.DataReceivedEventArgs) Handles MyProcess.ErrorDataReceived
AppendOutputText(vbCrLf & "Error: " & e.Data)
End Sub
Private Sub MyProcess_OutputDataReceived(ByVal sender As Object, ByVal e As System.Diagnostics.DataReceivedEventArgs) Handles MyProcess.OutputDataReceived
AppendOutputText(vbCrLf & e.Data)
'*****************************************
'Get Players and maybe other stuff as well
'*****************************************
LastLine = Me.OutputTextBox.Lines.Last
If Status.ServerStarted = True Then
If Me.LastLine.Contains(" joined the game") Then
LastLineFormatted = Me.LastLine
LastLineFormatted = LastLineFormatted.Replace(" joined the game", "")
'***THIS LINE BELOW WORKS IN FORM LOAD, BUT NOT HERE FOR SOME REASON???***
Status.txtPlayersList.Items.Add(LastLineFormatted)
MsgBox("add lastlineformatted")
ElseIf Me.LastLine.Contains(" left the game") Then
LastLineFormatted = Me.LastLine
LastLineFormatted = LastLineFormatted.Replace(" left the game", "")
Status.txtPlayersList.Items.Remove(LastLineFormatted)
End If
End If
End Sub
Private Sub ExecuteButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExecuteButton.Click
MyProcess.StandardInput.WriteLine(InputTextBox.Text)
MyProcess.StandardInput.Flush()
InputTextBox.Text = ""
End Sub
Private Sub AppendOutputText(ByVal text As String)
If OutputTextBox.InvokeRequired Then
Dim myDelegate As New AppendOutputTextDelegate(AddressOf AppendOutputText)
Try
Me.Invoke(myDelegate, text)
Catch
End Try
Else
Try
OutputTextBox.AppendText(text)
Catch
End Try
End If
End Sub
End Class
EDIT: Below is the code I have for form1 per request
'code
Public Class Form1
Public Localpath As String
Public Downloadpath As String
Public LocalpathParent As String
'when this form is closing, send stop to console to make sure it has closed and saved
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Console.MyProcess.StandardInput.WriteLine("stop") 'send an EXIT command to the Command Prompt
Application.Exit()
End
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'load stuff in background n stuff
Me.Show()
Me.Focus()
Configure.Show()
Configure.Hide()
Status.Show()
Status.Hide()
Console.Show()
Console.Hide()
End Sub
'CONSOLE.form
Private Sub ConsoleToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles ConsoleToolStripMenuItem1.Click
'Hide all forms
Status.Hide()
Configure.Hide()
'Shown Form that you want to load
Console.Opacity = 100
Console.Show()
WindowState = FormWindowState.Normal
Console.MdiParent = Me
Console.OutputTextBox.SelectionStart = Console.OutputTextBox.Text.Length
Console.OutputTextBox.ScrollToCaret()
End Sub
'STATUS.form
Private Sub StatusToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles StatusToolStripMenuItem1.Click
'hide all forms
Console.Hide()
Configure.Hide()
'Show Form that you want to load
Status.Opacity = 100
Status.Show()
WindowState = FormWindowState.Maximized
Configure.Size = Me.Size
Status.MdiParent = Me
End Sub
'CONFIGURE.form
Private Sub ConfigurationToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles ConfigurationToolStripMenuItem1.Click
'hide all forms
Status.Hide()
Console.Hide()
'Show form that you want to load
Configure.Opacity = 100
Configure.Show()
WindowState = FormWindowState.Maximized
Configure.Size = Me.Size
Configure.MdiParent = Me
End Sub
End Class
'code
It seems that your original code to create an embeded CMD window was interfering with the code to update the listbox in another mdi child. After finding another way to embed a cmd console, and some fiddling around, It seems to be working Ok. I haven't been able to test pure server output yet though.
THere have been quite a few changes to the code that are too big to post here, but the Alternative embedded CMD is this.
Place this in general form declarations
'command prompt variables
Private strResults As String
Private intStop As Integer
Private swWriter As System.IO.StreamWriter
Friend thrdCMD As System.Threading.Thread
Private Delegate Sub cmdUpdate()
Private uFin As New cmdUpdate(AddressOf UpdateText)
Public WithEvents procCMDWin As New Process
This in your form_load Sub
thrdCMD = New System.Threading.Thread(AddressOf Prompt)
thrdCMD.IsBackground = True
thrdCMD.Start()
and these declarations within your form Class
Private Sub Prompt()
AddHandler procCMDWin.OutputDataReceived, AddressOf CMDOutput
AddHandler procCMDWin.ErrorDataReceived, AddressOf CMDOutput
procCMDWin.StartInfo.RedirectStandardOutput = True
procCMDWin.StartInfo.RedirectStandardInput = True
procCMDWin.StartInfo.CreateNoWindow = True
procCMDWin.StartInfo.UseShellExecute = False
procCMDWin.StartInfo.FileName = "cmd.exe"
procCMDWin.StartInfo.WorkingDirectory = LocalpathParent
procCMDWin.Start()
procCMDWin.BeginOutputReadLine()
swWriter = procCMDWin.StandardInput
Do Until (procCMDWin.HasExited)
Loop
procCMDWin.Dispose()
End Sub
Private Sub UpdateText()
OutputTextBox.Text += strResults
OutputTextBox.SelectionStart = OutputTextBox.TextLength - 1
InputTextBox.Focus()
intStop = OutputTextBox.SelectionStart
OutputTextBox.ScrollToCaret()
If OutputTextBox.Lines.Count > 2 Then
LastLine = OutputTextBox.Lines.ElementAt(OutputTextBox.Lines.Count - 2)
If Status.ServerStarted = True Then
'get element 1 of split
If LastLine.Contains(" joined the game") Then
LastLineFormatted = ExtractName(LastLine, " joined the game")
'If listlineformatted.contains(Players.allitems) then do
Status.txtPlayersList.Items.Add(LastLineFormatted)
Status.Show()
ElseIf Me.LastLine.Contains(" left the game") Then
LastLineFormatted = ExtractName(LastLine, " left the game")
'If listlineformatted.contains(Players.allitems) then do
Status.txtPlayersList.Items.Remove(LastLineFormatted)
MsgBox("remove lastlineformatted")
End If
End If
End If
End Sub
Private Function ExtractName(unformattedString As String, stringToRemove As String) As String
Dim temp As String = Split(unformattedString, "Server]")(1).ToString
ExtractName = temp.Replace(stringToRemove, "")
End Function
Private Sub CMDOutput(ByVal Sender As Object, ByVal OutputLine As DataReceivedEventArgs)
strResults = OutputLine.Data & Environment.NewLine
Invoke(uFin)
End Sub

BackgroundWorker's ProgressChanged not updating UI until end of work loop

I am coding a WPF application that will grab email's off of an IMAP account, and then export them into a user-selected folder.
I use a BackgroundWorker to download the emails. However, my UI isn't being updated until the loop is over.
Any tips would be appreciated.
Class MainWindow
Public MailRepo As MailRepository
Private bw_Connect As New BackgroundWorker
Private bw_Save As New BackgroundWorker
Public Sub New()
InitializeComponent()
bw_Connect.WorkerReportsProgress = True
bw_Connect.WorkerSupportsCancellation = True
AddHandler bw_Connect.DoWork, AddressOf bw_Connect_DoWork
bw_Save.WorkerReportsProgress = True
bw_Save.WorkerSupportsCancellation = True
AddHandler bw_Save.DoWork, AddressOf bw_Save_DoWork
AddHandler bw_Save.ProgressChanged, AddressOf bw_Save_ProgressChanged
End Sub
Private Sub bw_Save_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)
Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)
If bw_Connect.CancellationPending = True Then
e.Cancel = True
Else
SaveEmails()
End If
End Sub
Private Sub SaveEmails()
Dim allMails As IEnumerable(Of Message)
'Get All Emails in Mailbox
Try
Dim mailBox As String
Dispatcher.Invoke(DirectCast(Sub()
mailBox = comboBoxEmailFolders.SelectedValue
End Sub, Action))
allMails = MailRepo.GetAllMails(mailBox)
Catch i4e As Imap4Exception
MsgBox("Error: Folder not found" & vbCrLf & i4e.Message)
Return
End Try
Dim msg As Message
Dim msgInt As Integer = 1
'Save each message
For Each msg In allMails
bw_Save.ReportProgress(100 / allMails.Count * msgInt, Nothing)
SaveMessage(msg)
msgInt += 1
Next
End Sub
Private Sub bw_Save_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs)
Dim percentDone As String = e.ProgressPercentage.ToString() & "%"
updateStatus("Saving Emails " & percentDone & " done.")
progressBarStatus.Value = e.ProgressPercentage
End Sub

Timer will not start a second time

I've got a function:
Private Sub UpdateSch()
Threading.Thread.Sleep(50)
Dim i As Integer = 1
While i = 1
Try
If DataGridView1.Rows.Count > 1 Then
DataGridView1.Rows.Clear()
End If
Using stream As System.IO.FileStream = System.IO.File.OpenRead("Z:\\SchData.txt")
Using reader As New System.IO.StreamReader(stream)
Dim line As String = reader.ReadLine()
While (line IsNot Nothing)
Dim columns = line.Split(";")
line = reader.ReadLine()
Dim index = Me.DataGridView1.Rows.Add()
Me.DataGridView1.Rows(index).SetValues(columns)
End While
End Using
End Using
Button88.Enabled = True
DataGridView1.CurrentCell = DataGridView1.Rows(rowIndex).Cells(colIndex)
i = 0
Catch ex As Exception
Threading.Thread.Sleep(50)
End Try
End While
'Check for local updating
If updatingSch = False Then
DataGridView1.Enabled = False
LockWarning1.Visible = True
lockVar1 = 0
LockTimer1.Start()
Else
updatingSch = False
End If
End Sub
And then I've got a timer:
Private Sub LockTimer1_Tick(sender As Object, e As EventArgs) Handles LockTimer1.Tick
LockWarning1.Visible = False
DataGridView1.Enabled = True
LockTimer1.Stop()
End Sub
The function updateSch is called at form load and whenever the file is changed. It locks the DataGridView, starts the timer which runs for 10 sec, and then unlocks the Datagridview. This all works on load, but when it is called again it locks and never unlocks. The second time around the timer is never started. (I put a break point on the "LockTimer1.Start()" and it is executed the second time, but the LockTimer_Tick event doesn't fire after that)
I've found a soution to my problem. For the life of me I can't figure out why my previous code won't work. What I was able to get working was a Systems.Timers.Timer (instead of System.Windows.Forms.Timer). My code creating the timer looks like this:
Dim LockTimer1 As New System.Timers.Timer()
LockTimer1.Interval = 10000
LockTimer1.AutoReset = False 'Run timer only once
LockTimer1.Start()
AddHandler LockTimer1.Elapsed, AddressOf LockTimer1_Tick
And then the function LockTimer1_tick:
Private Sub LockTimer1_Tick(ByVal sender As Object, ByVal e As ElapsedEventArgs)
LockWarning1.Visible = False
DataGridView1.Enabled = True
Button88.Enabled = True
Button1.Enabled = True
End Sub