Refresh WiFi network list with 'WlanScan' (convert api syntax from c# to vba… or a workaround?)

  • A+
Category:Languages

I need to refresh Window's list of wireless networks.

I'll gladly accept any workaround that I can automate (cmdline, wmi, etc) directly or indirectly from VBA. (I'm using Windows 7 Home 64-bit with Office 365 Pro 64-bit.)

I can list the networks programmatically a couple ways including netsh, or the code below, but the list does not refresh unless I physically click the Refresh WiFi network list with 'WlanScan' (convert api syntax from c# to vba… or a workaround?) Network Connection icon on the taskbar's Notification area.

  • The list does not auto-update every 60 seconds as some docs state.
  • Disconnect+Reconnecting the NIC is not a feasible/sustainable option.

I think I'm not getting the handle from WlanOpenHandle as required and I'm green at converting C to VBA.

No errors but WlanScan returns unknown code 1168.


Related bits:

Here's the function declaration for VB, adapted:

Public Shared Function WlanScan(ByVal hClientHandle As IntPtr, _    ByRef pInterfaceGuid As Guid, ByVal pDot11Ssid As IntPtr, _    ByVal pIeData As IntPtr, ByVal pReserved As IntPtr) As UInteger End Function 

...and an example of function usage in C#:

Guid g; //wlanHndl is the handle returned previously by calling [WlanOpenHandle] for (int i = 0; i < infoList.dwNumberOfItems; i++) { g = infoList.InterfaceInfo[i].InterfaceGuid; uint resultCode=WlanScan(wlanHndl, ref g, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero); if (resultCode != 0)     return; } 

...and how to open the handle, in C++ (from here):

dwResult = WlanOpenHandle(dwMaxClient, NULL, &dwCurVersion, &hClient); if (dwResult != ERROR_SUCCESS) {     wprintf(L"WlanOpenHandle failed with error: %u/n", dwResult);     return 1;     // You can use FormatMessage here to find out why the function failed } 

"Un-hidden:"

Obtain (cached) list of wireless networks:

The code to list the networks works great - except for not refreshing on it's own. (Previously I was parsing the text output of netsh wlan show networks mode=bssid, which had the same issue.)

I had previously removed this section because its lengthy and seems to work fine except for the refresh. -)

Option Explicit  'section's source: vbforums.com/showthread.php?632731 Private Const DOT11_SSID_MAX_LENGTH As Long = 32 Private Const WLAN_MAX_PHY_TYPE_NUMBER As Long = 8 Private Const WLAN_AVAILABLE_NETWORK_CONNECTED As Long = 1 Private Const WLAN_AVAILABLE_NETWORK_HAS_PROFILE As Long = 2  Private Type GUID  'from cpearson.com     Data1 As Long: Data2 As Integer:  Data3 As Integer:  Data4(7) As Byte End Type  Private Type WLAN_INTERFACE_INFO     ifGuid As GUID: InterfaceDescription(255) As Byte: IsState As Long End Type  Private Type DOT11_SSID     uSSIDLength As Long:            ucSSID(DOT11_SSID_MAX_LENGTH - 1) As Byte End Type  Private Type WLAN_AVAILABLE_NETWORK     strProfileName(511) As Byte:    dot11Ssid As DOT11_SSID     dot11BssType As Long:           uNumberOfBssids As Long     bNetworkConnectable As Long:    wlanNotConnectableReason As Long     uNumberOfPhyTypes As Long:      dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1) As Long     bMorePhyTypes As Long:          wlanSignalQuality As Long     bSEcurityEnabled As Long:       dot11DefaultAuthAlgorithm As Long     dot11DefaultCipherAlgorithm As Long: dwflags As Long: dwReserved As Long End Type  Private Type WLAN_INTERFACE_INFO_LIST     dwNumberOfItems As Long: dwIndex As Long: InterfaceInfo As WLAN_INTERFACE_INFO End Type  Private Type WLAN_AVAILABLE_NETWORK_LIST     dwNumberOfItems As Long:  dwIndex As Long: Network As WLAN_AVAILABLE_NETWORK End Type  Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll" (ByVal dwClientVersion As Long, _                 ByVal pdwReserved As Long, ByRef pdwNegotiaitedVersion As Long, _                 ByRef phClientHandle As Long) As Long  Declare PtrSafe Function WlanEnumInterfaces Lib "Wlanapi.dll" (ByVal hClientHandle As Long, _                 ByVal pReserved As Long, ppInterfaceList As Long) As Long  Declare PtrSafe Function WlanGetAvailableNetworkList Lib "Wlanapi.dll" ( _                 ByVal hClientHandle As Long, pInterfaceGuid As GUID, ByVal dwflags As Long, _                 ByVal pReserved As Long, ppAvailableNetworkList As Long) As Long  Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _                 Source As Any, ByVal Length As Long)  Declare PtrSafe Sub WlanFreeMemory Lib "Wlanapi.dll" (ByVal pMemory As Long)  Type WiFis   ssid As String: signal As Single End Type  Public Function GetWiFi() As WiFis() 'returns an array of custom type WiFis (1st interface only)      Dim udtList As WLAN_INTERFACE_INFO_LIST, udtAvailList As WLAN_AVAILABLE_NETWORK_LIST, udtNetwork As WLAN_AVAILABLE_NETWORK     Dim lngReturn As Long, lngHandle As Long, lngVersion As Long, lngList As Long, lngAvailable As Long     Dim lngStart As Long, intCount As Integer, ssid As String, signal As Single, wifiOut() As WiFis     n = 0      lngReturn = WlanOpenHandle(2&, 0&, lngVersion, lngHandle) 'get handle     If lngReturn <> 0 Then         Debug.Print "Couldn't get wlan handle (Code " & lngReturn & ")"         Exit Function     End If      lngReturn = WlanEnumInterfaces(ByVal lngHandle, 0&, lngList) 'enumerate <*first interface only*>     CopyMemory udtList, ByVal lngList, Len(udtList)     lngReturn = WlanGetAvailableNetworkList(lngHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, lngAvailable) 'get network list     CopyMemory udtAvailList, ByVal lngAvailable, LenB(udtAvailList)     intCount = 0     lngStart = lngAvailable + 8      Do         CopyMemory udtNetwork, ByVal lngStart, Len(udtNetwork) ' Populate avail. network structure         ssid = Replace(StrConv(udtNetwork.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")         If Len(ssid) < 4 Then ssid = "(Unnamed)"         signal = CSng(udtNetwork.wlanSignalQuality) / 100         '[Signal] = 0 to 100 which represents the signal strength (100 Signal)=(-100dBm RSSI), (100 Signal)=(-50dBm RSSI)          If udtNetwork.dwflags = 0 Then             n = n + 1             ReDim Preserve wifiOut(n)             wifiOut(n).ssid = ssid             wifiOut(n).signal = signal         Else             'skipping networks with [dwflags] > 0             'I *think* that's what I'm supposed to do             'Returns 3 for currently connected network, 2 for networks that have profiles         End If          intCount = intCount + 1         lngStart = lngStart + Len(udtNetwork)     Loop Until intCount = udtAvailList.dwNumberOfItems     WlanFreeMemory lngAvailable     'clean up memory     WlanFreeMemory lngList      GetWiFi = wifiOut   'Success! (function is populated with cached network list)  End Function 

