• Home
 · 
• Internet/HTML
 · 
• WiFi and LAN-Name, Signal Strength, etc

WiFi and LAN-Name, Signal Strength, etc

A LOT of researched info on WiFi, signal strength, which adapter is
connected to wireless, how to override to use LAN if cable plugged in,
which of the wireless connections has the lowest metric, etc... I suggest
you visit each of the URLs for your own benefit. Note all URLs are
included... Borrowed from various sources, and all noted. The one by
Techni Rei Myoko no longer exists in VBC (Returns the Wifi signal
strength in bars (1 to 5, 5 being good). Placed as generic source for you
to use the pieces that you choose... Kindly vote, noting that all info
has been researched and collated into one place.

Rate WiFi and LAN-Name, Signal Strength, etc

• 1
• 2
• 3
• 4
• 5

(3(3 Vote))

Option Explicit
'WiFi and LAN - Name, Signal Strength, etc...
'------------------------------------------------------------------------------------
'An easy way to test a user's Internet connection with the API
'------------------------------------------------------------------------------------
'Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwFlags As Long, _
ByVal dwReserved As Long) As Long
'The function returns 1 if a connection exists and 0 if not. You can easily convert these values to their Boolean equivalents in VB. After the test, the dwflags parameter will indicate what type of connection the user has. You use bitwise comparisons to test for specific values. The dwflags constants are as follows:
Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40
' added - Tiger
Private Const CONNECT_RAS As Long = &H10
Private Const CONNECT_MODEM_BUSY As Long = &H8
'------------------------------------------------------------------------------------
'An easy way to test a user's Internet connection with the API
'------------------------------------------------------------------------------------
' ===========================================================================
'http://vbnet.mvps.org/index.html?code/network/internetgetconnectedstate.htm
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Private Sub TestHowConnectedToLanRASetc()
'
'Text1.Text = IsNetConnectViaLAN()
'Text2.Text = IsNetConnectViaModem()
'Text3.Text = IsNetConnectViaProxy()
'Text4.Text = IsNetConnectOnline()
'Text5.Text = IsNetRASInstalled()
'Text6.Text = GetNetConnectString()
'
'End Sub
Private Function IsNetConnectViaLAN() As Boolean
Dim dwFlags As Long
 'pass an empty variable into which the API will
 'return the flags associated with the connection
Call InternetGetConnectedState(dwFlags, 0&)
 'return True if the flags indicate a LAN connection
IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN
 
End Function
Private Function IsNetConnectViaModem() As Boolean
Dim dwFlags As Long
 'pass an empty variable into which the API will
 'return the flags associated with the connection
Call InternetGetConnectedState(dwFlags, 0&)
 'return True if the flags indicate a modem connection
IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM
 
End Function
Private Function IsNetConnectViaProxy() As Boolean
Dim dwFlags As Long
 'pass an empty variable into which the API will
 'return the flags associated with the connection
Call InternetGetConnectedState(dwFlags, 0&)
 'return True if the flags indicate a proxy connection
IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY
 
End Function
Private Function IsNetConnectOnline() As Boolean
 'no flags needed here - the API returns True
 'if there is a connection of any type
IsNetConnectOnline = InternetGetConnectedState(0&, 0&)
 
End Function
Private Function IsNetRASInstalled() As Boolean
Dim dwFlags As Long
 'pass an empty variable into which the API will
 'return the flags associated with the connection
Call InternetGetConnectedState(dwFlags, 0&)
 'return True if the flags include RAS installed
IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED
 
End Function
Private Function GetNetConnectString() As String
Dim dwFlags As Long
Dim Msg As String
 'build a string for display
If InternetGetConnectedState(dwFlags, 0&) Then
 
 If dwFlags And INTERNET_CONNECTION_CONFIGURED Then
 Msg = Msg & "You have a network connection configured." & vbCrLf
 End If
 If dwFlags And INTERNET_CONNECTION_LAN Then
 Msg = Msg & "The local system connects to the Internet via a LAN"
 End If
 
 If dwFlags And INTERNET_CONNECTION_PROXY Then
 Msg = Msg & ", and uses a proxy server. "
 Else
 Msg = Msg & "."
 End If
 
 If dwFlags And INTERNET_CONNECTION_MODEM Then
 Msg = Msg & "The local system uses a modem to connect to the Internet. "
 End If
 
 If dwFlags And INTERNET_CONNECTION_OFFLINE Then
 Msg = Msg & "The connection is currently offline. "
 End If
 
 If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then
 Msg = Msg & "The local system's modem is busy with a non-Internet connection. "
 End If
 
 If dwFlags And INTERNET_RAS_INSTALLED Then
 Msg = Msg & "Remote Access Services are installed on this system."
 End If
