AnsweredAssumed Answered

VB.NET software to discover LAN / IP address of any VISA instruments

Question asked by vga on Oct 16, 2014
Dear All,

I found many answers to my questions on forums. I thought that this time it would be my turn to help you out. 

This piece of code was developed  to detect any VISA instrument connected to the computer. This way end-users don’t have to go inside Agilent Connection Expert to register their instruments. The program obviously scan for serial, USB and other already registered instrument but also network (LAN IP address). This is a part of code that I was not able to find on internet nor on agilent documentation. The function  QueryANetworkAddress is the most interesting as it will broadcast a special packet to the whole network and any instrument replying will be tested for VISA capability. If it is VISA capable it will be presented to the end-user. 

This program was originally made for 34972a but it works with 34970 or any other VISA instruments. 

I hope that this will help some of you. 

Regards,
Vincent


------------------


Imports System.Net.NetworkInformation
Imports System.Net.Sockets
Imports System.Net


Public Class DiscoverInstruments

    Dim ValidVisaAddress As Dictionary(Of String, String)

    Private Sub BtnSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSearch.Click
        Dim Mgr As New AgilentRMLib.SRMCls
        Dim OpenDAQ As New VisaComLib.FormattedIO488
        Dim AllRessources As Object

        Me.Enabled = False
        ValidVisaAddress = New Dictionary(Of String, String)
        TxtOutput.Text = ""



        ' -- Browse the ressources already registered ....
        Try
            AllRessources = Mgr.FindRsrc("?*INSTR")

            For Each VisaAddress As String In AllRessources
                AddToValidAddress(VisaAddress)
            Next

        Catch
        End Try





        ' -- Scan the COM port in case the instrument was not registered yet .

        For Each sp As String In My.Computer.Ports.SerialPortNames
            AddToValidAddress(sp.Replace("COM", "ASRL"))
        Next




        ' -- Scan a well known USB address in case the instrument was not registered yet .

        AddToValidAddress("UsbInstrument1")





        ' -- Scan the LAN in case the instrument was not registered yet .
        ' Broadcasting special packet to 255.255.255.255

        QueryANetworkAddress(IPAddress.Broadcast)




        ' ATTENTION : Broadcasting with range 255.255.255.255 make the broadcast send ONLY on the default interface therefore missing all others interface.
        ' The next code broadcast x.x.x.255 depending on the IP of each interface. Therefore sending it to every interface.


        Dim ipE As IPHostEntry = Dns.GetHostEntry(Dns.GetHostName())   ' Get All interface

        For Each Ip As IPAddress In ipE.AddressList                                 ' Browse all interface .. 
            If Ip.AddressFamily = AddressFamily.InterNetwork Then      ' ... in IPv4 only (Not IPv6)
                QueryANetworkAddress(GetBroadcastAddress(Ip.ToString)) ' send to x.x.x.255 
            End If
        Next

        LblFound.Text = ValidVisaAddress.Count & " instrument(s) found."

        If ValidVisaAddress.Count <> 0 Then
            CbAvailableAgilent.DataSource = New BindingSource(ValidVisaAddress, "")
            CbAvailableAgilent.DisplayMember = "Key"
            CbAvailableAgilent.ValueMember = "Value"
        End If


        Me.Enabled = True

    End Sub

    Sub AddToValidAddress(ByVal VisaAddress As String)
        Dim Mgr As New AgilentRMLib.SRMCls
        Dim OpenDAQ As New VisaComLib.FormattedIO488
        Dim StrIDN As String

        StrIDN = ""

        TxtOutput.AppendText(vbNewLine & "Searching device on " & VisaAddress & " ...")

        Application.DoEvents()

        Try
            OpenDAQ.IO = Mgr.Open(VisaAddress)
            OpenDAQ.IO.Timeout = 2000
            OpenDAQ.WriteString("*IDN?")
            StrIDN = OpenDAQ.ReadString
            If StrIDN <> "" And StrIDN.Trim <> "*IDN?" Then
                If Not ValidVisaAddress.ContainsKey(StrIDN) Then  ' avoid duplicate detection
                    ValidVisaAddress.Add(StrIDN, VisaAddress)
                    TxtOutput.AppendText("Found : " & StrIDN)
                Else
                    TxtOutput.AppendText("Already existing.")
                End If

                Application.DoEvents()
            End If
        Catch ex As Exception
            TxtOutput.Text += " Failed : " & ex.Message
            TxtOutput.AppendText(" Failed : " & ex.Message)
            Application.DoEvents()
            Exit Sub
        End Try

    End Sub

    Function GetBroadcastAddress(ByVal Address As String) As IPAddress
        ' convert a ip address to broadcast 
        ' 192.168.0.1  becomes 192.168.0.255


        Address = Address.Remove(Address.LastIndexOf(".")) & ".255"
        GetBroadcastAddress = IPAddress.Parse(Address)

    End Function

    Sub QueryANetworkAddress(ByVal Ip As IPAddress)

        ' Discover LAN VISA equipment (Credit : Vincent Ganzitti)
        ' --------------------------------------------------------
        ' Methode :  Broadcast a special packet through UDP on port 111, any responding IP address will be checked for VISA capability. 
        ' Ip Address : can be any address but it is much more efficiency if it is a broadcast adress type eg : 255.255.255.255 or 192.168.0.255).
        '
        ' Packet :
        ' Hex values for Remote Procedure Call XID :0x53db50ee - Portman V2 Program (100000) procedure GETPORT
        ' 53db50ee0000000000000002000186a00000000200000003000000000000000000000000000000000
        ' Hex values for Portmap GETPROT Call VXI-11 Core(395183) With Data of 4 bytes (00 00 00 00)
        ' 00607af00000001000000060000000400000000

        ' All Hex values converted to Byte gives the specialy crafted packet hereafter. 

        Dim Packet() As Byte = {83, 219, 80, 238, 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 134, 160, 0, 0, 0, 2, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 7, 175, 0, 0, 0, 1, 0, 0, 0, 6, 0, 0, 0, 4, 0, 0, 0, 0}


        TxtOutput.AppendText(vbNewLine & "Searching device on LAN " & Ip.ToString & " ...")

        Application.DoEvents()

        Try
            ' Sending packet 
            Dim UdpSender As New UdpClient()
            Dim UdpSenderEndpoint As New IPEndPoint(Ip, 111)
            UdpSender.EnableBroadcast = True
            UdpSender.Send(Packet, Packet.Length, UdpSenderEndpoint)

            Do

                ' Waiting for reply from any IP.
                Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 111)
                UdpSender.Client.ReceiveTimeout = 2000
                Dim receiveBytes As [Byte]()

                receiveBytes = UdpSender.Receive(RemoteIpEndPoint)

                AddToValidAddress("TCPIP::" & RemoteIpEndPoint.Address.ToString())  ' this line will not be executed if 

            Loop While True   ' The infinite loop is to capture severval response .. the try catch will end it after 2sec due to timeout.


        Catch ex As Exception
            TxtOutput.AppendText(" Failed : " & ex.Message)
            Application.DoEvents()
        End Try
    End Sub


    Private Sub BtnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOk.Click
        MsgBox("Selected Visa address is : " & CbAvailableAgilent.SelectedItem.Value())
        Me.Close()
    End Sub
End Class  

Attachments

Outcomes