I have code that sends a ping to a batch of computers, and opens a VNC session to any that respond that they are online.
The pings are sent in a parallel.foreach loop, and an event is raised when a reply is receieved.
Despite putting a synclock block around the AddHost code, it is still being entered by multiple threads simultaneously.
I think it has something to do with the code being called by a raiseevent on another object.
This is the method that is handling the event
Private Sub AddHost(hostname As String)
' panesList is an list(of RemoteDesktop) prepopulated with 36 individual RemoteDesktop objects
Dim vnc As RemoteDesktop = panesList(Position)
vnc.GetPassword = New AuthenticateDelegate(Function() vncPassword)
SyncLock Semaphore
Try
If Position = 36 Then
Return
End If
vnc.Connect(hostname, 0, True, True)
Position += 1
Catch ex As Exception
End Try
End SyncLock
End Sub
Private Sub HandleConnect(hostFilter As String)
AddHandler OnlineFinder.LiveComputer, AddressOf AddHost
Dim bg As New Task(Sub() OnlineFinder.CheckFilteredASync(hostFilter))
bg.Start()
' AddHandler OnlineFinder.SearchComplete, AddressOf Finished
End Sub
From the object OnlineFinder.vb
Public Sub CheckFilteredASync(filterString As String)
Dim Ctable As DataTable = CTableAdapter.GetDataByPartName($"{filterString}%")
Dim clist As New List(Of String)
For Each drow As DataRow In Ctable.Rows
clist.Add(drow.Field(Of String)("Name"))
Next
Searching = True
Dim parallelLoopResult = Parallel.ForEach(clist, Sub(site) Ping(site))
RaiseEvent SearchComplete()
End Sub
Private Sub Ping(host As String)
If ValidPing(host) Then
RaiseEvent LiveComputer(host)
End If
End Sub
How should I be doing this so only one event is processed at a time (but it doesn't hang the UI)
Related
I have been creating a single instance application using a Mutex.
In the Sub Main code, the app checks to see if it is the first instance, if so it starts the form (called MainForm). The MainForm creates an asynchronous named pipe server to receive arguments passed from a new instance.
If the app is not the first instance, Sub Main creates a named pipe client, sends the command line arguments through to the first app, and proceeds to exit.
The application is tab-based, and each command line argument is a file path, which is used to create the tab. The argument is received (I can MsgBox() it), but when I try to pass it as an argument to the control I'm creating, nothing happen
Pipe classes:
Namespace Pipes
' Delegate for passing received message back to caller
Public Delegate Sub DelegateMessage(Reply As String)
Public Class PipeServer
Public Event PipeMessage As DelegateMessage
Private _pipeName As String
Public Sub Listen(PipeName As String)
Try
' Set to class level var so we can re-use in the async callback method
_pipeName = PipeName
' Create the new async pipe
Dim pipeServer As New NamedPipeServerStream(PipeName, PipeDirection.[In], 1, PipeTransmissionMode.[Byte], PipeOptions.Asynchronous)
' Wait for a connection
pipeServer.BeginWaitForConnection(New AsyncCallback(AddressOf WaitForConnectionCallBack), pipeServer)
Catch oEX As Exception
Debug.WriteLine(oEX.Message)
End Try
End Sub
Private Sub WaitForConnectionCallBack(iar As IAsyncResult)
Try
' Get the pipe
Dim pipeServer As NamedPipeServerStream = DirectCast(iar.AsyncState, NamedPipeServerStream)
' End waiting for the connection
pipeServer.EndWaitForConnection(iar)
Dim buffer As Byte() = New Byte(254) {}
' Read the incoming message
pipeServer.Read(buffer, 0, 255)
' Convert byte buffer to string
Dim stringData As String = Encoding.UTF8.GetString(buffer, 0, buffer.Length)
Debug.WriteLine(stringData + Environment.NewLine)
' Pass message back to calling form
RaiseEvent PipeMessage(stringData)
' Kill original sever and create new wait server
pipeServer.Close()
pipeServer = Nothing
pipeServer = New NamedPipeServerStream(_pipeName, PipeDirection.[In], 1, PipeTransmissionMode.[Byte], PipeOptions.Asynchronous)
' Recursively wait for the connection again and again....
pipeServer.BeginWaitForConnection(New AsyncCallback(AddressOf WaitForConnectionCallBack), pipeServer)
Catch
Return
End Try
End Sub
End Class
Class PipeClient
Public Sub Send(SendStr As String, PipeName As String, Optional TimeOut As Integer = 1000)
Try
Dim pipeStream As New NamedPipeClientStream(".", PipeName, PipeDirection.Out, PipeOptions.Asynchronous)
' The connect function will indefinitely wait for the pipe to become available
' If that is not acceptable specify a maximum waiting time (in ms)
pipeStream.Connect(TimeOut)
Debug.WriteLine("[Client] Pipe connection established")
Dim _buffer As Byte() = Encoding.UTF8.GetBytes(SendStr)
pipeStream.BeginWrite(_buffer, 0, _buffer.Length, AddressOf AsyncSend, pipeStream)
Catch oEX As TimeoutException
Debug.WriteLine(oEX.Message)
End Try
End Sub
Private Sub AsyncSend(iar As IAsyncResult)
Try
' Get the pipe
Dim pipeStream As NamedPipeClientStream = DirectCast(iar.AsyncState, NamedPipeClientStream)
' End the write
pipeStream.EndWrite(iar)
pipeStream.Flush()
pipeStream.Close()
pipeStream.Dispose()
Catch oEX As Exception
Debug.WriteLine(oEX.Message)
End Try
End Sub
End Class
End Namespace
MainForm logic:
#Region "Pipes"
Public ArgumentPipe As New Pipes.PipeServer
Public Sub RecievedMessage(reply As String)
GetMainformHook.Invoke(MySTDelegate, reply)
End Sub
Public Sub InitializeServer()
AddHandler ArgumentPipe.PipeMessage, AddressOf RecievedMessage
ArgumentPipe.Listen(_pipename)
End Sub
Public Delegate Sub RecievedMessageDel(txt As String)
Public MySTDelegate As RecievedMessageDel = AddressOf SetText
Public Sub SetText(txt)
MsgBox(txt)
TabStrip1.AddTab(txt.ToString) 'PROBLEM OCCURS HERE
End Sub
Public Shared Function GetMainformHook() As MainForm
Return Application.OpenForms("MainForm")
End Function
Public Shared Function GetTabControl() As TabStrip
Return CType(Application.OpenForms("MainForm"), MainForm).TabStrip1
End Function
Private Sub MainForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
InitializeServer()
End Sub
#End Region
In Sub Main when sending argument:
Dim _pipeClient = New Pipes.PipeClient()
If cmdArgs.Length > 0 Then
For i = 0 To cmdArgs.Length - 1
_pipeClient.Send(cmdArgs(i), _pipename, 1000)
Next
End If
_pipename is a global string like "myappv6"
Am I missing something?
I'm thinking this has something to do with cross threading, but can't pinpoint where to fix it.
Thanks
I am writing an application in VB.NET that allows users to schedule submissions (emails) to be sent at a later date. I use threads to wait until the time is right to send a particular submission, but for some reason I can't access one of the class objects from the listener threads (or something else is happening, that's what I'm trying to figure out). Here is the relevant code:
Public Class AppContext
Inherits ApplicationContext
Private submsnMngr As SubmissionManager
Public Sub New()
submsnMgr = New SubmissionManager()
menuAddEdit = New ToolStripMenuItem("Add/Edit Submissions")
...
End Sub
Private Sub menuAddEdit_Click(ByVal sender As Object, ByVal e As System.EventArgs)
Handles menuAddEdit.Click
' The user clicking this tray button is the ONLY way that the form can be shown
submsnMngr.ShowWelcome()
End Sub
...
End Class
Class SubmissionManager
Public currentSubmissions As SubmissionList
Public WelcomeForm As Welcome
Public Sub ShowWelcome()
If WelcomeForm Is Nothing Then
' Welcome is the form that needs to be refreshed down in the MailSender subroutine
WelcomeForm = New Welcome(Me)
End If
WelcomeForm.Show()
End Sub
Public Sub CheckDates()
For Each submsn In currentSubmissions.Submissions
SyncLock submsn
If Today.Date >= submsn.EffDate.AddDays(-90).Date And Not submsn.Sent90 And Not submsn.Denied90 And submsn.Thread Is Nothing Then
submsn.Send(1)
submsn.Sent90 = True
currentSubmissions.Save()
ElseIf Today.Date = submsn.EffDate.AddDays(-91).Date And submsn.Thread Is Nothing Then
Dim thd As New Thread(AddressOf MailSender)
thd.IsBackground = True
submsn.Thread = thd
Dim args As New ThreadArgs(submsn.Insured, 1)
thd.Start(args)
End If
If Today.Date >= submsn.EffDate.AddDays(-60).Date And submsn.Thread Is Nothing Then
submsn.Send(2)
currentSubmissions.RemoveSubmission(submsn)
If WelcomeForm IsNot Nothing Then
WelcomeForm.RefreshSubmissions()
End If
ElseIf Today.Date = submsn.EffDate.AddDays(-61).Date And submsn.Thread Is Nothing Then
Dim thd As New Thread(AddressOf MailSender)
thd.IsBackground = True
submsn.Thread = thd
Dim args As New ThreadArgs(submsn.Insured, 2)
thd.Start(args)
End If
End SyncLock
Next
End Sub
Private Sub DateListener()
Do
CheckDates()
Thread.Sleep(3600000)
Loop
End Sub
Private Sub MailSender(args As ThreadArgs)
Dim wait As New TimeSpan(14 - DateTime.Now.Hour, 23 - DateTime.Now.Minute, 0)
Thread.Sleep(wait.TotalMilliseconds)
Dim submsn As Submission = currentSubmissions.GetSubmission(args.insured)
SyncLock submsn
submsn.Send(args.mode)
If args.mode = 1 Then
submsn.Sent90 = True
submsn.Thread = Nothing
currentSubmissions.Save()
Else
currentSubmissions.RemoveSubmission(submsn)
End If
End SyncLock
If WelcomeForm IsNot Nothing Then
' Here is the issue, this code is not being run, even though WelcomeForm is set
' in New() above
WelcomeForm.RefreshSubmissions()
End If
End Sub
End Class
Paying special attention to the few comment lines in the code above, why is WelcomeForm Nothing when I clearly set it to reference the form created in the New() subroutine? I tried alternatively sending the reference to the MailSender thread as an argument, but the same thing happened. Note that I need the If statement there because the user may have closed the form before the thread gets to that point. But it is essential that RefreshSubmissions() be called on it if it is still open.
Sorry guys, realized my thread was being aborted elsewhere in my application's code. No problems with the actual code I posted above.
I have two related tables (tbVehicles and tbVehiclesDoc) I am running the below sql dependency but it is firring many time and my program freezes. please assist.
I want the program to update these tables when another user modifies them.
my Code:
Public Sub getdata()
Try
If tbdataset.Tables.Contains("tbVehicles") Then
If tbdataset.Tables("tbVehiclesDoc") IsNot Nothing Then
For f As Integer = tbdataset.Tables("tbVehiclesDoc").ChildRelations.Count - 1 To 0 Step -1
tbdataset.Tables("tbVehiclesDoc").ChildRelations(f).ChildTable.Constraints.Remove(tbdataset.Tables("tbVehiclesDoc").ChildRelations(f).RelationName)
tbdataset.Tables("tbVehiclesDoc").ChildRelations.RemoveAt(f)
Next
tbdataset.Tables("tbVehiclesDoc").ChildRelations.Clear()
tbdataset.Tables("tbVehiclesDoc").ParentRelations.Clear()
tbdataset.Tables("tbVehiclesDoc").Constraints.Clear()
tbdataset.Tables.Remove("tbVehiclesDoc")
End If
tbdataset.Tables.Remove("tbVehicles")
tbdataset.EnforceConstraints = True
End If
gridVehicles.DataSource = Nothing
Catch ex As Exception
MsgBox(ex.ToString)
' Exit Sub
End Try
command.Notification = Nothing
Dim dependency As New SqlDependency(command)
AddHandler dependency.OnChange, AddressOf dependency_OnChange
Dim adapter As New SqlDataAdapter(command)
adapter.Fill(tbdataset, "tbVehicles")
'----
End Sub
Private Sub toupdate()
If CanRequestNotifications() Then
If connection Is Nothing Then
connection = New SqlConnection(GetConnectionString())
connection.Open()
End If
If connection.State = ConnectionState.Closed Then
connection.Open()
End If
If command Is Nothing Then
command = New SqlCommand(GETSQL(), connection)
End If
End If
getdata()
End Sub
Private Function GETSQL() As String
Return "Select Rtrim(VehcID) as VehcID,RTrim(VehcModel), Rtrim(VehcRegNo) as VehcRegNo, Rtrim(VehcFourWheel), Rtrim(VehcCondition), Rtrim(VehcLastKM),Rtrim(VehcBranch), Rtrim(VehcDepartment), Rtrim(VehcDriver), Rtrim(VehcRemarks), VehcPic from dbo.tbVehicles"
End Function
Private Sub dependency_OnChange(ByVal sender As Object, ByVal e As SqlNotificationEventArgs)
' This event will occur on a thread pool thread.
' It is illegal to update the UI from a worker thread
' The following code checks to see if it is safe
' update the UI.
Dim i As ISynchronizeInvoke = CType(Me, ISynchronizeInvoke)
' If InvokeRequired returns True, the code
' is executing on a worker thread.
If i.InvokeRequired Then
' Create a delegate to perform the thread switch
Dim tempDelegate As New OnChangeEventHandler( _
AddressOf dependency_OnChange)
Dim args() As Object = {sender, e}
' Marshal the data from the worker thread
' to the UI thread.
i.BeginInvoke(tempDelegate, args)
Return
End If
' Remove the handler since it's only good
' for a single notification
Dim dependency As SqlDependency = _
CType(sender, SqlDependency)
RemoveHandler dependency.OnChange, _
AddressOf dependency_OnChange
' Reload the dataset that's bound to the grid.
getdata()
End Sub
I need to raise an event from a form on a new thread.
(I don't believe the reason for this is relevant, but just in case: I'll be raising events from code within a form's WndProc sub. If the code handling the event blocks with something on a form [such as a msgbox], then all sorts of trouble occurs with disconnected contexts and what not. I've confirmed that raising events on new threads fixing the problem.)
This is what I am currently doing:
Public Event MyEvent()
Public Sub RaiseMyEvent()
RaiseEvent MyEvent
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Dim t As New Threading.Thread(AddressOf RaiseMyEvent)
t.Start()
End Sub
Is there a better way?
It is my understanding that events in VB are actually made up of delegates in the background. Is there any way to raise events in new threads without creating subs for each? Or, is there a more appropriate method I should be using?
You can eliminate the RaiseMyEvent sub like this:
Public Class Class1
Public Event MyEvent()
Sub Demo()
Dim t As New Threading.Thread(Sub() RaiseEvent MyEvent())
t.Start()
End Sub
End Class
Don't know if this will help, but i'll always do threading and events like this:
Event MyEvent(ByVal Var1 As String, ByVal Var2 As String)
Private Delegate Sub del_MyEvent(ByVal Var1 As String, ByVal Var2 As String)
Private Sub StartNewThread()
'MAIN UI THREAD
Dim sVar1 As String = "Test"
Dim sVar2 As String = "Second Var"
Dim oThread As New Threading.Thread(New Threading.ParameterizedThreadStart(AddressOf StartNewThread_Threaded))
With oThread
.IsBackground = True
.Priority = Threading.ThreadPriority.BelowNormal
.Name = "StartNewThread_Threaded"
.Start(New Object() {sVar1, sVar2})
End With
End Sub
Private Sub StartNewThread_Threaded(ByVal o As Object)
'CHILD THREAD
Dim sVar1 As String = o(0)
Dim sVar2 As String = o(1)
'Do threaded operation
Threading.Thread.Sleep(1000)
'Raise event
RaiseEvent_MyEvent(sVar1, sVar2)
End Sub
Public Sub RaiseEvent_MyEvent(ByVal Var1 As String, ByVal Var2 As String)
If Me.InvokeRequired Then
'Makes the sub threadsafe (I.e. the event will only be raised in the UI Thread)
Dim oDel As New del_MyEvent(AddressOf RaiseEvent_MyEvent)
Me.Invoke(oDel, Var1, Var2)
Exit Sub
End If
'MAIN UI THREAD
RaiseEvent MyEvent(Var1, Var2)
End Sub
In my application, I have a MainWindow with a ToolStripProgressBar and a ToolStripStatusLabel.
This properties:
Property ProgressBarPercantage() As Integer Implements BCSXPSearchTool.Presenter.IMainView.ProgressPercentage
Get
Return Me._progressbarpercentage
End Get
Set(ByVal value As Integer)
Me._progressbarpercentage = value
Me.StatusStripCurrentProgressBar.Value = Me._progressbarpercentage
End Set
End Property
Private _progressbarpercentage As Integer = 0
Property ProgressStatusText() As String Implements BCSXPSearchTool.Presenter.IMainView.ProgressStatusText
Get
Return Me._progressstatustext
End Get
Set(ByVal value As String)
Me._progressstatustext = value
Me.StatusStripCurrentState.Text = Me._progressstatustext
End Set
End Property
Private _progressstatustext As String = "Ready"
In the MainWindowPresenter I start a new BackgroundWorker which should read from a database.
Public Sub Search()
Dim bw As New BackgroundWorker
bw.WorkerReportsProgress = True
bw.WorkerSupportsCancellation = True
AddHandler bw.DoWork, AddressOf runproc
If bw.IsBusy = False Then
bw.RunWorkerAsync()
End If
End Sub
Public Sub runproc()
Dim statusToSub As delegateStatusTo = AddressOf statusTo
Dim percToSub As delegatePercTo = AddressOf percTo
statusToSub.Invoke("Test")
'percToSub.Invoke(50)
End Sub
Public Sub percTo(ByVal value As Integer)
_view.ProgressPercentage = value
End Sub
Public Sub statusTo(ByVal value As String)
_view.ProgressStatusText = value
End Sub
Delegate Sub delegateStatusTo(ByVal value As String)
Delegate Sub delegatePercTo(ByVal value As Integer)
The code above is working. But if I change the sub runproc() to:
Public Sub runproc()
Dim statusToSub As delegateStatusTo = AddressOf statusTo
Dim percToSub As delegatePercTo = AddressOf percTo
' statusToSub.Invoke("Test")
percToSub.Invoke(50)
End Sub
It doesn't work. I get an exception:
InvalidOperationException
I got the text in english and can't translate it to english very well but I think something like:
The access to the control, created by another thread from another thread is not allowed.
I'm using Visual Studio 2008 Express + VB 2.0.
Thank you!
This is due to cross-thread UI access which is disallowed (but for every UI access, so your other code shouldn’t work either!). The easiest solution is to use BeginInvoke when required:
Public Sub statusTo(ByVal value As String)
If InvokeRequired Then
BeginInvoke(New Action(Of String)(AddressOf statusTo))
Return
End If
_view.ProgressStatusText = value
End Sub
Furthermore, #vulkanino’s comment is spot-on: your calls should be direct method calls, not delegate invocations.
Dim statusToSub As **new** delegateStatusTo(AddressOf WriteToDebug)
statusToSub.Invoke("Test")
Dim percToSub As **new** delegatePercTo (AddressOf percTo)
percToSub.Invoke(50)
It looks like you are attempting to access UI controls from the DoWork event handler. Remember, that event handler is running on a worker thread. You are not allowed to touch any UI control from a thread other than the one that created it. There is a ProgressChanged event that will be marshaled onto the UI thread automatically upon calling ReportProgress. You safely update the UI from this event.