Measure the strength of wireless access point

Posted on 2006-11-15
Last Modified: 2013-11-15
Hi Experts, I want to write a VB application that is going to run in the background (the machine will have a wireless adapter installed) to measure the relative strength between this machine with the access point (the value could in terms of 1 - weak to 5 - strong) with the corresponding timestamp when the reading is taken.

Could you advice me on the VB code that I could use to achieve the objective?

Question by:bpyeo
  • 4
LVL 29

Accepted Solution

nffvrxqgrcfqvvc earned 500 total points
ID: 18004401
' Start new project Add 1 module and 2 command buttons and 1 label to the form.
'Now you might get differnt values depending on your access point or wireless card driver

' --------- module1.bas ----------

Option Explicit

' Measure wireless signal strength
' -10 = 100%    max     signal
' -85 = 0%      low     signal
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Const max_signal As Long = -10  '(dBm) maximum signal you see when holding a laptop up to an access point
Private Const low_signal As Long = -85  '(dBm) low signal

Dim Status      As String
Dim Percent     As Long

Private Function WirelessSignalStrength() As Long
    Dim objServices     As Object
    Dim cInstance       As Object
    Dim oInstance       As Object
    Dim Signal          As Double       ' dee-bee milliwatts
    If objServices Is Nothing Then _
        Set objServices = GetObject("winmgmts:\\.\root\wmi")
    If cInstance Is Nothing Then _
        Set cInstance = objServices.ExecQuery( _
        "Select * From MSNdis_80211_ReceivedSignalStrength " & _
        "Where Active = True")
    For Each oInstance In cInstance
        Signal = oInstance.Ndis80211ReceivedSignalStrength
        WirelessSignalStrength = 100 - 80 * _
            (max_signal - Signal) / _
            (max_signal - low_signal)
End Function

Public Sub SignalLevel(ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

    Percent = WirelessSignalStrength
    Select Case Percent
        Case Is > 90
            Status = "Very Excellent"
        Case Is > 60
            Status = "Excellent"
        Case Is > 50
            Status = "Very Good"
        Case Is > 30
            Status = "Good"
        Case Is > 20
            Status = "Low"
        Case Is > 10
            Status = "Very Low"
    End Select
    Form1.Label1.Caption = Percent & " %   " & Status
End Sub

Public Sub MonitorWLAN_Start(hWnd As Long)
    SetTimer hWnd, 101, 1000, AddressOf SignalLevel
End Sub

Public Sub MonitorWLAN_Stop(hWnd As Long)
    KillTimer hWnd, 101
End Sub

' ------ Form1 -------

Option Explicit

Private Sub Command1_Click()

     MonitorWLAN_Start Me.hWnd

End Sub

Private Sub Command2_Click()
     MonitorWLAN_Stop Me.hWnd
End Sub
LVL 29

Expert Comment

ID: 18018080
If you don't want to use WMI scripting then you can use the API version and have the status raisevents from the class.
'Start a new ActiveX.DLL project, rename class1 to (cwstrength.cls) and add a standard module named (mdecls.bas) compile.

' ---- mdecls.bas ---- (module)

Option Explicit

Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByVal lpInBuffer As Long, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Sub push Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes As Long)
Public Declare Function CloseHandle Lib "kernel32" (ByVal hFile As Long) As Long

' ---- cwstrengh.cls ---- (class module)

' Reference:
    ' Tested adapter Broadcom 802.11bg wireless mini pci card
    ' You must lookup your own adapters service name _
    '   this can be found in the registry under the _
    '   following key.
    '   HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\
    ' The adapters service name looks similiar to the value _
        presented below. Pass the value to the wdevice_open() function.
    '   {91257929-11FC-4C99-B304-CA94D758E028}
