使用“WlanScan”刷新 WiFi 网络列表

Question

我需要刷新 Window 的无线网络列表。我很乐意接受任何我可以直接或间接从 VBA自动化（cmdline、wmi 等）的解决方法。（我使用的是 Windows 7 Home 64 位和 Office 365 Pro 64 位。）我可以通过编程方式列出网络，包括netsh或下面的代码，但除非我物理单击任务栏通知区域上的网络连接图标，否则列表不会刷新该列表并不能自动更新每60秒为一些文档的状态。断开连接+重新连接 NIC不是可行/可持续的选择。我想我没有按要求从WlanOpenHandle获得句柄，而且我很擅长将 C 转换为 VBA。没有错误，但 WlanScan 返回未知代码1168。我在这里改编自 VB 版本：wlanscan (wlanapi)MSDN 文档：WlanScan 函数相关位：这是 的函数声明VB，已改编：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 UIntegerEnd Function...以及函数用法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;}...以及如何打开手柄，在C++（从这里）：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}“未隐藏：”获取（缓存）无线网络列表：列出网络的代码效果很好- 除了不自己刷新。（以前我正在解析 的文本输出netsh wlan show networks mode=bssid，它有同样的问题。）我之前删除了这个部分，因为它很长，而且除了刷新之外似乎工作正常。-)

Answer 1

我认为您不刷新的主要问题是您永远不会关闭打开的句柄。这可能会导致问题，因为不应该有多个打开的句柄 afaik。

您用于WlanOpenHandle获取接口的句柄，但在完成并获得所需信息后，您应该调用WlanCloseHandle以关闭该句柄和关联的连接。

Declare PtrSafe Function WlanCloseHandle Lib "Wlanapi.dll" ( _

  ByVal hClientHandle As LongPtr, _

  Optional ByVal pReserved As LongPtr) As Long

然后在你的函数结束时：

    WlanCloseHandle lngHandle 'Close handle

    GetWiFi = wifiOut   'Success! (function is populated with cached network list)

End Function

任何错误处理程序，如果要添加一个，应该测试句柄是否不为 0，如果不是，则关闭它。

我还更改了各种小东西，例如使用LongPtrfor 指针使您的代码与 64 位兼容（注意：它不兼容 VBA6，需要大量条件编译），重新编写声明以不使用可选参数，以及一些其他小事。

我在一个设备上用 10 次迭代测试了以下代码，得到了 10 个不同的结果：

代码：

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

类型和常量：

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

函数声明：

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)

测试调用以打印列表：

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

Answer 2

关于这些评论：

除非我实际单击“网络连接”图标，否则该列表不会刷新

和

当然有一种迂回的方法可以从 VBA 刷新网络列表？我很喜欢可以自动化的变通办法……什么？！

这是一种迂回的方式：以编程方式单击网络连接图标：

Sub ClickIt()

With CreateObject("WScript.Shell")

    .Run "%windir%\explorer.exe ms-availablenetworks:"

End With

End Sub

您“可以”在应用程序之后使用 mouse_event 关闭它。等待需要一些时间来刷新

Answer 3

这个项目之所以成为一项任务，是因为它看起来很简单，有好几次。我的第一次尝试捕获了的输出，netsh wlan show networks mode=bssid但我无法刷新列表。认为如果我切换到 API 方法 ( WlanScan+ WlanGetAvailableNetworkList)刷新会很容易，我从头开始，然后才意识到我仍然无法刷新数据。

发布此问题后，EvR 的回答最终/最终使我能够在 Windows 通知区域中打开/关闭网络连接列表，这会刷新缓存的文本，因此我第三次重写了该过程，重新使用netsh. 我终于得到了尝试 #3 的工作（如下），然后看到了 Erik 的答案，它实现了相同的结果……但“hacky”要少得多，速度快 25 倍。

所以，我显然会选择“最终尝试#4”，但我想无论如何我都会发布这个替代答案，因为其中一些概念很容易转移到其他问题上 黑客 需要修复。

Option Compare Binary

Option Explicit

Public Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hWnd _

    As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters _ 

    As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr

