Gets the Name of the Primary Domain Controller for the Current Machine

Category:

Network/Internet

Type:

Snippets

Difficulty:

Advanced

Author:

Waty

Version Compatibility:

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' #VBIDEUtils ' * Programmer Name : John Timney ' * Web Site : www.geocities.com/ResearchTriangle/6311/ ' * E-Mail : timneyj@syntegra.bt.co.uk ' * Date : 28/06/99 ' * Time : 12:50 ' ************************************************************ ' * Comments : Gets the name of the PDC for the machine ' * on which the program runs ' * ' * ' *********************************************************** Option Explicit Private Declare Function NetGetDCName Lib "netapi32.dll" _ (strServerName As Any, strDomainName As Any, _ pBuffer As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32.dll" _ (Buffer As Any) As Long Private Declare Sub MoveMemory Lib "kernel32" Alias _ "RtlMoveMemory" (hpvDest As Any, _ ByVal hpvSource As Long, ByVal cbCopy As Long) Private Declare Function lstrlenW Lib "kernel32" _ (ByVal lpString As Long) As Long Private Declare Function lstrcpyW Lib "kernel32" _ (lpString1 As Byte, ByVal lpString2 As Long) As Long Private Declare Function MultiByteToWideChar Lib "kernel32" _ (ByVal CodePage As Long, ByVal dwFlags As Long, _ ByVal lpMultiByteStr As String, _ ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, _ ByVal cchWideChar As Long) As Long Private Const CP_ACP = 0

Code:

Public Function GetDC() As String
   ' Gets the name of the PDC for the machine on which the
   'program runs
   
   Dim szServer    As String
   Dim ptmpBuffer  As Long
   Dim sByte()     As Byte
   Dim lGotNameOK  As Long
   Dim lBufferOK   As Long
   
   On Error GoTo ErrHandler
   
   '# this will return nothing if the machine is not in a domain
   lGotNameOK = NetGetDCName(vbNullString, vbNullString, _
       ptmpBuffer)
   
   If lGotNameOK = 0 Then ' success
      
      ReDim sByte(256)
      
      ' ptmpbuffer is a pointer so copy contents using API call
      MoveMemory sByte(0), ptmpBuffer, 256
      
      If lBufferOK = 0 Then
         ' strip off trailing rubbish
         szServer = sByte
         szServer = szServer & vbNullChar
         GetDC = Left$(szServer, InStr(szServer, vbNullChar) - 1)
      End If
       ' free ptmpbuffer - not in other samples but
          'mentioned in documentation
      lBufferOK = NetApiBufferFree(ptmpBuffer)
   Else
      GetDC = ""
   End If
   Exit Function
ErrHandler:
    GetDC = ""
End Function