VB and VBA Users Source Code: Enumerate the Servers (inc. SQL) on a domain
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Enumerate the Servers (inc. SQL) on a domain
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, January 26, 2001
Hits:
682
Category:
Unspecified
Article:
To enumerate the SQL servers on a specified domain use the following code: Option Explicit Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Declare Function NetServerEnum Lib "netapi32" (strServername As Any, ByVal level As Long, bufptr As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, strDomain As Any, resumehandle As Long) As Long Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 'Different types of server Private Const SV_TYPE_WORKSTATION = &H1, SV_TYPE_SERVER = &H2 Private Const SV_TYPE_SQLSERVER = &H4, SV_TYPE_DOMAIN_CTRL = &H8 Private Const SV_TYPE_DOMAIN_BAKCTRL = &H10, SV_TYPE_TIME_SOURCE = &H20 Private Const SV_TYPE_AFP = &H40, SV_TYPE_NOVELL = &H80, SV_TYPE_ALL = &HFFFFFFFF Private Type SV_100 platform As Long name As Long End Type 'Example calling routine Sub Test() Dim saServers() As String, sDomainName As String, lThisDomain As Long EnumDomainServers saServers, Environ$("USERDOMAIN") On Error GoTo ExitSub For lThisDomain = 0 To UBound(saServers) Debug.Print saServers(lThisDomain) Next ExitSub: End Sub 'Purpose : To enumerate the servers on a specified domain. 'Inputs : [sDomainName] The domain name to check the servers on. If not specified enumerates the servers ' on the local domain ' [lType] The type of server to enumerate. Defaults to SQL Server 'Outputs : saServers() A zero bound string array containing all the servers on the specified domain 'Author : Andrewb 'Date : 29/08/2000 'Notes : 'Revisions : Public Sub EnumDomainServers(saServers() As String, Optional sDomainName As String = "Local", Optional lType = SV_TYPE_SQLSERVER) Dim lRet As Long, lEntriesRead As Long, lTotalEntries As Long Dim lhResume As Long, lBufPtr As Long, lLevel As Long Dim lPrefMaxLen As Long, lThisEntry As Long, lptrStart As Long Dim abDomain() As Byte Dim tSv100 As SV_100 lLevel = 100 lPrefMaxLen = -1 'Use automatic max length If Right$(sDomainName, 1) <> vbNullChar Then abDomain = sDomainName & vbNullChar End If lRet = NetServerEnum(ByVal 0&, lLevel, lptrStart, lPrefMaxLen, lEntriesRead, lTotalEntries, lType, abDomain(0), lhResume) If (lRet = 0 Or lRet = 234&) And lEntriesRead > 0 Then lBufPtr = lptrStart ReDim saServers(0 To lEntriesRead - 1) For lThisEntry = 0 To lEntriesRead - 1 CopyMemory tSv100, ByVal lBufPtr, Len(tSv100) saServers(lThisEntry) = StrFromPtr(tSv100.name) 'Move the pointer along by the length of the structure lBufPtr = lBufPtr + Len(tSv100) Next Else 'No Servers Found. Clear the array Erase saServers End If 'Free the resource Call NetApiBufferFree(lptrStart) End Sub 'Purpose : Converts a pointer to a string into a string. 'Inputs : lPtr A long pointer to a string held in memory 'Outputs : The string held at the specified memory address 'Author : Andrew Baker 'Date : 03/08/2000 19:14 'Notes : 'Revisions : Private Function StrFromPtr(ByVal lPtr As Long) As String Dim lLen As Long Dim abytBuf() As Byte 'Get the length of the string at the memory location lLen = lstrlenW(lPtr) * 2 - 1 'Unicode string (must double the buffer size) If lLen > 0 Then ReDim abytBuf(lLen) 'Copy the memory contents into a byte array Call CopyMemory(abytBuf(0), ByVal lPtr, lLen) 'convert and return the buffer StrFromPtr = abytBuf End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
