Account Login Username:
Active Server Pages Coding Standards Complete Applications Custom Controls/Forms/Menus Data Structures Databases/Data Access/DAO/ADO DDE Debugging and Error Handling DirectX Encryption Files/File Controls/Input/Output Games Graphics Internet/HTML Jokes/Humor Libraries Math/Dates Microsoft Office Apps/VBA Miscellaneous Object Oriented Programming (OOP) OLE/COM/DCOM/Active-X Registry Sound/MP3 String Manipulation VB function enhancement Windows API Call/Explanation Windows CE Windows System Services
by TigerM (7 Submissions) Category: Internet/HTMLCompatability: Visual Basic 4.0 (32-bit)Difficulty: Intermediate Date Added: Fri 12th February 2021 Rating: (0 Votes)
A LOT of researched info on WiFi, signal strength, which adapter isconnected to wireless, how to override to use LAN if cable plugged in,which of the wireless connections has the lowest metric, etc... I suggestyou visit each of the URLs for your own benefit. Note all URLs areincluded... Borrowed from various sources, and all noted. The one byTechni Rei Myoko no longer exists in VBC (Returns the Wifi signalstrength in bars (1 to 5, 5 being good). Placed as generic source for youto use the pieces that you choose... Kindly vote, noting that all infohas been researched and collated into one place.
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 = &H2Private Const CONNECT_MODEM As Long = &H1Private Const CONNECT_PROXY As Long = &H4Private Const CONNECT_OFFLINE As Long = &H20Private Const CONNECT_CONFIGURED As Long = &H40' added - TigerPrivate Const CONNECT_RAS As Long = &H10Private 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 SubPrivate Function IsNetConnectViaLAN() As BooleanDim dwFlags As Long 'pass an empty variable into which the API will 'return the flags associated with the connectionCall InternetGetConnectedState(dwFlags, 0&) 'return True if the flags indicate a LAN connectionIsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN End FunctionPrivate Function IsNetConnectViaModem() As BooleanDim dwFlags As Long 'pass an empty variable into which the API will 'return the flags associated with the connectionCall InternetGetConnectedState(dwFlags, 0&) 'return True if the flags indicate a modem connectionIsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM End FunctionPrivate Function IsNetConnectViaProxy() As BooleanDim dwFlags As Long 'pass an empty variable into which the API will 'return the flags associated with the connectionCall InternetGetConnectedState(dwFlags, 0&) 'return True if the flags indicate a proxy connectionIsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY End FunctionPrivate Function IsNetConnectOnline() As Boolean 'no flags needed here - the API returns True 'if there is a connection of any typeIsNetConnectOnline = InternetGetConnectedState(0&, 0&) End FunctionPrivate Function IsNetRASInstalled() As BooleanDim dwFlags As Long 'pass an empty variable into which the API will 'return the flags associated with the connectionCall InternetGetConnectedState(dwFlags, 0&) 'return True if the flags include RAS installedIsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED End FunctionPrivate Function GetNetConnectString() As StringDim dwFlags As LongDim Msg As String 'build a string for displayIf 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 IfElse Msg = "Not connected to the internet now."End IfGetNetConnectString = MsgEnd FunctionPublic Function RtnNetConnectionString() As StringDim dwFlags As LongDim Msg As String Msg = "" 'build a string for displayIf 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 IfElse Msg = "Offline"End IfRtnNetConnectionString = MsgEnd 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 SubPrivate Sub DisplayInfoOnAllNICs()'http://www.visualbasicscript.com/m97503-print.aspxDim objWMIService As ObjectDim colItems As Object, objItem As ObjectConst wbemFlagReturnImmediately = &H10Const wbemFlagForwardOnly = &H20Dim strComputer As StringstrComputer = "."' WirelessSet 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.MACAddressNextSet colItems = NothingSet objWMIService = Nothing' LANSet 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.MACAddressNextSet colItems = NothingSet objWMIService = NothingEnd Sub'https://www.promixis.com/forums/showthread.php?15714-Help-With-Visual-Basic-ScriptPrivate Sub ShowAllWirelessAdapters()On Error Resume NextDim objWMIService As Object, colItems As Object, objItem As ObjectDim strComputer As StringDim regValueDataMetricDim ConnectionStatusstrComputer = "."Set objWMIService = GetObject("winmgmts:" _& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")regValueDataMetric = "35"ConnectionStatus = 7Do While ConnectionStatus <> 2Set colItems = objWMIService.ExecQuery _("Select * From Win32_NetworkAdapter Where NetConnectionID = 'Wireless Network Connection'")If colItems.Count = 0 ThenMsgBox "No Wireless Adapter Present!"ConnectionStatus = 2ElseFor Each objItem In colItemsIf objItem.NetConnectionStatus = 2 ThenMsgBox "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 = 2End IfNextEnd If'WScript.Sleep 1000LoopEnd 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 LongPublic objWMIServiceGlobal As ObjectPublic isSet As BooleanPublic Declare Function InternetGetConnectedState Lib "Wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As LongPublic Enum ConnectedStateINTERNET_CONNECTION_MODEM = &H1INTERNET_CONNECTION_LAN = &H2INTERNET_CONNECTION_PROXY = &H4INTERNET_CONNECTION_MODEM_BUSY = &H8INTERNET_RAS_INSTALLED = &H10INTERNET_CONNECTION_OFFLINE = &H20INTERNET_CONNECTION_CONFIGURED = &H40End Enum' ===========================================================================' ===========================================================================' ??? uses isset, as default compilation var as false...' ??? calls InternetGetConnectedState - with default flags value...Public Function RtnWiFiSignalStrength(Optional Computer As String = ".") As LongOn Error Resume NextDim colItems As Object, objItem As ObjectDim WiFiSignalStrength As LongWiFiSignalStrength = IIf(isConnected, 5, 0)If Not isSet Then Set objWMIServiceGlobal = GetObject("winmgmts:\\" & Computer & "\root\wmi") isSet = TrueEnd IfSet colItems = objWMIServiceGlobal.ExecQuery("Select * From MSNdis_80211_ReceivedSignalStrength") For Each objItem In colItemsWiFiDecibals = objItem.NDIS80211ReceivedSignalStrengthWiFiHardwareName = objItem.InstanceNameSelect Case WiFiDecibalsCase 0: WiFiHardwareName = "Ethernet": WiFiSignalStrength = 5Case Is > -57: WiFiSignalStrength = 5 ' -56 to 0Case Is > -68: WiFiSignalStrength = 4 '-67 to -57Case Is > -72: WiFiSignalStrength = 3 '-71 to -68Case Is > -80: WiFiSignalStrength = 2 '-79 to -72Case Is > -90: WiFiSignalStrength = 1 '-89 to -80Case Else: WiFiSignalStrength = 0End Select NextSet colItems = NothingRtnWiFiSignalStrength = WiFiSignalStrengthEnd Function'ConnectionPublic Function isConnected() As BooleanDim dwFlags As Long, RetVal As LongRetVal = InternetGetConnectedState(dwFlags, 0&)isConnected = RetVal = 1End Function' ===========================================================================' ==========================================================================='http://www.experts-exchange.com/questions/28350821/Getting-Wireless-Connection-Name-Through-VBA.htmlFunction GetNameOfActiveConnection(ByRef AllConnectionNamesCSV As String) As StringDim strComputer As StringDim objWMIService As ObjectDim colLAN As ObjectDim colWiFi As ObjectDim objWifi As ObjectDim objLAN As ObjectDim ConnectionName As StringConnectionName = ""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'NextFor Each objLAN In colLANIf objLAN.NetConnectionStatus = 2 ThenConnectionName = objLAN.NameAllConnectionNamesCSV = AllConnectionNamesCSV & ", " & ConnectionNameEnd IfNext'Set colWiFi = NothingSet colLAN = NothingSet objWMIService = Nothing' remove any leading commas in CSV string before returning PARM value...If AllConnectionNamesCSV <> "" Then If Left$(AllConnectionNamesCSV, 1) = "," ThenAllConnectionNamesCSV = Right$(AllConnectionNamesCSV, Len(AllConnectionNamesCSV) - 1)AllConnectionNamesCSV = Trim$(AllConnectionNamesCSV) End IfEnd If' neaten up...'dbugConnectionName = ""ConnectionName = Trim$(ConnectionName)GetNameOfActiveConnection = ConnectionNameEnd Function'===========================================================================' ===========================================================================Public Function GetDNSQualifiedComputerName(ByRef DomainName As String, ByRef hostname As String) As StringDim buffer As StringDim SIZE As LongDim network_and_computer As StringDim network_name As StringOn Error Resume Next' make 3 calls - rather than extract pieces out...SIZE = 255buffer = Space(SIZE)GetComputerNameEx ComputerNameDnsDomain, buffer, SIZEDomainName = Left$(buffer, SIZE) & ""DomainName = Trim$(DomainName)SIZE = 255buffer = Space(SIZE)GetComputerNameEx ComputerNameDnsHostname, buffer, SIZEhostname = Left$(buffer, SIZE) & ""hostname = Trim$(hostname)SIZE = 255buffer = 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 StringDim objWMIService As ObjectDim colItems As Object, objItem As ObjectDim metric As LongDim Description As StringDim strComputer As String' should pass in PARM???? ....On Error Resume NextstrComputer = "."Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")metric = 500Description = ""For Each objItem In colItemsIf (objItem.IPConnectionMetric < metric And objItem.IPConnectionMetric >= 0) Thenmetric = objItem.IPConnectionMetricDescription = objItem.DescriptionEnd IfNextSet colItems = NothingSet objWMIService = NothingGetInternetAdapterName = DescriptionEnd Function' ===========================================================================Dim AllWiFiConnectionNamesCSV As StringDim WiFiSignalStrength As LongPrivate Sub tmrDateTime_Timer()Dim DateTimeStr As StringDim WiFiConnectionName As StringDim AllWiFiConnectionNamesCSV As StringDim NetworkName As StringDim DomainName As String, hostname As StringDim InternetAdapterName As StringDim NetConnectionString As StringDim BattLifePerc As LongDim BattLifeTime As StringDim BattFullLifeTime As StringDim BattPowerLineSource As StringDim BattStatus As StringDim p As LongStatic TenCounter As Long' roll over from 1 to 10...If TenCounter > 10 Then TenCounter = 0If TenCounter < 0 Then TenCounter = 0TenCounter = TenCounter + 1 ' Do WiFi things...' this is every second...WiFiSignalStrength = RtnWiFiSignalStrength 'dbug... WiFiSignalStrength = RtnRndBetween(0, 6) If WiFiSignalStrength = 6 Then WiFiSignalStrength = 5Call DisplayWifiStrengthPic(WiFiSignalStrength)' every ten seconds, determine the provider...' this will also allow it to display on first time... If (TenCounter = 1) ThenAllWiFiConnectionNamesCSV = ""WiFiConnectionName = GetNameOfActiveConnection(AllWiFiConnectionNamesCSV)If WiFiConnectionName = "" Then' determine network name and domain...eg (computer.hostname.nz.ca)DomainName = ""hostname = ""NetworkName = GetDNSQualifiedComputerName(DomainName, hostname)WiFiConnectionName = DomainNamep = InStr(1, WiFiConnectionName, ".", vbBinaryCompare)If p <> 0 Then WiFiConnectionName = Left$(WiFiConnectionName, p - 1)End IfEnd If' debug...If WiFiConnectionName = "" Then WiFiConnectionName = "MTN" ' GetNameOfActiveConnection(AllWiFiConnectionNamesCSV)If AllWiFiConnectionNamesCSV <> "" Then ' do whatever necessary, if we have more than one provider...End IfWiFiConnectionName = 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 connectionNameInternetAdapterName = GetInternetAdapterName'Call DisplayWifiNamePic(InternetAdapterName)'''''''MsgBox InternetAdapterName' determine how we are connected (LAN, modem, proxy,etc)NetConnectionString = RtnNetConnectionString'MsgBox NetConnectionStringCall DisplayWifiConnectionTypePic(NetConnectionString) End If End SubPublic Function RtnDateTimeStrFormmated() As StringDim DateTimeStr As String DateTimeStr = Trim$(CStr(Now)) RtnDateTimeStrFormmated = Mid$(DateTimeStr, 12, 5) & " " & Right$(DateTimeStr, 2)End FunctionPublic Function RtnRndBetween(X As Long, Y As Long) As LongDim MyValue Randomize MyValue = Int((Y * Rnd) + X)' Generate random value between 1 and 6. RtnRndBetween = MyValueEnd Function
Download this snippet Add to My Saved Code
No comments have been posted about WiFi and LAN-Name, Signal Strength, etc. Why not be the first to post a comment about WiFi and LAN-Name, Signal Strength, etc.
0/1000 characters