.NET events not visible/working for use with vb6(vba)? - vb.net

I have written an vb.net class which I want to make COM-visible for VB6. I have an old application which was developed in VB6, and I am in the process of rewrite it entirely for .net, but in the meantime I need to get this class working and get it usable together with VB6.
All the methods exposed to COM seems to work as they should, but I can't get the event to work with VB6. I have crawled the net for weeks now, and have found a lot of information which have helped me to the point I am now. The problem is when I try to select the class in the dropdown list inside the VB6 IDE, the IDE creates an eventhandler directly(in my case sub tc_Pls_changeprice()). What's strange is that it's not possible for me to select or mark the actual class, and then pick the event from the event dropdown list.
If I doesn't try to select the class first, but select the event directly from the event dropdownlist, I am able to select it(but the name of it is tc_Pls_changeprice, and not Pls_changeprice as I should expect)
If I select it two or more times, the IDE generates new eventhandlers rather than jump into the already created eventhandler.
When I try to put code inside the eventhandler, my vb6 testapplication compiles and run, but the event doesn't fire.
I have attached my .net code and my vb6 testapplication code.
The .dll has been compiled with ComVisible activated, but not register as com-interop(since I need to register the dll on other machines). I register the dll on the host machines with regasm /TLB /codebase option, and the TLB that is generated is located together with the DLL inside same directory as my vb6 source directory.
Duplicate eventhandlers:
This picture shows that its something wrong with the event dropdown event list, and I'm not able to first select the class from the left dropdown list:
Have anybody any ideas of what's wrong?
Here is my .net code for the class:
Imports System.IO.Ports
Imports System.Timers
<Guid("ABEF0C71-17CE-4d38-BEFD-71770E7D50B4")>
<InterfaceType(ComInterfaceType.InterfaceIsDual)>
<ComVisible(True)>
Public Interface Itaxcomm
<DispId(1)> Property commport As String
<DispId(2)> ReadOnly Property taxstatus As String
<DispId(3)> Function open() As Integer
<DispId(4)> Function close() As Integer
<DispId(5)> Sub testevent()
<DispId(6)> Sub Reset()
<DispId(7)> Sub ChangepriceOK()
<DispId(8)> Sub Triggerstartbutton()
<DispId(9)> Sub TaxState()
End Interface
<Guid("A68C5882-21B2-4827-AA0F-A8D6538D1AE3")>
<InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>
<ComVisible(True)>
Public Interface ItaxcommEvents
<DispId(10)> Sub Pls_changeprice()
End Interface
<ComVisible(True)>
<ClassInterface(ClassInterfaceType.None)>
<ComDefaultInterface(GetType(Itaxcomm))>
<ComSourceInterfaces(GetType(ItaxcommEvents))>
<Guid("0F998406-B0CF-440a-8A78-262015480C90")>
<ProgId("Taxcomm.taxcomm")>
Public Class taxcomm
Implements Itaxcomm
Public Status As String
<ComVisible(False)>
Public Delegate Sub pls_changepricedelegate()
Public Event Pls_changeprice As pls_changepricedelegate
Private _comport As String
Private _taxmode As String
Private rxByte(4096) As Byte
Private WithEvents statetimer As New Timer
Private WithEvents sp As New SerialPort
Private Property Itaxcomm_commport As String Implements Itaxcomm.commport
Get
Return _comport
End Get
Set(ByVal value As String)
_comport = value
End Set
End Property
Private ReadOnly Property Itaxcomm_taxstatus As String Implements Itaxcomm.taxstatus
Get
Return _taxmode
End Get
End Property
Private Sub sp_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles sp.DataReceived
Dim s As String = ""
If sp.BytesToRead < 7 Then Exit Sub
sp.Read(rxByte, 0, 7)
For i = 0 To 20
s = s + (rxByte(i).ToString) & " "
Next i
If rxByte(0) = &H48 And rxByte(6) = &H54 And rxByte(5) = (rxByte(0) Xor rxByte(1) Xor rxByte(2) Xor rxByte(3) Xor rxByte(4)) Then
Select Case rxByte(3)
Case 0
Select Case rxByte(4)
Case 0 ''Normal_mode(with tax)
_taxmode = 1
Case 1 ''!Normal_mode(Ex tax)
_taxmode = 0
End Select
Case 1
Select Case rxByte(4)
Case 0 ''Pls_changeprice
RaiseEvent Pls_changeprice()
Case 1
End Select
Case 253
Select Case rxByte(4)
Case 0 ''Buffer overflow
Status = "Tax rx:Buffer overflow"
End Select
Case 255
Select Case rxByte(4)
Case 0
Case 1 ''Command unknown
Status = "Tax rx:Command unknown"
Case 2 ''ERROR_CRC
Status = "Tax rx:ERROR or CRC error"
End Select
End Select
End If
End Sub
Private Sub TestEvent() Implements Itaxcomm.testevent
RaiseEvent Pls_changeprice()
End Sub
Private Sub sp_Disposed(sender As Object, e As EventArgs) Handles sp.Disposed
End Sub
Private Sub sp_ErrorReceived(sender As Object, e As SerialErrorReceivedEventArgs) Handles sp.ErrorReceived
Status = "TAX commerror:" & e.ToString
End Sub
Private Sub Taxstate() Implements Itaxcomm.TaxState
Dim txarray = New Byte() {&H16, &H6, &H63, &H1, &H72, &H54}
sptx(txarray)
End Sub
Public Sub Triggerstartbutton() Implements Itaxcomm.Triggerstartbutton
Dim txarray = New Byte() {&H16, &H6, &H63, &H4, &H77, &H54}
sptx(txarray)
End Sub
Public Sub ChangepriceOK() Implements Itaxcomm.ChangepriceOK
Dim txarray = New Byte() {&H16, &H6, &H63, &H2, &H71, &H54}
sptx(txarray)
End Sub
Public Sub Reset() Implements Itaxcomm.Reset
Dim txarray = New Byte() {&H16, &H6, &H63, &H3, &H70, &H54}
sptx(txarray)
End Sub
Private Sub statetimer_Elapsed(sender As Object, e As ElapsedEventArgs) Handles statetimer.Elapsed
If sp.IsOpen Then Taxstate()
End Sub
Private Sub sptx(a() As Byte)
Do Until sp.BytesToWrite = 0
Loop
sp.Write(a, 0, a.Count)
End Sub
Public Function open() As Integer Implements Itaxcomm.open
Try
sp.BaudRate = 9600
sp.DataBits = 8
sp.Handshake = IO.Ports.Handshake.None
sp.Parity = IO.Ports.Parity.None
sp.RtsEnable = True
sp.ReceivedBytesThreshold = 1
sp.StopBits = IO.Ports.StopBits.One
If _comport <> "" And Not sp.IsOpen Then
sp.PortName = _comport
sp.Open()
statetimer.Interval = 1000
statetimer.Enabled = True
Return 0
Else
Return 1
End If
Catch ex As Exception
Status = "Serialport open:" & Err.Description
Return 1
End Try
End Function
Public Function close() As Integer Implements Itaxcomm.close
Try
If sp.IsOpen Then sp.Close()
statetimer.Enabled = False
Return 0
Catch ex As Exception
Status = "Serialport close:" & Err.Description
Return 1
End Try
End Function
Public Sub New()
MyBase.New()
End Sub
End Class:
and here is my vb6 testapplication code:
Option Explicit
Private WithEvents tc As taxcomm.taxcomm
Private Sub Command1_Click()
On Error GoTo errhandler
tc.Triggerstartbutton
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
End Sub
Private Sub Command2_Click()
On Error GoTo errhandler
tc.Reset
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
End Sub
Private Sub Command3_Click()
tc.testevent
End Sub
Private Sub Form_Load()
On Error GoTo errhandler
Set tc = CreateObject("Taxcomm.taxcomm")
tc.commport = "COM5"
If tc.Open = 0 Then
MsgBox "Active"
Else
MsgBox "Not active"
tc.Close
End If
Exit Sub
errhandler:
MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
tc.Close
End Sub
Private Sub Form_Terminate()
tc.Close
End Sub
Private Sub tc_Pls_changeprice()
MsgBox "test"
End Sub
Private Sub Timer1_Timer()
On Error GoTo errhandler
Text1.Text = tc.taxstatus
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
tc.Close
End Sub
The .net class and the vb6 testapplication compiles as it should, but it seems to be something wrong with the generation of the TLB(due to something wrong in my .net code) so the event doesn't fire, and/or the exposed event are not correctly registered inside VB6 IDE.

