简体   繁体   English

使用'WlanScan'刷新WiFi网络列表(将api语法从c#转换为vba ...或解决方法?)

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

I need to refresh Window's list of wireless networks. 我需要刷新Window的无线网络列表。

I'll gladly accept any workaround that I can automate (cmdline, wmi, etc) directly or indirectly from VBA. 我很乐意接受任何可以直接或间接从VBA自动化(cmdline,wmi等)的解决方法。 (I'm using Windows 7 Home 64-bit with Office 365 Pro 64-bit.) (我正在使用Windows 7 Home 64位与Office 365 Pro 64位。)

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 我可以通过编程方式列出网络,包括netsh或下面的代码,但列表不会刷新,除非我实际点击 净 Network Connection icon on the taskbar's Notification area. 任务栏的通知区域中的“网络连接”图标。

  • The list does not auto-update every 60 seconds as some docs state. 列表自动更新每60秒为一些文档的状态。
  • Disconnect+Reconnecting the NIC is not a feasible/sustainable option. 断开连接+重新连接NIC 不是一个可行/可持续的选择。

I think I'm not getting the handle from WlanOpenHandle as required and I'm green at converting C to VBA. 我想我没有按照要求从WlanOpenHandle 获得句柄 ,而且我很擅长将C转换为VBA。

No errors but WlanScan returns unknown code 1168 . 没有错误,但WlanScan返回未知代码1168


Related bits: 相关位:

Here's the function declaration for VB , adapted: 这是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 UInteger
End Function

...and an example of function usage in C# : ...以及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 ): ...以及如何在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
}

"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.) (之前我正在解析netsh wlan show networks mode=bssid的文本输出,它有同样的问题。)

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 ? 使用WlanScan刷新网络列表?

This does not generate a VBA error, but does return code 1168 (which I can't identify)/ ( Source ) 不会产生VBA错误,但不会返回代码1168 (我不能确定)/( 来源

'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? 当然有一种迂回的方式来刷新VBA的网络列表? I'm cool with workarounds that I can automate... anything?! 我的解决方法很酷,我可以自动化......什么?!

爪子 Thanks! 谢谢!


Edit: 编辑:

I changed Long to LongPtr in the applicable (I think) spots. 我在适用的(我认为)点改变了LongLongPtr Same error. 同样的错误。

Here's the WlanOpenHandle and WlanScan definitions. 这是WlanOpenHandleWlanScan定义。

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. 您使用WlanOpenHandle获取接口的句柄,但在完成它并获得所需信息后,您应该调用WlanCloseHandle来关闭该句柄和关联的连接。

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. 任何错误处理程序,如果你要添加一个,应测试句柄是否为0,如果不是,则关闭它。

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. 我还改变了各种小东西,例如使用LongPtr指针使代码与64位兼容(注意:它兼容VBA6,需要大量条件编译),重新编写声明以不使用可选参数,以及其他一些小事。

I've tested the following code with 10 iterations on a device and got 10 different results: 我在一台设备上测试了以下代码并进行了10次迭代,得到了10个不同的结果:

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

Regarding these comments: 关于这些评论:

the list does not refresh unless I physically click the Network Connection icon 除非我实际单击“网络连接”图标,否则列表不会刷新

and

Surely there's a roundabout way to refresh the network list from VBA? 当然有一种迂回的方式来刷新VBA的网络列表? I'm cool with workarounds that I can automate... anything?! 我的解决方法很酷,我可以自动化......什么?!

Here's a roundabout way: programmatically click the Network Connection Icon: 这是一种迂回的方式:以编程方式单击网络连接图标:

Sub ClickIt()
With CreateObject("WScript.Shell")
    .Run "%windir%\explorer.exe ms-availablenetworks:"
End With
End Sub

You 'could' close it with a mouse_event after an application.wait when it takes some time to refresh 你可以在应用程序之后用mouse_event关闭它。等待刷新需要一些时间

This project became a mission because it seemed straightforward, several times. 这个项目成了一个使命,因为它似乎很简单,好几次。 My first attempt captured the output of netsh wlan show networks mode=bssid but I couldn't get the list to refresh . 我的第一次尝试捕获了netsh wlan show networks mode=bssid的输出,但我无法让列表刷新 Thinking the refresh would be easy if I changed over to the API method ( WlanScan + WlanGetAvailableNetworkList ), I started from scratch before realizing I still couldn't refresh the data. 如果我转换到API方法( WlanScan + WlanGetAvailableNetworkList ),认为刷新会很容易,我从头开始,然后才意识到我仍然无法刷新数据。

After posting this question, EvR's answer eventually/finally led me to the ability to open/close the Network Connections list in the Windows notification area, which refreshed the cached text, so I re-wrote the process a third time, back to using netsh . 在发布这个问题后,EvR的回答最终/最终使我能够打开/关闭Windows通知区域中的网络连接列表,刷新了缓存的文本,所以我重新编写了第三次进程,回到使用netsh I finally got attempt #3 working (below), and then saw Erik's answer which accomplishes the same result... but considerably less "hacky", and 25× faster. 我终于尝试了#3工作(下面),然后看到Erik的答案完成了相同的结果......但是相当少“hacky”,并且快了25倍。

So, I will obviously go with "final attempt #4", but figured I'd post this alternate answer anyhow, as some of the concepts are easily transferable to other problems where a quick 所以,我显然会选择“最后的尝试#4”,但我认为无论如何我会发布这个替代答案,因为有些概念很容易转移到其他快速的问题 hack fix is needed. 修复是必要的。

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

More Information: 更多信息:

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM