Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Measure the strength of wireless access point

Posted on 2006-11-15
Medium Priority
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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
LVL 29

Accepted Solution

nffvrxqgrcfqvvc earned 2000 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

One-stop solution for Exchange Administrators to address all MS Exchange Server issues, which is known by the name of Stellar Exchange Toolkit.
The core idea of this article is to make you acquainted with the best way in which you can export Exchange mailbox to PST format.
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Suggested Courses

618 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