Public Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextA" _

    (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr

Public Declare Function GetForegroundWindow Lib "User32.dll" () As LongPtr

Type WiFis

    ssid As String      'wifi network name

    signal As Single    'wifi signal strength%

End Type

Private Function IsNetworksWindow(hWnd As Long, nCaption As String) As Boolean

'returns TRUE if the window caption (title) of window [hWnd]=[nCaption]

    Dim title As String * 255

    GetWindowText hWnd, title, 255                                  'get window caption

    IsNetworksWindow = (nCaption = Left$(title, Len(nCaption)))

End Function

Sub RefreshWifiList()

'open "available networks" window (to refresh cached network list)

    Const clsID = "shell:::{38A98528-6CBF-4CA9-8DC0-B1E1D10F7B1B}" 'clsid of req'd window

    Const nCaption = "View Available Networks"                     'title of req'd  window

    Dim retVal As LongPtr

    retVal = ShellExecute(0, "open", clsID, "", "", 0)             'open clsID

    If retVal < 33 Then Stop    'Error. Full list here: [http://oehive.org/node/528]

    Do

    DoEvents: Loop While Not IsNetworksWindow(GetForegroundWindow, nCaption) 'wait for refresh

    ThisWorkbook.Activate: AppActivate Application.Caption           'return to Excel

End Sub

Public Function getCmdLineOutput(cmd As String) As String

'run cmdline in hidden window and return string of output

    Dim tmpFile As String: tmpFile = Environ("temp") & "\cmd_out.tmp" 'create tmp file

    If Dir(tmpFile) <> "" Then Kill tmpFile                         'delete tmp file

    With CreateObject("WScript.Shell")                              'run cmdline command

        .Run "cmd /c """ & cmd & """ > " & tmpFile, 0, True         '0=Hide Window

    End With

    With CreateObject("Scripting.FileSystemObject")                 'open fso

        getCmdLineOutput = Trim(.opentextfile(tmpFile).ReadAll())   'read temp file

        .DeleteFile tmpFile                                         'delete temp file

    End With

End Function

Public Function GetWiFi() As WiFis()

'extract [ssid]'s & [signal]'s from list to populate array of networks

    Dim stNet As String, pStart As Long, pStop As Long: pStop = 1

    Dim ssid As String, signal As String, wiFi() As WiFis: ReDim wiFi(0 To 0)

    Application.ScreenUpdating = False

    RefreshWifiList                                                 'refresh wifi list

    stNet = getCmdLineOutput("netsh wlan show networks mode=bssid") 'get network list

    stNet = Mid$(stNet, InStr(stNet, "SSID"))                       'trim extraneous chars

    stNet = Replace(Replace(Replace(stNet, " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)

    Do While InStr(pStop, stNet, "SSID") > 0

        pStart = InStr(InStr(pStop, stNet, "SSID"), stNet, ":") + 1   'find ssid start

        pStop = InStr(pStart, stNet, "Networktype")                   'find ssid stop

        ssid = Mid$(stNet, pStart, pStop - pStart)                    'extract ssid

        pStart = InStr(pStop, stNet, "Signal:") + 7                   'find signal start

        pStop = InStr(pStart, stNet, "%")                             'find signal stop

        signal = CSng(Mid$(stNet, pStart, pStop - pStart)) / 100      'extract signal

        If signal = 0 Then Stop: If ssid = "" Then ssid = "(Unnamed)" 'validate

        ReDim Preserve wiFi(UBound(wiFi) + 1)                         'populate array

        wiFi(UBound(wiFi)).ssid = ssid: wiFi(UBound(wiFi)).signal = signal

    Loop

    GetWiFi = wiFi

End Function

Sub demo()

    Dim wiFi() As WiFis, netNum As Long

    wiFi() = GetWiFi()                                      'populate array of networks

    For netNum = 1 To UBound(wiFi)                          'loop through networks

        With wiFi(netNum)

            Debug.Print .ssid, Format(.signal, "0%")        'print ssid & signal

        End With

    Next netNum

End Sub

Sub timeTest_listNetworks()

    Dim wiFi() As WiFis, netNum As Long, n As Long

    Dim startTime As Single, allTime As Single: allTime = Timer

    For n = 1 To 5                      'repeat test 5x

        Erase wiFi()                    'clear array

        startTime = Timer

        wiFi() = GetWiFi()              'refresh array of networks

        For netNum = 1 To UBound(wiFi)  'loop through networks

            Debug.Print wiFi(netNum).ssid & "=" & Format(wiFi(netNum).signal, "0%") & " ";

        Next netNum

        Debug.Print "(" & Round(Timer - startTime, 1) & " sec)"

    Next n

    Debug.Print "Total: " & Round(Timer - allTime, 1) & " sec"

End Sub