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
     

Related:  

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
     
 Prerequisites
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
None.

 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

Private Type IP_ADDRESS_STRING
   IpAddr(0 To 15)     As Byte
End Type

Private Type IP_MASK_STRING
   IpMask(0 To 15)     As Byte
End Type

Private Type IP_ADDR_STRING
   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 & _
                     currserver
                                      
   
  '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) & _
                          vbNewLine
         
      Next
   
   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, _
                       nStructSize
            
            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

            Loop
            
         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)
    Else
       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
 Comments

 
 

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