Author  

Language  

Operating Systems  

Option Explicit

'The NetGetDCName function returns the name of the Primary Domain Controller (PDC) for the specified domain.

'API calls
Private Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As Any, DomainName As Any, lpBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long

Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long

'API Constants
Private Const NERR_Success As Long = 0&

Private Function PtrToString(lpwString As Long) As String
    'Convert a LPWSTR pointer to a VB string
    Dim Buffer() As Byte
    Dim nLen As Long

    If lpwString Then
        nLen = lstrlenW(lpwString) * 2
        If nLen Then
            ReDim Buffer(0 To (nLen - 1)) As Byte
            CopyMem Buffer(0), ByVal lpwString, nLen
            PtrToString = Buffer
        End If
    End If
End Function

'ComputerName

'Pointer to  string containing the name of the remote server on which the function is to execute. A NULL string specifies the local computer.

'DomainnNme

'Pointer to a string containing the name of the domain. A NULL string indicates that the function returns the name of the domain controller for the primary domain.
Public Function GetPDCName(ComputerName As String, DomainName As String) As String
    Dim bComputer() As Byte
    Dim bDomain() As Byte
    Dim ret As Long
    Dim lpBuffer As Long
    Dim s As String

    If Trim(ComputerName) = "" Then
        'Local users
        bComputer = vbNullChar
    Else
        'Check the syntax of the ServerName string
        If InStr(ComputerName, "\\") = 1 Then
            bComputer = ComputerName & vbNullChar
        Else
            bComputer = "\\" & ComputerName & vbNullChar
        End If
    End If
    If Trim(DomainName) = "" Then
        'Default Domain
        bDomain = vbNullChar
    Else
        bDomain = DomainName & vbNullChar
    End If
    ret = NetGetDCName(bComputer(0), bDomain(0), lpBuffer)
    If ret = NERR_Success And lpBuffer Then
        s = PtrToString(lpBuffer)
    End If
    If lpBuffer Then
        Call NetApiBufferFree(lpBuffer)
    End If
    GetPDCName = s
End Function

Private Sub Command1_Click()
    MsgBox GetPDCName("", "")
End Sub