This was originally in a comment, but putting this here to make clear what the answer was:
Surprising as it may sound, I've found that VB6 has some limitations when dealing with underscores in method and event names when doing some more advanced COM component / COM interop type stuff. This was years ago, so I cannot recall what pain point I specifically hit. A bit of a longshot, but just for the heck of it, try to rename you event to avoid the underscore

Related

Object reference not set to an instance of object - vb.net

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_"

update listbox in GUI from other classes

I have a listbox on my main vb.net form which I am using to display status messages from the server program I am running. My actual program consists of many different classes (in separate files) and what I would like to be able to do is to call the Sub frm.UpdateList("With Info in Here") from each of the classes to write to the listbox.
If I call the frm.UpdateList or UpdateList from the frm class, it writes to the listbox fine, but if I call it from any other class nothing happens (I don't get an error either).
I have tried with and without making it shared (and changing frm to me) but neither works as I would hope.
Would anyone be able to help me understand why this is not working, I have invoked the item, and it does get added to but just not from a separate class (which is what I need it to do).
Many Thanks!
Private Delegate Sub UpdateListDelegate(ByVal itemName As String)
Public Shared Sub UpdateList(ByVal itemName As String)
If frm.InvokeRequired Then
frm.Invoke(New UpdateListDelegate(AddressOf UpdateList), itemName)
Else
frm.ListBox1.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)
End If
End Sub
Edit: Try 2, with the following thanks to Idle_Mind works on the frm class (frm is the main form and only form) but it still does not write to the listbox when called from other classes (and no errors occur):
Public Shared Sub UpdateList(ByVal itemName As String)
Dim frm As Form = My.Application.ApplicationContext.MainForm
If Not IsNothing(frm) Then
Dim matches() As Control = frm.Controls.Find("ListBox1", True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is ListBox Then
Dim LB As ListBox = DirectCast(matches(0), ListBox)
LB.Invoke(New MethodInvoker(Sub() LB.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End If
End If
End Sub
I have a listbox on my main vb.net form
This will only work on the startup form, and is not really a good design. Consider other approaches as well:
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim soc As New SomeOtherClass
soc.Foo()
End Sub
End Class
Public Class SomeOtherClass
Public Sub Foo()
Dim msg As String = "Hello?!"
Helper.UpdateList(msg) ' <-- You can do this from any class...
End Sub
End Class
Public Class Helper
Public Shared Sub UpdateList(ByVal itemName As String)
Dim frm As Form = My.Application.ApplicationContext.MainForm
If Not IsNothing(frm) Then
Dim matches() As Control = frm.Controls.Find("ListBox1", True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is ListBox Then
Dim LB As ListBox = DirectCast(matches(0), ListBox)
LB.Invoke(New MethodInvoker(Sub() LB.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End If
End If
End Sub
End Class
Other correct approaches, which would require more work on your part, might include:
(1) Pass a reference to your main form into the other classes as you create them. Then those classes can either up the ListBox directly, or possibly call a method in it as suggested by Plutonix. Here's an example of this in action:
Public Class Form1
Public Sub UpdateList(ByVal itemName As String)
ListBox1.Invoke(New MethodInvoker(Sub() ListBox1.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim soc As New SomeOtherClass(Me)
soc.Foo()
End Sub
End Class
Public Class SomeOtherClass
Private _Main As Form1
Private Sub New()
End Sub
Public Sub New(ByVal MainForm As Form1)
_Main = MainForm
End Sub
Public Sub Foo()
If Not IsNothing(_Main) Then
_Main.UpdateList("Hello?!")
End If
End Sub
End Class
You'd have to modify all of your other classes in a similar fashion so that they can receive an instance of your form.
(2) Make the other classes raise a custom event that the main form subscribes to when those classes are created.

Vb Error object reference not set to an instance of an object

I'm having issues creating an updater for my program. It just gives me this error when pressing the button :
object reference not set to an instance of an object
I have a dll file and a Forms application file.
Here is the code of the dll file:
Public Class Class1
Dim bit As Boolean = False
Sub bits()
'For 32 and 64 bit decison
If My.Computer.FileSystem.DirectoryExists("C:\Program Files(x86)") = False Then
bit = False
Else
bit = True
End If
End Sub
Sub CheckFolder(ByVal i As String)
If i.Contains("Program Files") And bit = False Then
ElseIf bit = True Then
i.Replace("Program Files", "Program Files(x86)")
Else
End If
If My.Computer.FileSystem.DirectoryExists(i) Then
Else
My.Computer.FileSystem.CreateDirectory(i)
End If
End Sub
Sub downloadupdate(ByVal location As String)
My.Computer.Network.DownloadFile("http://dl.dropboxusercontent.com/s/e872b78tgcw3pbv/update.txt?dl=1&token_hash=AAFCqEhjemoPI2iKjvv3LbzfuwJ1Gd-G1Kb-Xcebef7tig", location)
End Sub
Sub checkupdate(ByVal location1 As String)
If My.Computer.FileSystem.FileExists(location1) = True Then
Dim update As String
update = My.Computer.FileSystem.ReadAllText(location1)
If update = My.Application.Info.Version.ToString Then
MsgBox("No updates found!")
Else
MsgBox("Updates Found!")
End If
Else
downloadupdate("C:\")
End If
End Sub
End Class
And here is the code for the actual form:
Imports Updates.Class1
Public Class Form1
Public download As Updates.Class1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
download.bits()
download.CheckFolder("C:\")
download.downloadupdate("C:\")
download.checkupdate("C:\")
End Sub
End Class
The DLL File is imported as a referance to the Forms Application
But it gives me that error
Please, Any help?
You need to initialize the class object with the New keyword.
Public download As Updates.Class1
Should be:
Public download As New Updates.Class1

Check Internet Connection vb.net

I am trying to run some vb.net code that indicates if i'm connected to the internet
If My.Computer.Network.IsAvailable Then
MsgBox("Computer is connected.")
Else
MsgBox("Computer is not connected.")
End If
This works fine if I'm connecting to a WiFi signal that doesn't require a login. If I connect to a public WiFi signal that I'm required to login/pay and I execute the code before completing this step it still tells me I'm connected (in theory yes but without paying/logging in I'm not)
Any ideas how set this up?
Thanks
You could check for an internet connection by trying to read Google.com:
Public Shared Function CheckForInternetConnection() As Boolean
Try
Using client = New WebClient()
Using stream = client.OpenRead("http://www.google.com")
Return True
End Using
End Using
Catch
Return False
End Try
End Function
Taken from: Here
I use this
Public Function HaveInternetConnection() As Boolean
Try
Return My.Computer.Network.Ping("www.google.com")
Catch
Return False
End Try
End Function
I create this class to track internet connection changes. This class can check the stable internet connections also (stable means, that the connection not change during N second). The class raise events, if the connection changes.
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.ComTypes
Imports System.Text
Imports System.Collections.Generic
Imports System.Linq
Imports System.Net.NetworkInformation
Imports System.Net
Public Enum InternetConnectionState
Connected
Disconnected
End Enum
Public Class NetworkConnections
Implements IDisposable
Public Shared Property CheckHostName As String = "www.google.com"
Public Property ConnectionStableAfterSec As Integer = 10
Private MonitoringStarted As Boolean = False
Private StableCheckTimer As System.Threading.Timer
Private IsFirstCheck As Boolean = True
Private wConnectionIsStable As Boolean
Private PrevInternetConnectionState As InternetConnectionState = InternetConnectionState.Disconnected
Public Event InternetConnectionStateChanged(ByVal ConnectionState As InternetConnectionState)
Public Event InternetConnectionStableChanged(ByVal IsStable As Boolean, ByVal ConnectionState As InternetConnectionState)
Public Sub StartMonitoring()
If MonitoringStarted = False Then
AddHandler NetworkChange.NetworkAddressChanged, AddressOf NetworkAddressChanged
MonitoringStarted = True
NetworkAddressChanged(Me, Nothing)
End If
End Sub
Public Sub StopMonitoring()
If MonitoringStarted = True Then
Try
RemoveHandler NetworkChange.NetworkAddressChanged, AddressOf NetworkAddressChanged
Catch ex As Exception
End Try
MonitoringStarted = False
End If
End Sub
Public ReadOnly Property ConnectionIsStableNow As Boolean
Get
Return wConnectionIsStable
End Get
End Property
<DllImport("wininet.dll")> _
Private Shared Function InternetGetConnectedState(ByRef Description As Integer, ByVal ReservedValue As Integer) As Boolean
End Function
Private Shared Function IsInternetAvailable() As Boolean
Try
Dim ConnDesc As Integer
Dim conn As Boolean = InternetGetConnectedState(ConnDesc, 0)
Return conn
Catch
Return False
End Try
End Function
Private Shared Function IsInternetAvailableByDns() As Boolean
Try
Dim iheObj As IPHostEntry = Dns.GetHostEntry(CheckHostName)
Return True
Catch
Return False
End Try
End Function
Public Shared Function CheckInternetConnectionIsAvailable() As Boolean
Return IsInternetAvailable() And IsInternetAvailableByDns()
End Function
Private Sub NetworkAddressChanged(sender As Object, e As EventArgs)
wConnectionIsStable = False
StableCheckTimer = New System.Threading.Timer(AddressOf ElapsedAndStable, Nothing, New TimeSpan(0, 0, ConnectionStableAfterSec), New TimeSpan(1, 0, 0))
If IsFirstCheck Then
If CheckInternetConnectionIsAvailable() Then
PrevInternetConnectionState = InternetConnectionState.Connected
RaiseEvent InternetConnectionStateChanged(InternetConnectionState.Connected)
Else
PrevInternetConnectionState = InternetConnectionState.Disconnected
RaiseEvent InternetConnectionStateChanged(InternetConnectionState.Disconnected)
End If
IsFirstCheck = False
Else
If CheckInternetConnectionIsAvailable() Then
If PrevInternetConnectionState <> InternetConnectionState.Connected Then
PrevInternetConnectionState = InternetConnectionState.Connected
RaiseEvent InternetConnectionStateChanged(InternetConnectionState.Connected)
End If
Else
If PrevInternetConnectionState <> InternetConnectionState.Disconnected Then
PrevInternetConnectionState = InternetConnectionState.Disconnected
RaiseEvent InternetConnectionStateChanged(InternetConnectionState.Disconnected)
End If
End If
End If
End Sub
Private Sub ElapsedAndStable()
If wConnectionIsStable = False Then
wConnectionIsStable = True
Dim hasnet As Boolean = CheckInternetConnectionIsAvailable()
RaiseEvent InternetConnectionStableChanged(True, IIf(hasnet, InternetConnectionState.Connected, InternetConnectionState.Disconnected))
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean ' To detect redundant calls
' IDisposable
Protected Overridable Sub Dispose(disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
Try
RemoveHandler NetworkChange.NetworkAddressChanged, AddressOf NetworkAddressChanged
Catch ex As Exception
End Try
End If
' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
' TODO: set large fields to null.
End If
Me.disposedValue = True
End Sub
' TODO: override Finalize() only if Dispose(ByVal disposing As Boolean) above has code to free unmanaged resources.
'Protected Overrides Sub Finalize()
' ' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.
' Dispose(False)
' MyBase.Finalize()
'End Sub
' This code added by Visual Basic to correctly implement the disposable pattern.
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
Track changes on a form with 2 listbox. Important! The events are thread unsafe, that need to be handle with invoke method.
Imports System.Net.NetworkInformation
Imports System.Net
Public Class frmNetworkConnections
Private WithEvents conn As NetworkConnections
Delegate Sub AddToList1Callback(ByVal ConnectionState As InternetConnectionState, ByVal IsStable As Boolean)
Delegate Sub AddToList2Callback(ByVal ConnectionState As InternetConnectionState, ByVal IsStable As Boolean)
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
conn = New NetworkConnections
End Sub
Sub AddToList1(ByVal ConnectionState As InternetConnectionState, ByVal IsStable As Boolean)
If Me.InvokeRequired = True Then
Dim d As New AddToList1Callback(AddressOf AddToList1)
Me.Invoke(d, ConnectionState, IsStable)
Else
ListBox1.Items.Add(Now & " - State: " & ConnectionState.ToString() & ", Stable: " & IsStable)
End If
End Sub
Sub AddToList2(ByVal ConnectionState As InternetConnectionState, ByVal IsStable As Boolean)
If Me.InvokeRequired = True Then
Dim d As New AddToList2Callback(AddressOf AddToList2)
Me.Invoke(d, ConnectionState, IsStable)
Else
ListBox1.Items.Add(Now & " - State: " & ConnectionState.ToString() & ", Stable: " & IsStable)
ListBox2.Items.Add(Now & " - State: " & ConnectionState.ToString() & ", Stable: " & IsStable)
End If
End Sub
Private Sub conn_InternetConnectionStableChanged(IsStable As Boolean, ConnectionState As InternetConnectionState) Handles conn.InternetConnectionStableChanged
AddToList2(ConnectionState, IsStable)
End Sub
Private Sub conn_InternetConnectionStateChanged(ConnectionState As InternetConnectionState) Handles conn.InternetConnectionStateChanged
AddToList1(ConnectionState, False)
End Sub
Private Sub btnStartMonitoring_Click(sender As Object, e As EventArgs) Handles btnStartMonitoring.Click
btnStopMonitoring.Enabled = True
btnStartMonitoring.Enabled = False
conn.StartMonitoring()
End Sub
Private Sub btnStopMonitoring_Click(sender As Object, e As EventArgs) Handles btnStopMonitoring.Click
btnStopMonitoring.Enabled = False
btnStartMonitoring.Enabled = True
conn.StopMonitoring()
End Sub
End Class
The result is:
I use the stable connection changes.
If you dont want to track changes, only check the connection, you can use the CheckInternetConnectionIsAvailable() shared function.
You could use the Ping class to try to reach a host in the Internet. In order not to wait too long, you should set a timeout when using Send.
A good way to check if the user is connected to the internet is
If My.Computer.Network.Ping("www.google.com") Then
MsgBox("Computer is connected to the internet.")
End If
You can also use this code, however it's slower
Public Shared Function CheckForInternetConnection() As Boolean
Try
Using client = New WebClient()
Using stream = client.OpenRead("http://www.google.com")
Return True
End Using
End Using
Catch
Return False
End Try
End Function
***** Best *****
The best Code For it, it not make any bug or Any slow.
Button Or Timer .. Etc
Try
If My.Computer.Network.Ping("www.google.com") Then
Label1.Text = "Internet Founded"
End If
Catch ex As Exception
'' Else ''
Label1.Text = "No internet Acess"
End Try
At least hope you gave me that
"Question Answer", it the best solution .Thanks.
(you can try it out)
Try
Dim client = New Net.WebClient
client.OpenRead("http://www.google.com")
Label21.Text = "Internet : Connected"
Catch
Label21.Text = "Internet : Disconnected"
End Try
Use this code in vb.net 100% solved, you can use this code form loading.
I am using this code and is working very well:
Public Function IsConnectedToInternet() As Boolean
If My.Computer.Network.IsAvailable Then
Try
Dim IPHost As IPHostEntry = Dns.GetHostEntry("www.google.com")
Return True
Catch
Return False
End Try
Else
Return False
End If
End Function
My.Computer.Network.Ping gave me problems so I used this function
Public Function fVerificaConnessioneInternet() As Boolean
Dim objPing As New System.Net.NetworkInformation.Ping
Try
Return If(objPing.Send("www.google.it").Status = IPStatus.Success, True, False)
Catch
Return False
End Try
End Function
or you could use this, a little better function to use. this should help you out if you need a c# version
http://www.guideushow.com/code-snippet/function-to-check-if-you-can-connect-to-the-internet-vb-net-c/
Public Function IsConnectionAvailable() As Boolean
' Returns True if connection is available
' Replace www.yoursite.com with a site that
' is guaranteed to be online - perhaps your
' corporate site, or microsoft.com
Dim objUrl As New System.Uri("http://www.google.com/")
' Setup WebRequest
Dim objWebReq As System.Net.WebRequest
objWebReq = System.Net.WebRequest.Create(objUrl)
objWebReq.Proxy = Nothing
Dim objResp As System.Net.WebResponse
Try
' Attempt to get response and return True
objResp = objWebReq.GetResponse
objResp.Close()
objWebReq = Nothing
Return True
Catch ex As Exception
' Error, exit and return False
objResp.Close()
objWebReq = Nothing
Return False
End Try
End Function

VB.NET accessing class objects from launched thread

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.