Option Explicit

    ' Constants
    Private Const max_signal        As Long = -10
    Private Const bad_signal        As Long = -85
    Private Const oid_stat          As Long = &H170002
    Private Const oid_rssi          As Long = &HD010206
    ' Properties
    Public percent  As Long     ' strength percentage
    Public handle   As Long     ' device handle
    Public dBm      As Long     ' dBm
    ' Events
    Event nosignal()            '       -90(dBm)
    Event verylow()             '       -81(dBm)
    Event low()                 '       -71(dBm)
    Event good()                '       -67(dBm)
    Event verygood()            '       -57(dBm)
    Event excellent()           '       below -57
    Public Function wdevice_open(ByVal svcname As String) As Long
    '   If the function succeeds, _
    '       the return value is nonzero
    Dim devhandle As Long
    If handle <> 0 Then
        Exit Function
    End If
    devhandle = CreateFileW( _
        StrPtr("\\.\" & svcname), 0&, 0&, 0&, 4, 0&, 0&)
    If devhandle <> (-1) Then
        push handle&, devhandle&, 4
        wdevice_open = 1
        wdevice_open = 0
    End If
    devhandle = 0
    End Function
    Public Function wdevice_close(lnghandle As Long) As Long
    '   If the function succeeds, _
    '       the return value is nonzero
    wdevice_close = CloseHandle(lnghandle)
    handle = 0
    End Function
    Public Function wdevice_query(lnghandle As Long) As Long
    '   If the function succeeds, _
    '       the return value is nonzero
    Dim queryOID(3) As Byte
    Dim dwrBytes    As Long
    If DeviceIoControl( _
        lnghandle, _
        oid_stat, _
        ByVal VarPtr(oid_rssi), 4, _
        ByVal VarPtr(queryOID(0)), 4, _
        dwrBytes, 0&) Then
        push dBm&, queryOID(0), 4
        wdevice_query = 1
        wdevice_query = 0
    End If
    End Function

    Public Sub wdevice_status(lngdBm As Long)
    Dim tmpPercentage As Long
    Select Case lngdBm
        Case Is < -90
            RaiseEvent nosignal
        Case Is < -81
            RaiseEvent verylow
        Case Is < -71
            RaiseEvent low
        Case Is < -67
            RaiseEvent good
        Case Is < -57
            RaiseEvent verygood
        Case Else
            RaiseEvent excellent
    End Select
    tmpPercentage = 100 - 80 * _
            (max_signal - lngdBm) / _
            (max_signal - bad_signal)
    push percent&, tmpPercentage&, 4
    tmpPercentage = 0
    End Sub

' Start a new standard exe project, add the reference to the .dll you just compiled
' Add 1 label (Label1)
' Add 1 Timer (Timer1)
' Add the code below to form

Option Explicit

Dim WithEvents WirelessStrength As cWstrength

Private Sub Form_Load()

    Set WirelessStrength = New cWstrength
    ' TO DO:
    ' You must find and enter your wireless adapters service name.
    ' Locate the value in the registry and replace the value below.
    If WirelessStrength.wdevice_open("{91257929-11FC-4C99-B304-CA94D758E028}") Then
        Debug.Print "opened handle (OK)"
        Timer1.Enabled = True
        Timer1.Interval = 500
    End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If WirelessStrength.wdevice_close(WirelessStrength.Handle) Then
        Debug.Print "closed handle (OK)"
    End If
    Set WirelessStrength = Nothing
End Sub

Private Sub Timer1_Timer()
    If WirelessStrength.wdevice_query(WirelessStrength.Handle) Then
        Call WirelessStrength.wdevice_status(WirelessStrength.dBm)
        Label4.Caption = WirelessStrength.Percent & "%"
    End If
End Sub

Private Sub WirelessStrength_excellent()
    Label1.Caption = "Excellent"
End Sub

Private Sub WirelessStrength_good()
    Label1.Caption = "Good"
End Sub

Private Sub WirelessStrength_low()
    Label1.Caption = "Low"
End Sub

Private Sub WirelessStrength_nosignal()
    Label1.Caption = "No Signal"
End Sub

Private Sub WirelessStrength_verygood()
    Label1.Caption = "Very Good"
End Sub

Private Sub WirelessStrength_verylow()
    Label1.Caption = "Very Low"
End Sub
LVL 29

Expert Comment

ID: 18018089
The API version that i wrote is more accurate than the WMI. I would use the API version instead.

Author Comment

ID: 18018527
Hi egl1044, thanks very much for your kind effort. I have tried the WMI version and it is working perfectly. Thanks for the API version. Will try the API version and let you know my feedback.

Thanks :-)
LVL 29

Expert Comment

ID: 18058226
You like the API version better hows it holding up for you?

Featured Post

Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In our personal lives, we have well-designed consumer apps to delight us and make even the most complex transactions simple. Many enterprise applications, however, are a bit behind the times. For an enterprise app to be successful in today's tech wo…
Healthcare organizations in the United States must adhere to the guidance of both the HIPAA (Health Insurance Portability and Accountability Act) and HITECH (Health Information Technology for Economic and Clinical Health Act) for securing and protec…
The viewer will learn how to create multiple layers to apply various filters and how to delete areas from each layer’s filter.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question