Visual Basic Network Services

GetNetworkParams: Determine Current and Available DNS Servers
Posted:   Sunday March 05, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows 2000
OS restrictions:   Windows 98, Windows ME, Windows 2000, Windows XP, Windows 2003
Author:   VBnet - Randy Birch


GetAdaptersInfo: Determine if DHCP is Enabled
GetAdaptersInfo: Get the DHCP Server IP
GetAdaptersInfo: Get the IPs for all DHCP Servers
GetAdaptersInfo: Get the Network Adapter IP Address
GetAdaptersInfo: Get IP Addresses for All Installed Network Adapters

GetNetworkParams: Determine Current and Available DNS Servers
One of the operating systems listed under OS Restrictions above.

The GetNetworkParams API returns a FIXED_INFO structure containing, among other things, the current DNS server as well as an array of available DNS servers.

 BAS Module Code

 Form Code
To a form add a command button (Command1), and two Labels (Label1, Label2). Add the following code to the form:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Const MAX_HOSTNAME_LEN = 128
Private Const MAX_DOMAIN_NAME_LEN = 128
Private Const MAX_SCOPE_ID_LEN = 256
Private Const ERROR_SUCCESS As Long = 0

   IpAddr(0 To 15)     As Byte
End Type

   IpMask(0 To 15)     As Byte
End Type

   dwNext               As Long
   IpAddress(0 To 15)   As Byte
   IpMask(0 To 15)      As Byte
   dwContext            As Long
End Type

Private Type FIXED_INFO
   HostName(0 To (MAX_HOSTNAME_LEN + 3))      As Byte
   DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
   CurrentDnsServer   As Long
   DnsServerList      As IP_ADDR_STRING
   NodeType           As Long
   ScopeId(0 To (MAX_SCOPE_ID_LEN + 3))       As Byte
   EnableRouting      As Long
   EnableProxy        As Long
   EnableDns          As Long
End Type

Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
  (pFixedInfo As Any, _
   pOutBufLen As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" _
  (ByVal RetVal As String, ByVal ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _
  (ByVal ptr As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" _
   (ByVal addr As Long) As Long

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

Private Sub Form_Load()

   Command1.Caption = "Get DNS Servers"
End Sub

Private Sub Command1_Click()

   Dim cnt As Long
   Dim success As Long
   Dim currserver As String
   Dim dnsservers() As String
  'pass an empty string and string array
  'to the function. Return value is the
  'number of DNS servers found
   success = GetDNSServers(currserver, dnsservers())
  'show the current DNS server found
   Label1.Caption = "Current DNS Server: " & _
                     vbNewLine & _
  'show all servers found
   If success > 0 Then
      Label2.Caption = "DNS Server List: " & vbNewLine
      For cnt = 0 To success - 1
         Label2.Caption = Label2.Caption & _
                          dnsservers(cnt) & _
   End If

End Sub

Private Function GetDNSServers(sCurrentDNSServer As String, _
                               dnssvr() As String) As Long

   Dim buff()        As Byte
   Dim cbRequired    As Long
   Dim nStructSize   As Long
   Dim ptr           As Long
   Dim fi            As FIXED_INFO
   Dim ipas          As IP_ADDR_STRING
   Dim cnt           As Long
   ReDim dnssvr(0) As String
   nStructSize = LenB(ipas)

  'call the api first to determine the
  'size required for the values to be returned
   Call GetNetworkParams(ByVal 0&, cbRequired)

   If cbRequired > 0 Then
      ReDim buff(0 To cbRequired - 1) As Byte
      If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
         ptr = VarPtr(buff(0))
         CopyMemory fi, ByVal ptr, Len(fi)
         With fi
           'identify the current dns server
            CopyMemory ipas, _
                       ByVal VarPtr(.CurrentDnsServer) + 4, _
            sCurrentDNSServer = TrimNull(StrConv(ipas.IpAddress, vbUnicode))

           'obtain a pointer to the
           'DnsServerList array
            ptr = VarPtr(.DnsServerList)

           'the IP_ADDR_STRING dwNext member indicates
           'that more than one DNS server may be listed,
           'so a loop is needed
            Do While (ptr <> 0)

              'copy each into an IP_ADDR_STRING type
               CopyMemory ipas, ByVal ptr, nStructSize

               With ipas

                 'extract the server address and
                 'cast to the array
                  ReDim Preserve dnssvr(0 To cnt) As String
                  dnssvr(cnt) = TrimNull(StrConv(ipas.IpAddress, vbUnicode))
                  ptr = .dwNext
               End With

               cnt = cnt + 1

         End With
      End If  'If GetNetworkParams
    End If  'If cbRequired > 0
   'return number of servers found
    GetDNSServers = cnt
End Function

Private Function TrimNull(item As String)

    Dim pos As Integer
    pos = InStr(item, Chr$(0))
    If pos Then
       TrimNull = Left$(item, pos - 1)
       TrimNull = item
    End If
End Function

Private Function GetInetStrFromPtr(Address As Long) As String
   GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))

End Function

Public Function GetStrFromPtrA(ByVal lpszA As Long) As String

   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter