vba - ACCESS VBA - 获取无线网络名称(已连接)

标签 vba ms-access module wifi detect

是否可以检测到他们通过 vba 连接到的用户 Wifi 网络(SSID)?在 Access 2010 中

非常感谢 最大

最佳答案

经过更多研究,我找到了以下链接:http://www.vbforums.com/showthread.php?547916-List-available-wireless-networks-(using-WMI)-Help-pls

如果您向下滚动到第 19 篇文章,这里有一个使用原生 Wifi API 的代码片段,我修改了以下代码片段,其中函数 GetConnectedSSID() 将返回当前连接的 Wifi 网络的 SSID:

Option Explicit

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
    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

Private Declare Function WlanOpenHandle Lib "wlanapi.dll" (ByVal dwClientVersion As Long, _
                ByVal pdwReserved As Long, _
                ByRef pdwNegotiaitedVersion As Long, _
                ByRef phClientHandle As Long) As Long

Private Declare Function WlanEnumInterfaces Lib "wlanapi.dll" (ByVal hClientHandle As Long, _
                ByVal pReserved As Long, _
                ppInterfaceList As Long) As Long

Private Declare 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

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                Source As Any, _
                ByVal Length As Long)

Private Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)

Public Function GetConectedSSID() As String
    Dim lngReturn As Long
    Dim lngHandle As Long
    Dim lngVersion As Long
    Dim lngList As Long
    Dim lngAvailable As Long
    Dim lngStart As Long
    Dim intCount As Integer
    Dim strSSID As String
    Dim strProfile As String
    Dim udtList As WLAN_INTERFACE_INFO_LIST
    Dim udtAvailableList As WLAN_AVAILABLE_NETWORK_LIST
    Dim udtNetwork As WLAN_AVAILABLE_NETWORK
    '
    ' Get a Handle
    '
    lngReturn = WlanOpenHandle(2&, 0&, lngVersion, lngHandle)
    If lngReturn = 0 Then
        '
        ' Enumerate the Interfaces
        ' (Note: this code only looks at the first interface)
        '
        lngReturn = WlanEnumInterfaces(ByVal lngHandle, 0&, lngList)
        CopyMemory udtList, ByVal lngList, Len(udtList)
        '
        ' Get the list of available Networks
        '
        lngReturn = WlanGetAvailableNetworkList(lngHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, lngAvailable)
        CopyMemory udtAvailableList, ByVal lngAvailable, LenB(udtAvailableList)
        intCount = 0
        lngStart = lngAvailable + 8
        Do
            '
            ' Populate the Available network structure
            '
            CopyMemory udtNetwork, ByVal lngStart, Len(udtNetwork)
            '
            ' Display the Data for this Network
            '
            strProfile = ByteToString(udtNetwork.strProfileName)
            strProfile = Left$(strProfile, InStr(strProfile, Chr(0)) - 1)
            strSSID = ByteToString(udtNetwork.dot11Ssid.ucSSID, udtNetwork.dot11Ssid.uSSIDLength, False)
            strSSID = Left(strSSID, InStr(strSSID, Chr(0)) - 1)
            If (udtNetwork.dwflags And WLAN_AVAILABLE_NETWORK_CONNECTED) = WLAN_AVAILABLE_NETWORK_CONNECTED Then
                'Debug.Print "Profile "; strProfile, "SSID "; strSSID, "Connected "; udtNetwork.dwflags
                GetConectedSSID = strSSID
            End If
            intCount = intCount + 1
            lngStart = lngStart + Len(udtNetwork)
            '
            ' Process all available networks
            '
        Loop Until intCount = udtAvailableList.dwNumberOfItems
        WlanFreeMemory lngAvailable
        WlanFreeMemory lngList
    End If
End Function

Private Function ByteToString(bytArray() As Byte, Optional lngLen As Long = 0, Optional boConvert As Boolean = True) As String
    Dim strTemp As String
    Dim intI As Integer
    Dim intEnd As Integer
    If lngLen = 0 Then
        intEnd = UBound(bytArray)
    Else
        intEnd = lngLen
    End If
    For intI = 0 To intEnd
        strTemp = strTemp & Chr(bytArray(intI))
    Next intI
    If boConvert = True Then strTemp = StrConv(strTemp, vbFromUnicode)
    ByteToString = strTemp
End Function

关于vba - ACCESS VBA - 获取无线网络名称(已连接),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/36297043/

相关文章:

php - prestashop 将值插入数据库显示意外的 T_STRING

python-docx 用 MySQL 数据生成文档

ms-access - 我可以隐藏 slider 的工具提示文本吗?

vba - 如何使用 VBA 在 Excel 注释中查找和替换日期格式

excel - 将宏动态插入到新的 Excel 工作簿中

database - 如何将记录同时插入到两个数据库表中?

sql - 将数据从 Excel 插入或更新到 Access

ms-access - 如何压缩MS Access数据库

javascript - 如何让sharejs与nodejs一起运行?

javascript - 从包访问 meteor 应用程序的导入目录?