[VBnet Network] GetNetworkParams: Obtain Domain Registering the Local Machine

	Visual Basic Network Services GetNetworkParams: Obtain Domain Registering the Local Machine

Posted:	Tuesday May 22, 2001
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows 2000
OS restrictions:	Windows 98+, Windows 2000, Windows XP or later
Author:	VBnet - Randy Birch

Related:	gethostbyname: Determine Network Host Name and IP Address gethostbyname: Resolve Host Name to IP Address gethostbyaddr: Obtain Host Name from IP Address IcmpSendEcho: Ping a Machine by Host Name

Prerequisites

One of the operating systems listed under OS Restrictions above.

By querying the returned FIXED_INFO structure returned in a call to GetNetworkParams, the domain name in which the local computer is registered can be obtained. In my case on the development machine, I am logged into the @home domain in Toronto.

BAS Module Code

None.

Form Code

To a form add a command button (Command1),a label (Label1) and a text box (Text1). Add the following 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 ERROR_SUCCESS         As Long = 0
Private Const MAX_DOMAIN_NAME_LEN   As Long = 128
Private Const MAX_HOSTNAME_LEN      As Long = 128
Private Const MAX_SCOPE_ID_LEN      As Long = 256

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  As IP_ADDRESS_STRING
    IpMask     As IP_MASK_STRING
    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 IP_ADDR_STRING
  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 Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
   

Private Sub Form_Load()

   Command1.Caption = "Get Domain Name"
   Label1.Caption = "Network domain is:"
   
End Sub
   

Private Sub Command1_Click()

   Text1.Text = GetDomainName()

End Sub


Public Function GetDomainName() As String

   Dim buff()        As Byte
   Dim cbRequired    As Long
   Dim nStructSize   As Long
   Dim Info          As FIXED_INFO

  'Call the api passing null as pFixedInfo.
  'The required size of the buffer for the
  'data is returned in cbRequired
   Call GetNetworkParams(ByVal 0&, cbRequired)

   If cbRequired > 0 Then
    
     'create a buffer of the needed size
      ReDim buff(0 To cbRequired - 1) As Byte
      
     'and call again
      If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
              
        'copy the buffer into a FIXED_INFO type
         CopyMemory Info, ByVal VarPtr(buff(0)), LenB(Info)
            
        'and retrieve the domain name
         GetDomainName = TrimNull(StrConv(Info.DomainName, vbUnicode))
      
      End If  'If GetNetworkParams
   End If  'If cbRequired > 0

End Function


Private Function TrimNull(item As String)

    Dim pos As Integer
   
   'double check that there is a chr$(0) in the string
    pos = InStr(item, Chr$(0))
    If pos Then
       TrimNull = Left$(item, pos - 1)
    Else
       TrimNull = item
    End If
  
End Function

Comments

PayPal Link