VB and VBA Users Source Code: Enumerate the machines on a domain
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Enumerate the machines on a domain
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, January 17, 2001
Hits:
729
Category:
Networks
Article:
To enumerate the machines on a domain use EnumDomainMachines routine. Note, a test routine can be found at the bottom of this post: Option Explicit 'Network API Private Declare Function StrLen Lib "KERNEL32" Alias "lstrlenW" (ByVal Ptr As Long) As Long Private Declare Function PtrToStr Lib "KERNEL32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long Private Declare Function PtrToInt Lib "KERNEL32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long Private Declare Function NetServerEnum Lib "NETAPI32.DLL" (ByVal Servername As Long, ByVal Level As Long, ByRef buffer As Long, ByRef PrefMaxLen As Long, ByRef EntriesRead As Long, ByRef TotalEntries As Long, ByRef ServerType As Long, DomainName As Byte, ByRef ResumeHandle As Long) As Long Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (ByVal lPointerToBuffer As Long) As Long 'Registry API Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal lHKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal lHKey As Long) As Long Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal lHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long 'Registry Constants Private Const STANDARD_RIGHTS_ALL = &H1F0000, KEY_QUERY_VALUE = &H1, KEY_NOTIFY = &H10, READ_CONTROL = &H20000 Private Const SYNCHRONIZE = &H100000, KEY_ENUMERATE_SUB_KEYS = &H8, STANDARD_RIGHTS_READ = (READ_CONTROL) Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Private Const REG_HEX = 4, REG_SZ = 1, REG_BINARY = 3, REG_DWORD = 4, KeyValSize As Long = 1024 Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) Private Type tMungeLong X As Long Dummy As Integer End Type Private Type tMungeInt XLo As Integer XHi As Integer Dummy As Integer End Type 'Purpose : Enumerates the machines on a specific domain 'Inputs : [sDomainName] The domain to enumerate. If unspecified, uses the primary domain. 'Outputs : asMachineNames String array(1 to NumMachines) containing the machine names ' Returns the number of machines found. 'Author : Andrew Baker 'Date : 31/12/2000 13:17 'Notes : 'Revisions : Function EnumDomainMachines(asMachineNames() As String, Optional sDomainName As String) As Long Const SV_TYPE_NT As Long = &H1000 Dim lpBufPtr As Long, lEntriesRead As Long, lTotalEntries As Long Dim lMaxLenPref As Long, lReturn As Long, lLevel As Long Dim lResumeHandle As Long, lIndex As Long Dim abDomain() As Byte Dim sMachineName As String If Len(sDomainName) = 0 Then 'Get primary domain name from registry sDomainName = RegistryLoad("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "CachePrimaryDomain", "", "HKEY_LOCAL_MACHINE") End If abDomain = sDomainName & vbNullChar lMaxLenPref = &HFFFFFFFF lLevel = 100 lReturn = NetServerEnum(0&, lLevel, lpBufPtr, lMaxLenPref, lEntriesRead, lTotalEntries, SV_TYPE_NT, abDomain(0), lResumeHandle) If lReturn = 0 Then 'Resize output array ReDim asMachineNames(1 To lEntriesRead) For lIndex = 1 To lEntriesRead * 2 Step 2 sMachineName = zGetPointedField(lpBufPtr, lIndex + 1) If Len(sMachineName) Then 'Store machine name EnumDomainMachines = EnumDomainMachines + 1 asMachineNames(EnumDomainMachines) = sMachineName End If Next If EnumDomainMachines <> lEntriesRead Then 'Resize output array ReDim Preserve asMachineNames(1 To lEntriesRead) End If Else 'Failed to enumerate domain, clear output array Erase asMachineNames End If lReturn = NetApiBufferFree(lpBufPtr) Exit Function ErrDLL: MsgBox "Error while attempting to obtaining network machine names..." & Chr(13) & Err.Description, vbExclamation End Function Private Function zGetPointedField(lbufptr As Long, lIndex As Long) As String Dim abResult(255) As Byte, lResult As Long Dim tTempPtr As tMungeLong, tTempStr As tMungeInt 'Get pointer to string from beginning of buffer. Copy 4 byte block of memory in 2 steps lResult = PtrToInt(tTempStr.XLo, lbufptr + (lIndex - 1) * 4, 2) lResult = PtrToInt(tTempStr.XHi, lbufptr + (lIndex - 1) * 4 + 2, 2) LSet tTempPtr = tTempStr ' munge 2 Integers to a Long 'Copy string to array and convert to a string lResult = PtrToStr(abResult(0), tTempPtr.X) zGetPointedField = Left$(abResult, StrLen(tTempPtr.X)) End Function 'Purpose : Private function to convert the root name to a Hex value 'Inputs : sRegPath The name of the root 'Outputs : The hex constant for the specified root. 'Author : Andrewb 'Date : 24/07/2000 'Notes : Private Function zRegPathToValue(sRegPath As String) As Long Select Case UCase$(sRegPath) Case "HKEY_CURRENT_USER" zRegPathToValue = &H80000001 Case "HKEY_LOCAL_MACHINE" zRegPathToValue = &H80000002 Case "HKEY_CLASSES_ROOT" zRegPathToValue = &H80000000 Case "HKEY_USERS" zRegPathToValue = &H80000003 Case "HKEY_CURRENT_CONFIG" zRegPathToValue = &H80000005 Case "HKEY_DYN_DATA" zRegPathToValue = &H80000006 End Select End Function 'Purpose : Reads a value from the registry 'Inputs : lHKey Handle to opened key ' sItemName The name of the item to return the value of. ' vDefault The default value to return if no value has been set. 'Outputs : vValue The value of the item in the registry ' Returns error number if error occurs. 'Author : Andrew Baker 'Date : 31/12/2000 13:17 'Notes : 'Revisions : Private Function zQueryValueEx(ByVal lHKey As Long, ByVal sItemName As String, vValue As Variant, vDefault As Variant) As Long Dim lDataLen As Long, lRetVal As Long, lType As Long, lValue As Long, sValue As String Const ERROR_NONE = 0 On Error GoTo ErrExit 'Determine the size and type of data to be read lRetVal = RegQueryValueExNULL(lHKey, sItemName, 0&, lType, 0&, lDataLen) If lRetVal = ERROR_NONE Then Select Case lType Case REG_SZ 'For strings sValue = String$(lDataLen, 0) lRetVal = RegQueryValueExString(lHKey, sItemName, 0&, lType, sValue, lDataLen) If lRetVal = ERROR_NONE Then vValue = Left$(sValue, lDataLen - 1) Else vValue = vDefault End If Case Else 'For Binary Values lRetVal = RegQueryValueExLong(lHKey, sItemName, 0&, lType, lValue, lDataLen) If lRetVal = ERROR_NONE Then vValue = lValue Else vValue = vDefault End If End Select Else 'Error Getting Value vValue = vDefault End If Exit Function ErrExit: 'Unhandled Error, return default value and error number vValue = vDefault zQueryValueEx = Err.Number End Function 'Purpose : Returns the value of a specified key from the registry. 'Inputs : sKeyPath The path to the key eg. "Software\VB and VBA Program Settings" ' sItemName The name of the item to return the value of. ' [vDefault] The value to return if the key doesn't exist. ' [sKeyName] The Root to the key eg. "HKEY_CURRENT_USER" or "HKEY_LOCAL_MACHINE" etc. 'Outputs : The value of sItemName 'Author : Andrewb 'Date : 24/07/2000 'Notes : Uses private function "zRegPathToValue" Function RegistryLoad(ByVal KeyPath As String, sItemName As String, Optional vDefault As Variant, Optional sKeyName As String = "HKEY_CURRENT_USER") As Variant Dim lRetVal As Long, lHKey As Long, KeyValue As Long KeyValue = zRegPathToValue(sKeyName) lRetVal = RegOpenKeyEx(KeyValue, KeyPath, 0, KEY_READ, lHKey) If lHKey Then 'Opened the Key lRetVal = zQueryValueEx(lHKey, sItemName, RegistryLoad, vDefault) 'Close the Key lRetVal = RegCloseKey(lHKey) Else 'Return vDefault RegistryLoad = vDefault End If End Function 'Demonstration Routine Sub Test() Dim vThisMachine As Variant, asMachines() As String 'Populate the array with the machine names EnumDomainMachines asMachines 'Print the results Debug.Print "Total Number: " & UBound(asMachines) For Each vThisMachine In asMachines Debug.Print CStr(vThisMachine) Next End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