Else
 
 Msg = "Not connected to the internet now."
End If
GetNetConnectString = Msg
End Function
Public Function RtnNetConnectionString() As String
Dim dwFlags As Long
Dim Msg As String
 Msg = ""
 'build a string for display
If InternetGetConnectedState(dwFlags, 0&) Then
 
 Msg = ""
 
 'If dwflags And INTERNET_CONNECTION_CONFIGURED Then
 'msg = msg & "Configured network connection." & vbCrLf
 'End If
 If dwFlags And INTERNET_CONNECTION_LAN Then
 Msg = Msg & "LAN"
 End If
 
 If dwFlags And INTERNET_CONNECTION_PROXY Then
 Msg = Msg & "(proxy)"
 End If
 
 If dwFlags And INTERNET_CONNECTION_MODEM Then
 If Msg <> "" Then Msg = Msg & "."
 Msg = Msg & "MODEM"
 End If
 
 If dwFlags And INTERNET_CONNECTION_OFFLINE Then
 If Msg <> "" Then Msg = Msg & "."
 Msg = Msg & "Offline"
 End If
 
 'If dwflags And INTERNET_CONNECTION_MODEM_BUSY Then
 'msg = msg & "modem busy - non-Internet connection. "
 'End If
 
 'If IsNetConnectOnline = True Then msg = msg & "Online."
 
 If Msg = "" Then Msg = "UNKNOWN."
 
 'If dwflags And INTERNET_RAS_INSTALLED Then
 'msg = msg & "Remote Access Services installed."
 'End If
Else
 
 Msg = "Offline"
End If
RtnNetConnectionString = Msg
End Function
' ===========================================================================
Private Sub ForceToUseLANOverWirelessWhenConnectedToBoth()
'https://community.spiceworks.com/scripts/show/1643-force-workstation-to-use-lan-over-wireless-when-connected-to-both
'This script increases the Route metric to a number specified (on line 6).
'I found this on a Microsoft Support site a while
'back: http://support.microsoft.com/kb/894564
'This can (and should?) be used as part of your login scripts that
'are deployed through GPO.
'Please refer to my How to for other ideas on managing wireless and
'wired connections here:
'http://community.spiceworks.com/how_to/show/14437-how-to-bring-harmony-to-your-mixed-wired-and-wireless-networks
''VBS
'strComputer = "."
'Set objWMIService = GetObject("winmgmts:" _
'& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'
'regValueDataMetric = "500"
'
'Set colItems = objWMIService.ExecQuery _
'("Select * From Win32_NetworkAdapter Where NetConnectionID = 'Wireless Network Connection'")
'
'For Each objItem In colItems
'strMACAddress = objItem.MACAddress
'Wscript.Echo "MACAddress: " & strMACAddress
'Next
'
'Set colNetCard = objWMIService.ExecQuery _
'("Select * From Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
'
'For Each objNetCard In colNetCard
'If objNetCard.MACAddress = strMACAddress Then
'For Each strIPAddress In objNetCard.IPAddress
'Wscript.Echo "Description: " & objNetCard.Description
'Wscript.Echo "IP Address: " & strIPAddress
'Wscript.Echo "IPConnectionMetric: " & objNetCard.IPConnectionMetric
'' this sets the value... objNetCard.SetIPConnectionMetric (regValueDataMetric)
'Next
'End If
'Next
'
'' set stuff to nothing here....
'
End Sub
Private Sub DisplayInfoOnAllNICs()
'http://www.visualbasicscript.com/m97503-print.aspx
Dim objWMIService As Object
Dim colItems As Object, objItem As Object
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly = &H20
Dim strComputer As String
strComputer = "."
' Wireless
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID = 'Wireless Network Connection[/style]'", "WQL", _
 wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
 'ws.Cells(intRowToUse, 10).value = "" & objItem.Description
 'ws.Cells(intRowToUse, 11).value = "" & objItem.MACAddress
