First a little background information: The purpose of this application is to capture images and save them automatically to a network directory that will be either created or appended using the input of the text box. This code DOES work on my computer (windows 7 home 64 bit). I've created it using microsoft visual basic express 2010.
However..... when attempting to run the application on a windows 10 tablet, I get the follow errors:
On form load:
An error occurred while capturing the image. The video capture will now be terminated.
Object reference not set to an instance of an object.
On button2_Click Event:
Object reference not set to an instance of an object.
Below is the entirety of the code.
Form2.vb
Public Class Form2
Public scanIsSet As Boolean
Private webcam As WebCam
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
webcam = New WebCam()
webcam.InitializeWebCam(imgVideo)
webcam.Start()
scanIsSet = False
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim CFGfile As String
Dim SaveDir As String
Dim imgIndex As Integer
Dim existingImages() As String
SaveDir = "C:\somepath\"
'save image to directory with index number
Try
imgCapture.Image.Save(SaveDir & OrderNumber.Text & "\" & CStr(imgIndex) & ".jpg")
Catch ex As Exception
MsgBox("error while accessing object imgCapture" & ex.Message)
End Try
imgIndex = imgIndex + 1
Else
Beep()
MsgBox("Please scan or type in order number first")
End If
End Sub
End Class
WebCam.vb
Imports System
Imports System.IO
Imports System.Linq
Imports System.Text
Imports WebCam_Capture
Imports System.Collections.Generic
Imports ZXing
Imports ZXing.OneD
'Design by Pongsakorn Poosankam
Class WebCam
Public scanz As Boolean
Public Sub setScan(ByVal x As Boolean)
scanz = x
End Sub
Private webcam As WebCamCapture
Private _FrameImage As System.Windows.Forms.PictureBox
Private FrameNumber As Integer = 30
Public Sub InitializeWebCam(ByRef ImageControl As System.Windows.Forms.PictureBox)
webcam = New WebCamCapture()
webcam.FrameNumber = CULng((0))
webcam.TimeToCapture_milliseconds = FrameNumber
AddHandler webcam.ImageCaptured, AddressOf webcam_ImageCaptured
_FrameImage = ImageControl
End Sub
Private Sub webcam_ImageCaptured(ByVal source As Object, ByVal e As WebcamEventArgs)
_FrameImage.Image = e.WebCamImage
If scanz = True Then
Dim BCreader As New ZXing.BarcodeReader
'BCreader.Options.TryHarder = True
Try
Dim resu As Result = BCreader.Decode(e.WebCamImage)
Form2.OrderNumber.Text = resu.Text
setScan(False)
Form2.Label2.Text = ""
Beep()
Catch ex As Exception
'do nothing
End Try
End If
End Sub
Public Sub Start()
webcam.TimeToCapture_milliseconds = FrameNumber
webcam.Start(0)
End Sub
Public Sub [Stop]()
webcam.[Stop]()
End Sub
Public Sub [Continue]()
' change the capture time frame
webcam.TimeToCapture_milliseconds = FrameNumber
' resume the video capture from the stop
webcam.Start(Me.webcam.FrameNumber)
End Sub
Public Sub ResolutionSetting()
webcam.Config()
End Sub
Public Sub AdvanceSetting()
webcam.Config2()
End Sub
End Class
As you can see toward the end of Form2.vb, I've wrapped imgCapture.Image.Save(SaveDir & OrderNumber.Text & "\" & CStr(imgIndex) & ".jpg") in a Try-Catch block because I suspect it's some sort of problems with the pictureBox objects. The try catch block does indeed catch the exception, but I still have no idea what the problem is, why it happens on the tablet and not the PC, or how to fix it.
I've found similar questions, but none with a solution I can make use of.
Since you are using a library, EasyWebCam, that is outdated and not compatible with Win10, I would suggest switching libraries. Other options out there:
DirectX.Capture
Windows.Media.Capture
I FOUND THE SOLUTION BUT I DON'T KNOW IF YOU NEED IT NOW ANYWAY THE PROBLEM IS IF YOU HAVE CHANGED THE PICTUREBOX NAME THEN IN REFENCES USE THE EXACT NAME YOU HAVE CHANGED TO. EXAMPLE IF I CHANGE ALL MY PICTUREBOX NAMES AS -
PictureBox_A1 , PictureBox_A2 ,... and so on then my refence should be as -
Dim r As DataRow
For Each r In t1.Rows
CType(Controls("PictureBox_" & r(2)), PictureBox).Image = bookedicon
Next
MY REFERENCE IS - "PictureBox_"
Related
Using the code below I can create a box with a combo box that shows the current com ports
What I need to do is show what is attached to the com Port, for example I want it to list
COM PORT1 FTDI USB serial adapter, the reason is to let you the user know which port to enter in a batch file that runs when another button is clicked ( i have removed that part of the code as its not important)
I have done some google work and found this link http://social.msdn.microsoft.com/Forums/en-US/vbgeneral/thread/331a26c1-0f42-4cf1-8adb-32fb09a18953/ But that just errors out
Imports System
Imports System.Threading
Imports System.IO.Ports
Imports System.ComponentModel
Public Class Form1
'------------------------------------------------
Dim myPort As Array
Delegate Sub SetTextCallback(ByVal [text] As String) 'Added to prevent threading
errors during receiveing of data
'------------------------------------------------
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
myPort = IO.Ports.SerialPort.GetPortNames()
ComboBox1.Items.AddRange(myPort)
End Sub
End Class
The following shows how to get a list of COM devices in VB.NET for both .NET 6 and .NET Framework 4.8 in VS 2022. If a USB COM (serial port) device is added/removed, the ComboBox will be updated.
Option 1 - Windows Forms App: (.NET 6)
Create a new project: Windows Forms App (name: SerialPortGetComDevices)
Download/install the following NuGet packages:
System.IO.Ports
System.Management
Option 2 - Windows Forms App (.NET Framework) - v4.8:
Create a new project: Windows Forms App (.NET Framework) (name: SerialPortGetComDevices)
Add Reference:
In VS menu, click Project
Select Add Reference...
Select Assemblies
Check System.Management
Click OK
The instructions below are the same for both Windows Forms App and Windows Forms App (.NET Framework) (ie: the instructions below are the same regardless of which option you've chosen above).
Create a class (name: ComPortInfo.vb)
In VS menu, select Project
Select Add Class... (name: ComPortInfo.vb)
Click Add
ComPortInfo.vb:
Public Class ComPortInfo
Public Property Caption As String
Public Property PortName As String
End Class
Open Solution Explorer:
In VS menu, click View
Select Solution Explorer
Open Properties Window:
In VS menu, click View
Select Properties Window
Add Load Event Handler
In Solution Explorer, right-click Form1.vb and select View Designer.
In Properties Window, click
Double-click Load
Add FormClosing Event Handler
In Solution Explorer, right-click Form1.vb and select View Designer.
In Properties Window, click
Double-click FormClosing
Add a ComboBox to the Form (name: ComboBoxComPorts)
In VS menu, click View
Select Toolbox
In Toolbox, select ComboBox, and drag it to the Form.
In the Properties Window, change (Name) to ComboBoxComPorts
In the Properties Window, change DropDownStyle to DropDownList
Select one of the options below. The 1st option uses ManagementEventWatcher to detect USB device insertion and removal. The 2nd option overrides WndProc.
Note: The WndProc version (Option 2) seems to have slightly better performance.
Option 1 (ManagementEventWatcher)
Note: The code for detecting the insertion and removal of a USB device, is adapted from here.
Add the code below in your Form (ex: Form1.vb)
Form1.vb
Imports System.ComponentModel
Imports System.Management
Imports System.IO.Ports
Public Class Form1
'create new instance
Private _comPorts As BindingList(Of ComPortInfo) = New BindingList(Of ComPortInfo)
Private _managementEventWatcher1 As ManagementEventWatcher = New ManagementEventWatcher()
Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
InitializeManagementEventWatcher()
UpdateCOM()
'set properties
ComboBoxComPorts.DataSource = _comPorts
ComboBoxComPorts.DisplayMember = "Caption"
ComboBoxComPorts.ValueMember = "PortName"
End Sub
Private Sub GetComPorts()
'this method Is only called from 'UpdateCOM'
'_comPorts' is only modified in this method
Dim portDict As Dictionary(Of String, String) = New Dictionary(Of String, String)
'clear existing data
_comPorts.Clear()
'get port names
For Each pName As String In SerialPort.GetPortNames()
If Not portDict.ContainsKey(pName) Then
portDict.Add(pName, pName) 'add to Dictionary
End If
Next
'get USB COM ports - this may result in a more descriptive name than 'COM1'
Using searcherPnPEntity As ManagementObjectSearcher = New ManagementObjectSearcher("SELECT Name FROM Win32_PnPEntity WHERE PNPClass = 'Ports'")
For Each objPnPEntity As ManagementObject In searcherPnPEntity.Get()
If objPnPEntity Is Nothing Then
Continue For
End If
'get name
Dim name As String = objPnPEntity("Name")?.ToString()
If Not String.IsNullOrEmpty(name) AndAlso name.ToUpper().Contains("COM") Then
Dim portName As String = name.Substring(name.IndexOf("(") + 1, name.IndexOf(")") - name.IndexOf("(") - 1)
If Not portDict.ContainsKey(portName) Then
portDict.Add(portName, name) 'add to Dictionary
Else
portDict(portName) = name 'update value
End If
End If
Next
End Using
'add items from Dictionary to BindingList
For Each kvp As KeyValuePair(Of String, String) In portDict
_comPorts.Add(New ComPortInfo() With {.Caption = kvp.Value, .PortName = kvp.Key}) 'add
Next
End Sub
Private Sub InitializeManagementEventWatcher()
'see https:'learn.microsoft.com/en-us/windows/win32/wmisdk/within-clause
'WITHIN sets the polling interval in seconds
'polling too frequently may reduce performance
Dim query As WqlEventQuery = New WqlEventQuery("SELECT * FROM __InstanceOperationEvent WITHIN 2 WHERE TargetInstance ISA 'Win32_PnPEntity'")
'Dim query As WqlEventQuery = New WqlEventQuery("SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_PnPEntity'")
'set property
_managementEventWatcher1.Query = query
'subscribe to event
AddHandler _managementEventWatcher1.EventArrived, AddressOf ManagementEventWatcher_EventArrived
'start
_managementEventWatcher1.Start()
End Sub
Private Sub LogMsg(msg As String, Optional includeTimestamp As Boolean = True)
If includeTimestamp Then
msg = $"{DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff")} - {msg}"
End If
Debug.WriteLine(msg)
End Sub
Public Sub UpdateCOM()
If ComboBoxComPorts.InvokeRequired Then
'LogMsg("ComboBoxComPorts.InvokeRequired")
ComboBoxComPorts.Invoke(New MethodInvoker(Sub()
GetComPorts()
End Sub))
Else
GetComPorts()
End If
End Sub
Public Sub ManagementEventWatcher_EventArrived(sender As Object, e As EventArrivedEventArgs)
Dim obj As ManagementBaseObject = DirectCast(e.NewEvent, ManagementBaseObject)
Dim target As ManagementBaseObject = If(obj("TargetInstance") IsNot Nothing, DirectCast(obj("TargetInstance"), ManagementBaseObject), Nothing)
Dim usbEventType As String = String.Empty
Select Case target.ClassPath.ClassName
Case "__InstanceCreationEvent"
usbEventType = "added"
Case "__InstanceDeletionEvent"
usbEventType = "removed"
Case Else
usbEventType = target.ClassPath.ClassName
End Select
If target("PNPClass") IsNot Nothing AndAlso target("PNPClass").ToString() = "Ports" Then
'update COM ports
UpdateCOM()
End If
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
'stop
_managementEventWatcher1.Stop()
'unsubscribe from event
RemoveHandler _managementEventWatcher1.EventArrived, AddressOf ManagementEventWatcher_EventArrived
End Sub
End Class
Option 2 (override WndProc)
Note: The code for detecting the insertion and removal of a USB device, is adapted from here.
Add a Module (name: UsbDeviceNotification.vb)
In VS menu, select Project
Select Add Module... (name: UsbDeviceNotification.vb)
Click Add
UsbDeviceNotification.vb
Imports System.Runtime.InteropServices
Module UsbDeviceNotification
Public Const DbtDeviceArrival As Integer = &H8000 'device added
Public Const DbtDeviceRemoveComplete As Integer = &H8004 'device removed
Public Const WM_DEVICECHANGE As Integer = &H219 'device change event
Public Const DBT_DEVTYP_DEVICEINTERFACE As Integer = 5
Private ReadOnly _guidDevInterfaceUSBDevice As Guid = New Guid("A5DCBF10-6530-11D2-901F-00C04FB951ED") 'USB devices
Private _notificationHandle As IntPtr
Declare Auto Function RegisterDeviceNotification Lib "user32" (recipient As IntPtr, notificationFilter As IntPtr, flags As Integer) As IntPtr
Declare Auto Function UnregisterDeviceNotification Lib "user32" (hwnd As IntPtr) As Boolean
<StructLayout(LayoutKind.Sequential)>
Private Structure DEV_BROADCAST_DEVICEINTERFACE
Dim Size As Integer
Dim DeviceType As Integer
Dim Reserved As Integer
Dim ClassGuid As Guid
Dim Name As Short
End Structure
Public Sub RegisterUsbDeviceNotification(hwnd As IntPtr)
'Registers a window to receive notifications when USB devices are plugged or unplugged.
Dim dbi As DEV_BROADCAST_DEVICEINTERFACE = New DEV_BROADCAST_DEVICEINTERFACE() With
{
.DeviceType = DBT_DEVTYP_DEVICEINTERFACE,
.ClassGuid = _guidDevInterfaceUSBDevice
}
dbi.Size = Marshal.SizeOf(dbi)
Dim buffer As IntPtr = Marshal.AllocHGlobal(dbi.Size)
Marshal.StructureToPtr(dbi, buffer, True)
_notificationHandle = RegisterDeviceNotification(hwnd, buffer, 0)
End Sub
Public Sub UnregisterUsbDeviceNotification()
UnregisterDeviceNotification(_notificationHandle)
End Sub
End Module
Add the code below in your Form (ex: Form1.vb)
Form1.vb
Imports System.ComponentModel
Imports System.Management
Imports System.IO.Ports
Imports System.Threading
Public Class Form1
'create new instance
Private _comPorts As BindingList(Of ComPortInfo) = New BindingList(Of ComPortInfo)
Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
UpdateCOM()
'set properties
ComboBoxComPorts.DataSource = _comPorts
ComboBoxComPorts.DisplayMember = "Caption"
ComboBoxComPorts.ValueMember = "PortName"
End Sub
Private Sub GetComPorts()
'this method Is only called from 'UpdateCOM'
'_comPorts' is only modified in this method
Dim portDict As Dictionary(Of String, String) = New Dictionary(Of String, String)
'clear existing data
_comPorts.Clear()
'get port names
For Each pName As String In SerialPort.GetPortNames()
If Not portDict.ContainsKey(pName) Then
portDict.Add(pName, pName) 'add to Dictionary
End If
Next
'get USB COM ports - this may result in a more descriptive name than 'COM1'
Using searcherPnPEntity As ManagementObjectSearcher = New ManagementObjectSearcher("SELECT Name FROM Win32_PnPEntity WHERE PNPClass = 'Ports'")
If searcherPnPEntity IsNot Nothing Then
For Each objPnPEntity As ManagementBaseObject In searcherPnPEntity.Get()
If objPnPEntity Is Nothing Then
Continue For
End If
'get name
Dim name As String = objPnPEntity("Name")?.ToString()
If Not String.IsNullOrEmpty(name) AndAlso name.ToUpper().Contains("COM") Then
Dim portName As String = name.Substring(name.IndexOf("(") + 1, name.IndexOf(")") - name.IndexOf("(") - 1)
If Not portDict.ContainsKey(portName) Then
portDict.Add(portName, name) 'add to Dictionary
Else
portDict(portName) = name 'update value
End If
End If
Next
End If
End Using
'add items from Dictionary to BindingList
For Each kvp As KeyValuePair(Of String, String) In portDict
_comPorts.Add(New ComPortInfo() With {.Caption = kvp.Value, .PortName = kvp.Key}) 'add
Next
End Sub
Private Sub LogMsg(msg As String, Optional includeTimestamp As Boolean = True)
If includeTimestamp Then
msg = $"{DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff")} - {msg}"
End If
Debug.WriteLine(msg)
End Sub
Public Sub UpdateCOM()
'since this method/Sub is called from WndProc,
'it needs to run on a new thread
Dim threadProc As System.Threading.Thread = New System.Threading.Thread(Sub()
If ComboBoxComPorts.InvokeRequired Then
'LogMsg("ComboBoxComPorts.InvokeRequired")
ComboBoxComPorts.Invoke(New MethodInvoker(Sub()
GetComPorts()
End Sub))
Else
GetComPorts()
End If
End Sub)
threadProc.SetApartmentState(System.Threading.ApartmentState.STA)
threadProc.Start()
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = UsbDeviceNotification.WM_DEVICECHANGE Then
Select Case CInt(m.WParam)
Case UsbDeviceNotification.DbtDeviceRemoveComplete
UpdateCOM()
Case UsbDeviceNotification.DbtDeviceArrival
UpdateCOM()
End Select
End If
MyBase.WndProc(m)
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
End Sub
End Class
The following PowerShell commands may also provide useful information.
PowerShell:
Get-CimInstance -Namespace Root\Cimv2 -Query "Select * From Win32_SerialPort Where Name like '%COM%'"
Get-CimInstance -Namespace Root\Cimv2 -Query "Select * From Win32_SerialPortConfiguration"
Get-CimInstance -Namespace Root\Cimv2 -Query "Select * From Win32_PnPEntity where PnPClass = 'Ports' and Name like '%COM%'"
mode
Resources:
System.IO.Ports Namespace
SerialPort Class
BindingList Class
ManagementEventWatcher Class
WITHIN Clause
Detecting USB drive insertion and removal using windows service and c#
Check for device change (add/remove) events
ComboBox Class
Dictionary<TKey,TValue> Class
ManagementObjectSearcher Class
ManagementObject Class
Win32_PnPEntity class
For...Next Statement (Visual Basic)
If Operator (Visual Basic)
This message is displayed when running my windows service.
The [service name] service on local computer started and then stopped.
Some Services stop automatically if they are not in use by another services or programs.
I am not sure what is causing this error. Below is the code for my service. My code uses another class called MagentoSalesOrder. I ran this code as a console application first and it worked just fine. I believe this what is causing the error. When I comment out the lines that use that class my service runs fine for printing test to a file.
Imports MyFirstService.MagentoSalesOrder
Public Class MyFirstService
Dim WithEvents timer1 As New System.Timers.Timer
Protected Overrides Sub OnStart(ByVal args() As String)
timer1.Interval = 10000
timer1.Start()
WriteLog(Me.ServiceName & " has started ...")
End Sub
Protected Overrides Sub OnStop()
WriteLog(Me.ServiceName & " has stopped ...")
End Sub
Private Sub timer1_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles timer1.Elapsed
WriteLog(Me.ServiceName & " is running ...")
End Sub
Private Sub WriteLog(ByVal strMessage As String)
Dim strPath As String, file As System.IO.StreamWriter
Dim test As New MagentoSalesOrder()
strPath = AppDomain.CurrentDomain.BaseDirectory & "\MyService.log"
file = New System.IO.StreamWriter(strPath, True)
Dim arr = test.BuildPreOrder()
If (arr.Length > 0) Then
For Each element As Long In arr
file.WriteLine("PreOrder created: " + element)
Next
Else
file.WriteLine("No orders to process")
End If
'file.WriteLine("Test")
file.Close()
End Sub
End Class
So I found out my error was coming from the file.writeline in my foreach loop.
Changing element to element.toString in my writefile fixed my service.
The problem came from trying to concatenate a Long to a String.
Changing element to element.toString in my writefile fixed my service.
I apologize in advance if my question is too long-winded. I looked at the question “How to update data in GUI with messages that are being received by a thread of another class?” and it is very close to what I am trying to do but the answer was not detailed enough to be helpful.
I have converted a VB6 app to VB.NET (VS2013). The main function of the app is to send queries to a Linux server and display the results on the calling form. Since the WinSock control no longer exists, I’ve created a class to handle the functions associated with the TcpClient class. I can successfully connect to the server and send and receive data.
The problem is that I have multiple forms that use this class to send query messages to the server. The server responds with data to be displayed on the calling form. When I try to update a control on a form, I get the error "Cross-thread operation not valid: Control x accessed from a thread other than the thread it was created on." I know I’m supposed to use Control.InvokeRequired along with Control.Invoke in order to update controls on the Main/UI thread, but I can’t find a good, complete example in VB. Also, I have over 50 forms with a variety of controls on each form, I really don’t want to write a delegate handler for each control. I should also mention that the concept of threads and delegates is very new to me. I have been reading everything I can find on this subject for the past week or two, but I’m still stuck!
Is there some way to just switch back to the Main Thread? If not, is there a way I can use Control.Invoke just once to cover a multitude of controls?
I tried starting a thread just after connecting before I start sending and receiving data, but netStream.BeginRead starts its own thread once the callback function fires. I also tried using Read instead of BeginRead. It did not work well if there was a large amount of data in the response, BeginRead handled things better. I feel like Dorothy stuck in Oz, I just want to get home to the main thread!
Thanks in advance for any help you can provide.
Option Explicit On
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Friend Class ATISTcpClient
Public Event Receive(ByVal data As String)
Private Shared WithEvents oRlogin As TcpClient
Private netStream As NetworkStream
Private BUFFER_SIZE As Integer = 8192
Private DataBuffer(BUFFER_SIZE) As Byte
Public Sub Connect()
Try
oRlogin = New Net.Sockets.TcpClient
Dim localIP As IPAddress = IPAddress.Parse(myIPAddress)
Dim localPrt As Int16 = myLocalPort
Dim ipLocalEndPoint As New IPEndPoint(localIP, localPrt)
oRlogin = New TcpClient(ipLocalEndPoint)
oRlogin.NoDelay = True
oRlogin.Connect(RemoteHost, RemotePort)
Catch e As ArgumentNullException
Debug.Print("ArgumentNullException: {0}", e)
Catch e As Net.Sockets.SocketException
Debug.Print("SocketException: {0}", e)
End Try
If oRlogin.Connected() Then
netStream = oRlogin.GetStream
If netStream.CanRead Then
netStream.BeginRead(DataBuffer, 0, BUFFER_SIZE, _
AddressOf DataArrival, DataBuffer)
End If
Send(vbNullChar)
Send(User & vbNullChar)
Send(User & vbNullChar)
Send(Term & vbNullChar)
End If
End Sub
Public Sub Send(newData As String)
On Error GoTo send_err
If netStream.CanWrite Then
Dim sendBytes As [Byte]() = Encoding.UTF8.GetBytes(newData)
netStream.Write(sendBytes, 0, sendBytes.Length)
End If
Exit Sub
send_err:
Debug.Print("Error in Send: " & Err.Number & " " & Err.Description)
End Sub
Private Sub DataArrival(ByVal dr As IAsyncResult)
'This is where it switches to a WorkerThread. It never switches back!
On Error GoTo dataArrival_err
Dim myReadBuffer(BUFFER_SIZE) As Byte
Dim myData As String = ""
Dim numberOfBytesRead As Integer = 0
numberOfBytesRead = netStream.EndRead(dr)
myReadBuffer = DataBuffer
myData = myData & Encoding.ASCII.GetString(myReadBuffer, 0, numberOfBytesRead)
Do While netStream.DataAvailable
numberOfBytesRead = netStream.Read(myReadBuffer, 0, myReadBuffer.Length)
myData = myData & Encoding.ASCII.GetString(myReadBuffer, 0, numberOfBytesRead)
Loop
'Send data back to calling form
RaiseEvent Receive(myData)
'Start reading again in case we don‘t have the entire response yet
If netStream.CanRead Then
netStream.BeginRead(DataBuffer, 0,BUFFER_SIZE,AddressOf DataArrival,DataBuffer)
End If
Exit Sub
dataArrival_err:
Debug.Print("Error in DataArrival: " & err.Number & err.Description)
End Sub
Instead of using delegates one could use anonymous methods.
Singleline:
uicontrol.Window.Invoke(Sub() ...)
Multiline:
uicontrol.Window.Invoke(
Sub()
...
End Sub
)
If you don't want to pass an UI control every time you need to invoke, create a custom application startup object.
Friend NotInheritable Class Program
Private Sub New()
End Sub
Public Shared ReadOnly Property Window() As Form
Get
Return Program.m_window
End Get
End Property
<STAThread()> _
Friend Shared Sub Main()
Application.EnableVisualStyles()
Application.SetCompatibleTextRenderingDefault(False)
Dim window As New Form1()
Program.m_window = window
Application.Run(window)
End Sub
Private Shared m_window As Form
End Class
Now, you'll always have access to the main form of the UI thread.
Friend Class Test
Public Event Message(text As String)
Public Sub Run()
Program.Window.Invoke(Sub() RaiseEvent Message("Hello!"))
End Sub
End Class
In the following sample code, notice that the Asynchronous - Unsafe run will throw a Cross-thread exception.
Imports System.Threading
Imports System.Threading.Tasks
Public Class Form1
Public Sub New()
Me.InitializeComponent()
Me.cbOptions = New ComboBox() With {.TabIndex = 0, .Dock = DockStyle.Top, .DropDownStyle = ComboBoxStyle.DropDownList} : Me.cbOptions.Items.AddRange({"Asynchronous", "Synchronous"}) : Me.cbOptions.SelectedItem = "Asynchronous"
Me.btnRunSafe = New Button() With {.TabIndex = 1, .Dock = DockStyle.Top, .Text = "Run safe!", .Height = 30}
Me.btnRunUnsafe = New Button() With {.TabIndex = 2, .Dock = DockStyle.Top, .Text = "Run unsafe!", .Height = 30}
Me.tbOutput = New RichTextBox() With {.TabIndex = 3, .Dock = DockStyle.Fill}
Me.Controls.AddRange({Me.tbOutput, Me.btnRunUnsafe, Me.btnRunSafe, Me.cbOptions})
Me.testInstance = New Test()
End Sub
Private Sub _ButtonRunSafeClicked(s As Object, e As EventArgs) Handles btnRunSafe.Click
Dim mode As String = CStr(Me.cbOptions.SelectedItem)
If (mode = "Synchronous") Then
Me.testInstance.RunSafe(mode)
Else 'If (mode = "Asynchronous") Then
Task.Factory.StartNew(Sub() Me.testInstance.RunSafe(mode))
End If
End Sub
Private Sub _ButtonRunUnsafeClicked(s As Object, e As EventArgs) Handles btnRunUnsafe.Click
Dim mode As String = CStr(Me.cbOptions.SelectedItem)
If (mode = "Synchronous") Then
Me.testInstance.RunUnsafe(mode)
Else 'If (mode = "Asynchronous") Then
Task.Factory.StartNew(Sub() Me.testInstance.RunUnsafe(mode))
End If
End Sub
Private Sub TestMessageReceived(text As String) Handles testInstance.Message
Me.tbOutput.Text = (text & Environment.NewLine & Me.tbOutput.Text)
End Sub
Private WithEvents btnRunSafe As Button
Private WithEvents btnRunUnsafe As Button
Private WithEvents tbOutput As RichTextBox
Private WithEvents cbOptions As ComboBox
Private WithEvents testInstance As Test
Friend Class Test
Public Event Message(text As String)
Public Sub RunSafe(mode As String)
'Do some work:
Thread.Sleep(2000)
'Notify any listeners:
Program.Window.Invoke(Sub() RaiseEvent Message(String.Format("Safe ({0}) # {1}", mode, Date.Now)))
End Sub
Public Sub RunUnsafe(mode As String)
'Do some work:
Thread.Sleep(2000)
'Notify any listeners:
RaiseEvent Message(String.Format("Unsafe ({0}) # {1}", mode, Date.Now))
End Sub
End Class
End Class
Thank you to those who took the time to make suggestions. I found a solution. Though it may not be the preferred solution, it works beautifully. I simply added MSWINSCK.OCX to my toolbar, and use it as a COM/ActiveX component. The AxMSWinsockLib.AxWinsock control includes a DataArrival event, and it stays in the Main thread when the data arrives.
The most interesting thing is, if you right click on AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent and choose Go To Definition, the object browser shows the functions and delegate subs to handle the asynchronous read and the necessary delegates to handle BeginInvoke, EndInvoke, etc. It appears MicroSoft has already done the hard stuff that I did not have the time or experience to figure out on my own!
I'm attempting to make a multi-threaded download manager that has a limit of 4 concurrent downloads. In my research, I came across the following: C# Downloader: should I use Threads, BackgroundWorker or ThreadPool?
[edit] updated code:
Imports System.Net
Imports System.Collections.Concurrent
Imports System.ComponentModel
Imports System.Threading
Public Class Form1
Const MaxClients As Integer = 4
' create a queue that allows the max items
Dim ClientQueue As New BlockingCollection(Of WebClient)(MaxClients)
' queue of urls to be downloaded (unbounded)
Dim UrlQueue As New Queue(Of String)()
Dim downloadThread As Thread
'Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' create four WebClient instances and put them into the queue
For i As Integer = 0 To MaxClients - 1
Dim cli = New WebClient()
AddHandler cli.DownloadFileCompleted, AddressOf DownloadFileCompleted
AddHandler cli.DownloadProgressChanged, AddressOf DownloadProgressChanged
ClientQueue.Add(cli)
Next
' Fill the UrlQueue here
UrlQueue.Enqueue("http://www.gnu.org/licenses/gpl-1.0.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/gpl-2.0.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/gpl-3.0.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/lgpl-2.1.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/lgpl-3.0.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/fdl-1.1.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/fdl-1.2.txt")
UrlQueue.Enqueue("http://www.gnu.org/licenses/fdl-1.3.txt")
downloadThread = New Thread(AddressOf downloadQueue)
downloadThread.IsBackground = True
downloadThread.Start()
End Sub
Private Sub downloadQueue()
' Now go until the UrlQueue is empty
While UrlQueue.Count > 0
Dim cli As WebClient = ClientQueue.Take() ' blocks if there is no client available
Dim url As String = UrlQueue.Dequeue()
Dim fname As String = CreateOutputFilename(url)
cli.DownloadFileAsync(New Uri(url), fname, New DownloadArgs(url, fname, cli))
AppendText(url & " started" & vbCrLf)
End While
End Sub
Private Sub DownloadProgressChanged(sender As Object, e As DownloadProgressChangedEventArgs)
Dim args As DownloadArgs = DirectCast(e.UserState, DownloadArgs)
' Do status updates for this download
End Sub
Private Sub DownloadFileCompleted(sender As Object, e As AsyncCompletedEventArgs)
Dim args As DownloadArgs = DirectCast(e.UserState, DownloadArgs)
' do whatever UI updates
Dim url As String = "Filename" '<============I'd like to be able to pass the filename or URL but can't figure this out
AppendText(url & " completed" & vbCrLf)
' now put this client back into the queue
ClientQueue.Add(args.Client)
End Sub
Public Function CreateOutputFilename(ByVal url As String) As String
Try
Return url.Substring(url.LastIndexOf("/") + 1)
Catch ex As Exception
Return url
End Try
End Function
Private Delegate Sub SetTextCallback(text As String)
Private Sub AppendText(text As String)
If Me.TextBox1.InvokeRequired Then
TextBox1.Invoke(New Action(Of String)(AddressOf AppendText), text)
Return
End If
Me.TextBox1.AppendText(text)
Me.TextBox1.SelectionStart = TextBox1.TextLength
Me.TextBox1.ScrollToCaret()
End Sub
End Class
Class DownloadArgs
Public ReadOnly Url As String
Public ReadOnly Filename As String
Public ReadOnly Client As WebClient
Public Sub New(u As String, f As String, c As WebClient)
Url = u
Filename = f
Client = c
End Sub
End Class
This will successfully download the first 4 files in the UrlQueue, but it then seems to freeze and no further files download. I'd imagine the problem lies in something minor I missed in the process of converting from C# to vb.net, but I can't seem to figure this out.
ClientQueue.Take() blocks the UI thread. Also, WebClient will want to raise the DownloadFileCompleted event on the UI thread - but it is already blocked by ClientQueue.Take(). You have a deadlock.
To resolve this, you got to move your blocking loop to another background thread.
You are blocking the ability for your async queue to process. Not sure this is the "Correct" way to do this but the changes here make it work:
While UrlQueue.Count > 0
Do While ClientQueue.Count = 0
Application.DoEvents()
Loop
Dim cli As WebClient = ClientQueue.Take() ' blocks if there is no client available
Dim url As String = UrlQueue.Dequeue()
Dim fname As String = CreateOutputFilename(url) ' or however you get the output file name
cli.DownloadFileAsync(New Uri(url), fname, New DownloadArgs(url, fname, cli))
End While
Here's my script code:
Imports System.Diagnostics
Public Class Script
Implements IScript
Public Sub DoWork(w As WebBrowser, f As Form1) Implements IScript.DoWork
w.Navigate("http://www.google.com")
wait("5000")
w.Document.All("input").InvokeMember("click")
w.Document.All("input").SetAttribute("value", "Torrenter is the best!")
wait("2000")
w.Document.All("421").InvokeMember("click")
wait("1000")
End Sub
Public Sub wait(ByVal interval As Integer)
Dim sw As New Stopwatch
sw.Start()
Do While sw.ElapsedMilliseconds < interval
' Allows UI to remain responsive
Application.DoEvents()
Loop
sw.Stop()
End Sub
End Class
In-code:
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If int1.Text = "1" Then
int1.Text = "0"
Dim script As IScript = GenerateScript(File.ReadAllText(ListBox2.Items.Item(int2).ToString()))
script.DoWork(WebBrowser1, Me) 'Object reference not set to an instance of an object.
int2 = int2 + 1
int1.Text = "1"
End If
End Sub
Why? :(
It's supposed to start the next script after the first was done. I tried 4 methods but I can't understand why.
The problem is that your script code is failing to compile, but then you are trying to instantiate an object from the compiled assembly anyway. Since it failed to compile, the assembly doesn't actually exist, hence the error. If you modify the Return line in the GenerateScript method, so that it shows the compile errors, the actual problem will be more clear:
Dim results As CompilerResults = provider.CompileAssemblyFromSource(parameters, codes)
If results.Errors.HasErrors Then
Dim builder As New StringBuilder()
builder.AppendLine("Script failed to compile due to the following errors:")
For Each i As CompilerError In results.Errors
builder.AppendFormat("Line {0}: {1}", i.Line, i.ErrorText)
builder.AppendLine()
Next
Throw New Exception(builder.ToString())
Else
Return CType(results.CompiledAssembly.CreateInstance("Script"), IScript)
End If
I suspect that one of the reasons it's failing to compile is because the script uses IScript which is undefined. The reason it would complain that it's undefined is for two reasons. First, you declared the IScript interface as nested inside the Form1 class. You should move that outside of the form class so that it's not nested inside of any other type. Second, you are not specifying the full namespace nor importing the namespace in your script. You can automatically add the Imports line to the beginning of the script code before compiling it, like this:
Dim interfaceNamespace As String = GetType(IScript).Namespace
Dim codes As String = "Imports " & interfaceNamespace & Environment.NewLine & code
As I mentioned in the comments above, you really ought to be passing a string array into the CompileAssemblyFromSource method, not a string. I'm not sure how that even compiles, unless that's something having Option Strict Off somehow allows? In any case, it expects an array, so you should really be giving it one, like this:
Dim interfaceNamespace As String = GetType(IScript).Namespace
Dim codeArray() As String = New String() {"Imports " & interfaceNamespace & Environment.NewLine & code}
Dim results As CompilerResults = provider.CompileAssemblyFromSource(parameters, codeArray)
Another obvious reason why the script would fail to compile is because you have it using methods and properties of your Form1 class, as if it were a member of that class. Remember, the Script class defined by the script file source code is a completely separate class in a separate assembly. It will have no reference to the form unless you give it a reference, for instance, you could define the interface like this:
Public Interface IScript
Sub DoWork(f As Form1)
End Interface
Then, in your script, you could do this:
Public Class Script
Implements IScript
Public Sub DoWork(f As Form1) Implements IScript.DoWork
f.WebBrowser1.Navigate("http://www.google.com")
f.wait("5000")
f.wait("4000")
f.WebBrowser1.Document.All("input").InvokeMember("click")
f.WebBrowser1.Document.All("input").SetAttribute("value", "User")
f.wait("2000")
f.WebBrowser1.Document.All("421").InvokeMember("click")
End Sub
End Class
UPDATE
Ok, since you can't get it working, and I don't want this whole conversation to be a total loss, I put together a working project and tested it. Here's what you need to do to get it to work.
Contents of IScript.vb
Public Interface IScript
Sub DoWork(w As WebBrowser)
End Interface
Contents of Form1.vb
Imports Microsoft.VisualBasic
Imports System.CodeDom.Compiler
Imports System.Reflection
Imports System.IO
Imports System.Text
Public Class Form1
Dim int1 As Integer = 0
Dim int2 As Integer = 0
Dim p As Point
Public Function GenerateScript(ByVal code As String) As IScript
Using provider As New VBCodeProvider()
Dim parameters As New CompilerParameters()
parameters.GenerateInMemory = True
parameters.ReferencedAssemblies.Add(GetType(WebBrowser).Assembly.Location)
parameters.ReferencedAssemblies.Add(Assembly.GetExecutingAssembly().Location)
Dim interfaceNamespace As String = GetType(IScript).Namespace
code = "Imports System.Windows.Forms" & Environment.NewLine & "Imports " & interfaceNamespace & Environment.NewLine & code
Dim results As CompilerResults = provider.CompileAssemblyFromSource(parameters, code)
If results.Errors.HasErrors Then
Dim builder As New StringBuilder()
builder.AppendLine("Script failed to compile due to the following errors:")
For Each i As CompilerError In results.Errors
builder.AppendFormat("Line {0}: {1}", i.Line, i.ErrorText)
builder.AppendLine()
Next
Throw New Exception(builder.ToString())
Else
Return CType(results.CompiledAssembly.CreateInstance("Script"), IScript)
End If
End Using
End Function
Public Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
For Each File As FileInfo In New System.IO.DirectoryInfo(Application.StartupPath & "/scripts").GetFiles
If CheckedListBox1.GetItemCheckState(int2) = CheckState.Checked Then
ListBox1.Items.Add(File.FullName)
End If
int2 = int2 + 1
Next
int2 = 0
Dim script As IScript = GenerateScript(File.ReadAllText(ListBox1.Items.Item(int2).ToString()))
script.DoWork(WebBrowser1)
End Sub
End Class
Contents of script file
Imports System.Diagnostics
Public Class Script
Implements IScript
Public Sub DoWork(w As WebBrowser) Implements IScript.DoWork
w.Navigate("http://www.google.com")
wait("5000")
wait("4000")
w.Document.All("input").InvokeMember("click")
w.Document.All("input").SetAttribute("value", "User")
wait("2000")
w.Document.All("421").InvokeMember("click")
End Sub
Public Sub wait(ByVal interval As Integer)
Dim sw As New Stopwatch
sw.Start()
Do While sw.ElapsedMilliseconds < interval
' Allows UI to remain responsive
Application.DoEvents()
Loop
sw.Stop()
End Sub
End Class