...and the problem:

Refresh network list using WlanScan?

This does not generate a VBA error, but does return code 1168 (which I can't identify)/ (Source)

'Added blindly:'wlanui type library (wlanui.dll) and "wlan pref iua" (wlanconn.dll)  Public Type DOT11_SSID     uSSIDLength As LongPtr: ucSSID As String End Type  Private Type GUID 'from cpearson.com/excel/CreateGUID.aspx     Data1 As LongPtr: Data2 As Integer     Data3 As Integer: Data4(0 To 7) As Byte End Type  #If Win64 Then 'also new to Office-64bit, but seems okay     Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _         (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _         ByVal pDot11Ssid As LongPtr, ByVal pIeData As LongPtr, _         ByVal pReserved As LongPtr) As LongPtr #Else     Private Declare WlanScan Lib "Wlanapi.dll" _         (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _         ByVal pDot11Ssid As LongPtr, ByVal pIeData As LongPtr, _         ByVal pReserved As LongPtr) As LongPtr #End If  Sub test_RefreshNetworkList()     Dim hresult As LongPtr, phClientHandle As Long, pdwNegotiatedVersion As Long     Dim retVal As Longptr, g As GUID     hresult = WlanOpenHandle(2&, 0&, pdwNegotiatedVersion, phClientHandle)     retVal = WlanScan(phClientHandle, g, 0, 0, 0)     Select Case retVal         Case 87: Debug.Print "ERROR_INVALID_PARAMETER"         Case 6: Debug.Print "ERROR_INVALID_HANDLE"         Case 8: Debug.Print "ERROR_NOT_ENOUGH_MEMORY"         Case Else: Debug.Print "RPC_STATUS : " & retVal  ' "misc errors"     End Select End Sub 

Surely there's a roundabout way to refresh the network list from VBA? I'm cool with workarounds that I can automate... anything?!

Refresh WiFi network list with 'WlanScan' (convert api syntax from c# to vba… or a workaround?) Thanks!


Edit:

I changed Long to LongPtr in the applicable (I think) spots. Same error.

Here's the WlanOpenHandle and WlanScan definitions.

Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll"      (ByVal dwClientVersion As LongPtr, _      ByVal pdwReserved As LongPtr,       ByRef pdwNegotiaitedVersion As LongPtr, _      ByRef phClientHandle As LongPtr           ) As LongPtr 

(...it was also my first attempt time using compiler constants.)

#If Win64 Then     Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _         (ByVal hClientHandle As LongPtr,          ByRef pInterfaceGuid As GUID, _          ByVal pDot11Ssid As LongPtr,           ByVal pIeData As LongPtr, _          ByVal pReserved As LongPtr) As LongPtr #Else     Private Declare WlanScan Lib "Wlanapi.dll" _         (ByVal hClientHandle As LongPtr,           ByRef pInterfaceGuid As GUID, _          ByVal pDot11Ssid As LongPtr,           ByVal pIeData As LongPtr, _          ByVal pReserved As LongPtr     ) As LongPtr #End If 

 


I think your main problem with not refreshing is that you're never closing your open handles. This can cause problems, as there shouldn't be multiple open handles afaik.

You use WlanOpenHandle to gain a handle to the interface, but after you're done with it and have the information you need, you should call WlanCloseHandle to close that handle and the associated connection.

Declare PtrSafe Function WlanCloseHandle Lib "Wlanapi.dll" ( _   ByVal hClientHandle As LongPtr, _   Optional ByVal pReserved As LongPtr) As Long 

And at then end of your function:

    WlanCloseHandle lngHandle 'Close handle     GetWiFi = wifiOut   'Success! (function is populated with cached network list) End Function 

Any error handler, if you're going to add one, should test if the handle isn't 0, and if it isn't, close it.

I've also changed various little things, such as using LongPtr for pointers to make your code 64-bit compatible (note: it's not VBA6 compatible, that requires a lot of conditional compilations), reworking your declarations to not use optional parameters, and some other little things.

I've tested the following code with 10 iterations on a device and got 10 different results:

Code:

Public Function GetWiFi() As wifis() 'returns an array of custom type WiFis (1st interface only)      Dim udtList As WLAN_INTERFACE_INFO_LIST, udtAvailList As WLAN_AVAILABLE_NETWORK_LIST, udtNetwork As WLAN_AVAILABLE_NETWORK     Dim lngReturn As Long, pHandle As LongPtr, lngVersion As Long, pList As LongPtr, pAvailable As LongPtr     Dim pStart As LongPtr, intCount As Integer, ssid As String, signal As Single, wifiOut() As wifis     Dim n As Long     n = 0      lngReturn = WlanOpenHandle(2&, 0&, lngVersion, pHandle) 'get handle     If lngReturn <> 0 Then         Debug.Print "Couldn't get wlan handle (Code " & lngReturn & ")"         Exit Function     End If      lngReturn = WlanEnumInterfaces(ByVal pHandle, 0&, pList) 'enumerate <*first interface only*>     CopyMemory udtList, ByVal pList, Len(udtList)     lngReturn = WlanScan(pHandle, udtList.InterfaceInfo.ifGuid)     lngReturn = WlanGetAvailableNetworkList(pHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, pAvailable) 'get network list     CopyMemory udtAvailList, ByVal pAvailable, LenB(udtAvailList)     intCount = 0     pStart = pAvailable + 8      Do         CopyMemory udtNetwork, ByVal pStart, Len(udtNetwork) ' Populate avail. network structure         ssid = Replace(StrConv(udtNetwork.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")         If Len(ssid) < 4 Then ssid = "(Unnamed)"         signal = CSng(udtNetwork.wlanSignalQuality) / 100         '[Signal] = 0 to 100 which represents the signal strength (100 Signal)=(-100dBm RSSI), (100 Signal)=(-50dBm RSSI)          If udtNetwork.dwflags = 0 Then             n = n + 1             ReDim Preserve wifiOut(n)             wifiOut(n).ssid = ssid             wifiOut(n).signal = signal         Else             'skipping networks with [dwflags] > 0             'I *think* that's what I'm supposed to do             'Returns 3 for currently connected network, 2 for networks that have profiles         End If          intCount = intCount + 1         pStart = pStart + Len(udtNetwork)     Loop Until intCount = udtAvailList.dwNumberOfItems     WlanFreeMemory pAvailable     'clean up memory     WlanFreeMemory pList     WlanCloseHandle pHandle 'Close handle     GetWiFi = wifiOut   'Success! (function is populated with cached network list) End Function 

Types and constants:

Private Const DOT11_SSID_MAX_LENGTH As Long = 32 Private Const WLAN_MAX_PHY_TYPE_NUMBER As Long = 8 Private Const WLAN_AVAILABLE_NETWORK_CONNECTED As Long = 1 Private Const WLAN_AVAILABLE_NETWORK_HAS_PROFILE As Long = 2  Public Type GUID     Data(15) As Byte End Type  Private Type WLAN_INTERFACE_INFO     ifGuid As GUID: InterfaceDescription(255) As Byte: IsState As Long End Type  Private Type DOT11_SSID     uSSIDLength As Long:            ucSSID(DOT11_SSID_MAX_LENGTH - 1) As Byte End Type  Private Type WLAN_AVAILABLE_NETWORK     strProfileName(511) As Byte:    dot11Ssid As DOT11_SSID     dot11BssType As Long:           uNumberOfBssids As Long     bNetworkConnectable As Long:    wlanNotConnectableReason As Long     uNumberOfPhyTypes As Long:      dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1) As Long     bMorePhyTypes As Long:          wlanSignalQuality As Long     bSEcurityEnabled As Long:       dot11DefaultAuthAlgorithm As Long     dot11DefaultCipherAlgorithm As Long: dwflags As Long: dwReserved As Long End Type  Private Type WLAN_INTERFACE_INFO_LIST     dwNumberOfItems As Long: dwIndex As Long: InterfaceInfo As WLAN_INTERFACE_INFO End Type  Private Type WLAN_AVAILABLE_NETWORK_LIST     dwNumberOfItems As Long:  dwIndex As Long: Network As WLAN_AVAILABLE_NETWORK End Type  Public Type WiFis   ssid As String: signal As Single End Type 