Next
Set colItems = Nothing
Set objWMIService = Nothing
' LAN
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID = 'Local Area Connection[/style]'", "WQL", _
 wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
'ws.Cells(intRowToUse, 12).value = "" & objItem.Description
'ws.Cells(intRowToUse, 13).value = "" & objItem.MACAddress
Next
Set colItems = Nothing
Set objWMIService = Nothing
End Sub
'https://www.promixis.com/forums/showthread.php?15714-Help-With-Visual-Basic-Script
Private Sub ShowAllWirelessAdapters()
On Error Resume Next
Dim objWMIService As Object, colItems As Object, objItem As Object
Dim strComputer As String
Dim regValueDataMetric
Dim ConnectionStatus
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
regValueDataMetric = "35"
ConnectionStatus = 7
Do While ConnectionStatus <> 2
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapter Where NetConnectionID = 'Wireless Network Connection'")
If colItems.Count = 0 Then
MsgBox "No Wireless Adapter Present!"
ConnectionStatus = 2
Else
For Each objItem In colItems
If objItem.NetConnectionStatus = 2 Then
MsgBox "Name: " & vbTab & vbTab & objItem.Name & vbCrLf _
& "Description: " & vbTab & objItem.Description & vbCrLf _
& "AdapterType: " & vbTab & objItem.AdapterType & vbCrLf _
& "MACAddress: " & vbTab & objItem.MACAddress & vbCrLf _
& "ConnectionStatus: " & vbTab & objItem.NetConnectionStatus & vbCrLf _
& "NetConnectionID: " & vbTab & objItem.NetConnectionID, , "IsConnected.vbs"
'Set GirderEvent = CreateObject("Girder.GirderEvent")
'GirderEvent.Device = 18
'GirderEvent.EventString = "Start Xlobby"
'GirderEvent.Send()
ConnectionStatus = 2
End If
Next
End If
'WScript.Sleep 1000
Loop
End Sub
'**************************************
' Name: WiFi Signal Strength
' Description:Returns the Wifi signal strength in bars (1 to 5, 5 being good)
' By: Techni Rei Myoko
' http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=71872&lngWId=1
'**************************************
Public WiFiHardwareName As String, WiFiDecibals As Long
Public objWMIServiceGlobal As Object
Public isSet As Boolean
Public Declare Function InternetGetConnectedState Lib "Wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Public Enum ConnectedState
INTERNET_CONNECTION_MODEM = &H1
INTERNET_CONNECTION_LAN = &H2
INTERNET_CONNECTION_PROXY = &H4
INTERNET_CONNECTION_MODEM_BUSY = &H8
INTERNET_RAS_INSTALLED = &H10
INTERNET_CONNECTION_OFFLINE = &H20
INTERNET_CONNECTION_CONFIGURED = &H40
End Enum
' ===========================================================================
' ===========================================================================
' ??? uses isset, as default compilation var as false...
' ??? calls InternetGetConnectedState - with default flags value...
Public Function RtnWiFiSignalStrength(Optional Computer As String = ".") As Long
On Error Resume Next
Dim colItems As Object, objItem As Object
Dim WiFiSignalStrength As Long
WiFiSignalStrength = IIf(isConnected, 5, 0)
If Not isSet Then
 Set objWMIServiceGlobal = GetObject("winmgmts:\\" & Computer & "\root\wmi")
 isSet = True
End If
Set colItems = objWMIServiceGlobal.ExecQuery("Select * From MSNdis_80211_ReceivedSignalStrength")
 For Each objItem In colItems
WiFiDecibals = objItem.NDIS80211ReceivedSignalStrength
WiFiHardwareName = objItem.InstanceName
Select Case WiFiDecibals
Case 0: WiFiHardwareName = "Ethernet": WiFiSignalStrength = 5
Case Is > -57: WiFiSignalStrength = 5 ' -56 to 0
Case Is > -68: WiFiSignalStrength = 4 '-67 to -57
Case Is > -72: WiFiSignalStrength = 3 '-71 to -68
Case Is > -80: WiFiSignalStrength = 2 '-79 to -72
Case Is > -90: WiFiSignalStrength = 1 '-89 to -80
Case Else: WiFiSignalStrength = 0
End Select
 Next
Set colItems = Nothing
RtnWiFiSignalStrength = WiFiSignalStrength
End Function
'Connection
Public Function isConnected() As Boolean
Dim dwFlags As Long, RetVal As Long
RetVal = InternetGetConnectedState(dwFlags, 0&)
isConnected = RetVal = 1
End Function
' ===========================================================================
' ===========================================================================
'http://www.experts-exchange.com/questions/28350821/Getting-Wireless-Connection-Name-Through-VBA.html
Function GetNameOfActiveConnection(ByRef AllConnectionNamesCSV As String) As String
Dim strComputer As String
Dim objWMIService As Object
Dim colLAN As Object
Dim colWiFi As Object
Dim objWifi As Object
Dim objLAN As Object
Dim ConnectionName As String
ConnectionName = ""
AllConnectionNamesCSV = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colLAN = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter Where NetConnectionID like 'Local Area Connection' and PhysicalAdapter='True'")
''''Set colLAN = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter Where PhysicalAdapter='True'")
'Set colWiFi = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter Where NetConnectionID =" & "'" & GetWirelessName & "'" & "and PhysicalAdapter='True' ")
'For Each objWifi In colWiFi
'If objWifi.Netconnectionstatus = 2 Then
'ConnectionName = objWifi.Name
'AllConnectionNamesCSV = AllConnectionNamesCSV & ", " & ConnectionName
'End If
'Next
For Each objLAN In colLAN
If objLAN.NetConnectionStatus = 2 Then
ConnectionName = objLAN.Name
AllConnectionNamesCSV = AllConnectionNamesCSV & ", " & ConnectionName
End If
Next
'Set colWiFi = Nothing
Set colLAN = Nothing
Set objWMIService = Nothing
' remove any leading commas in CSV string before returning PARM value...
If AllConnectionNamesCSV <> "" Then
 If Left$(AllConnectionNamesCSV, 1) = "," Then
AllConnectionNamesCSV = Right$(AllConnectionNamesCSV, Len(AllConnectionNamesCSV) - 1)
AllConnectionNamesCSV = Trim$(AllConnectionNamesCSV)
 End If
End If
' neaten up...
'dbug
ConnectionName = ""
ConnectionName = Trim$(ConnectionName)
GetNameOfActiveConnection = ConnectionName
End Function
'===========================================================================
' ===========================================================================
Public Function GetDNSQualifiedComputerName(ByRef DomainName As String, ByRef hostname As String) As String
Dim buffer As String
Dim SIZE As Long
Dim network_and_computer As String
Dim network_name As String
On Error Resume Next
' make 3 calls - rather than extract pieces out...
SIZE = 255
buffer = Space(SIZE)
GetComputerNameEx ComputerNameDnsDomain, buffer, SIZE
DomainName = Left$(buffer, SIZE) & ""
DomainName = Trim$(DomainName)
SIZE = 255
buffer = Space(SIZE)
GetComputerNameEx ComputerNameDnsHostname, buffer, SIZE
hostname = Left$(buffer, SIZE) & ""
hostname = Trim$(hostname)
SIZE = 255
buffer = Space(SIZE)
GetComputerNameEx ComputerNameDnsFullyQualified, buffer, SIZE
'network_and_computer = Left$(buffer, size)
'MsgBox network_and_computer
'network_name = Right(network_and_computer, Len(network_and_computer) - InStr(1, network_and_computer, ".", vbTextCompare))
GetDNSQualifiedComputerName = Trim$(Left$(buffer, SIZE) & "")
End Function
' ===========================================================================
'http://stackoverflow.com/questions/3282760/using-wmi-to-determine-which-adapters-is-connected-to-the-internet
'Using Win32_NetworkAdapterConfiguration find the network device that has the
'lowest IPConnectionMetric, this will be the first device used for
'internet access.
' ===========================================================================
Public Function GetInternetAdapterName() As String
Dim objWMIService As Object
Dim colItems As Object, objItem As Object
Dim metric As Long
Dim Description As String
Dim strComputer As String' should pass in PARM???? ....
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")
metric = 500
Description = ""
For Each objItem In colItems
If (objItem.IPConnectionMetric < metric And objItem.IPConnectionMetric >= 0) Then
metric = objItem.IPConnectionMetric
Description = objItem.Description
End If
Next
Set colItems = Nothing
Set objWMIService = Nothing
GetInternetAdapterName = Description
End Function
' ===========================================================================
Dim AllWiFiConnectionNamesCSV As String
Dim WiFiSignalStrength As Long
Private Sub tmrDateTime_Timer()
Dim DateTimeStr As String
Dim WiFiConnectionName As String
Dim AllWiFiConnectionNamesCSV As String
Dim NetworkName As String
Dim DomainName As String, hostname As String
Dim InternetAdapterName As String
Dim NetConnectionString As String
Dim BattLifePerc As Long
Dim BattLifeTime As String
Dim BattFullLifeTime As String
Dim BattPowerLineSource As String
Dim BattStatus As String
Dim p As Long
Static TenCounter As Long
' roll over from 1 to 10...
If TenCounter > 10 Then TenCounter = 0
If TenCounter < 0 Then TenCounter = 0
TenCounter = TenCounter + 1
 
' Do WiFi things...
' this is every second...
WiFiSignalStrength = RtnWiFiSignalStrength
			 'dbug...
			WiFiSignalStrength = RtnRndBetween(0, 6)
			 If WiFiSignalStrength = 6 Then WiFiSignalStrength = 5
Call DisplayWifiStrengthPic(WiFiSignalStrength)
' every ten seconds, determine the provider...
' this will also allow it to display on first time...
 If (TenCounter = 1) Then
AllWiFiConnectionNamesCSV = ""
WiFiConnectionName = GetNameOfActiveConnection(AllWiFiConnectionNamesCSV)
If WiFiConnectionName = "" Then
' determine network name and domain...eg (computer.hostname.nz.ca)
DomainName = ""
hostname = ""
NetworkName = GetDNSQualifiedComputerName(DomainName, hostname)
WiFiConnectionName = DomainName
p = InStr(1, WiFiConnectionName, ".", vbBinaryCompare)
If p <> 0 Then
 WiFiConnectionName = Left$(WiFiConnectionName, p - 1)
End If
End If
' debug...
If WiFiConnectionName = "" Then WiFiConnectionName = "MTN" ' GetNameOfActiveConnection(AllWiFiConnectionNamesCSV)
If AllWiFiConnectionNamesCSV <> "" Then
 ' do whatever necessary, if we have more than one provider...
End If
WiFiConnectionName = UCase$(WiFiConnectionName)
Call DisplayWifiNamePic(WiFiConnectionName)
' determine network name and domain...eg (machinename.hostname.nz.ca)
'DomainName = ""
'Hostname = ""
'NetworkName = GetDNSQualifiedComputerName(DomainName, Hostname)
'MsgBox "Network name : " & NetworkName & vbCrLf & _
'"Domain Name name : " & DomainName & vbCrLf & _
'"Hostname name : " & Hostname
' Display Internet connectionName
InternetAdapterName = GetInternetAdapterName
'Call DisplayWifiNamePic(InternetAdapterName)
'''''''MsgBox InternetAdapterName
' determine how we are connected (LAN, modem, proxy,etc)
NetConnectionString = RtnNetConnectionString
'MsgBox NetConnectionString
Call DisplayWifiConnectionTypePic(NetConnectionString)
 End If
 
 
 
End Sub
Public Function RtnDateTimeStrFormmated() As String
Dim DateTimeStr As String
 DateTimeStr = Trim$(CStr(Now))
 RtnDateTimeStrFormmated = Mid$(DateTimeStr, 12, 5) & " " & Right$(DateTimeStr, 2)
End Function
Public Function RtnRndBetween(X As Long, Y As Long) As Long
Dim MyValue
 Randomize
 MyValue = Int((Y * Rnd) + X)' Generate random value between 1 and 6.
 RtnRndBetween = MyValue
End Function