Function declarations:

Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll" (ByVal dwClientVersion As Long, _                 ByVal pdwReserved As LongPtr, ByRef pdwNegotiaitedVersion As Long, _                 ByRef phClientHandle As LongPtr) As Long  Declare PtrSafe Function WlanEnumInterfaces Lib "Wlanapi.dll" (ByVal hClientHandle As LongPtr, _                 ByVal pReserved As LongPtr, ByRef ppInterfaceList As LongPtr) As Long  Declare PtrSafe Function WlanGetAvailableNetworkList Lib "Wlanapi.dll" ( _                 ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, ByVal dwflags As Long, _                 ByVal pReserved As LongPtr, ByRef ppAvailableNetworkList As LongPtr) As Long   Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _                 Source As Any, ByVal Length As Long)  Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _         (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _         Optional ByVal pDot11Ssid As LongPtr, Optional ByVal pIeData As LongPtr, _         Optional ByVal pReserved As LongPtr) As Long  Declare PtrSafe Function WlanCloseHandle Lib "Wlanapi.dll" ( _   ByVal hClientHandle As LongPtr, _   Optional ByVal pReserved As LongPtr) As Long   Declare PtrSafe Sub WlanFreeMemory Lib "Wlanapi.dll" (ByVal pMemory As LongPtr) 

Test call to print the list:

Public Sub PrintWifis()     Dim aWifis() As wifis     aWifis = GetWiFi     Dim l As Long     For l = LBound(aWifis) To UBound(aWifis)         Debug.Print aWifis(l).ssid; aWifis(l).signal     Next End Sub 

Comment

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: