Networked Computer Names

[Stu Bailey]

Does anybody know how to get the names and descriptions of all the computers currently turned on on my network?

Cheers

Stu

[John G Duffy]

Here is an example that enumerates all resources in a network.
Start a new project
Add a module
Paste the following code into the module
Set the startup sub to MAIN
Run the program.
Output is to a file and also the debug window

option Explicit

'Add this code to a module and set the Project's Startup Object to 'Sub Main'
' (-> Project Menu -> Project Properties -> General Tab)
private Const RESOURCE_CONNECTED as Long = &H1&
private Const RESOURCE_GLOBALNET as Long = &H2&
private Const RESOURCE_REMEMBERED as Long = &H3&
private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
private Const RESOURCEDISPLAYTYPE_FILE& = &H4
private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
private Const RESOURCETYPE_ANY as Long = &H0&
private Const RESOURCETYPE_DISK as Long = &H1&
private Const RESOURCETYPE_PRINT as Long = &H2&
private Const RESOURCETYPE_UNKNOWN as Long = &HFFFF&
private Const RESOURCEUSAGE_ALL as Long = &H0&
private Const RESOURCEUSAGE_CONNECTABLE as Long = &H1&
private Const RESOURCEUSAGE_CONTAINER as Long = &H2&
private Const RESOURCEUSAGE_RESERVED as Long = &H80000000
private Const NO_ERROR = 0
private Const ERROR_MORE_DATA = 234 'L // dderror
private Const RESOURCE_ENUM_ALL as Long = &HFFFF
private Type NETRESOURCE
dwScope as Long
dwType as Long
dwDisplayType as Long
dwUsage as Long
pLocalName as Long
pRemoteName as Long
pComment as Long
pProvider as Long
End Type
private Type NETRESOURCE_REAL
dwScope as Long
dwType as Long
dwDisplayType as Long
dwUsage as Long
sLocalName as string
sRemoteName as string
sComment as string
sProvider as string
End Type
private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource as NETRESOURCE, byval lpPassword as string, byval lpUserName as string, byval dwFlags as Long) as Long
private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (byval dwScope as Long, byval dwType as Long, byval dwUsage as Long, lpNetResource as Any, lphEnum as Long) as Long
private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (byval hEnum as Long, lpcCount as Long, lpBuffer as NETRESOURCE, lpBufferSize as Long) as Long
private Declare Function WNetCloseEnum Lib "mpr.dll" (byval hEnum as Long) as Long
private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject as Any) as Long
private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo as Any, lpFrom as Any, byval lLen as Long)
private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (byval lpTo as Long, byval lpFrom as Long, byval lLen as Long)
private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (byval lpString1 as string, byval lpString2 as Any) as Long
private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (byval lpString as Any) as Long
private Declare Function getusername Lib "advapi32.dll" Alias "GetUserNameA" (byval lpBuffer as string, nSize as Long) as Long
private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (byval lpBuffer as string, nSize as Long) as Long
public strUserName as string
public strMachinerName as string
Sub main()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'-> This sample was created by Donald Grover
Const MAX_RESOURCES = 256
Const NOT_A_CONTAINER = -1
Dim bFirstTime as Boolean
Dim lReturn as Long
Dim hEnum as Long
Dim lCount as Long
Dim lMin as Long
Dim lLength as Long
Dim l as Long
Dim lBufferSize as Long
Dim lLastIndex as Long
Dim uNetApi(0 to MAX_RESOURCES) as NETRESOURCE
Dim uNet() as NETRESOURCE_REAL
bFirstTime = true
Do
If bFirstTime then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, byval 0&, hEnum)
bFirstTime = false
else
If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)
else
lReturn = NOT_A_CONTAINER
hEnum = 0
End If
lLastIndex = lLastIndex + 1
End If
If lReturn = NO_ERROR then
lCount = RESOURCE_ENUM_ALL
Do
lBufferSize = UBound(uNetApi) * len(uNetApi(0)) / 2
lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
If lCount > 0 then
ReDim Preserve uNet(0 to lMin + lCount - 1) as NETRESOURCE_REAL
for l = 0 to lCount - 1
'Each Resource will appear here as uNet(i)
uNet(lMin + l).dwScope = uNetApi(l).dwScope
uNet(lMin + l).dwType = uNetApi(l).dwType
uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
If uNetApi(l).pLocalName then
lLength = lstrlen(uNetApi(l).pLocalName)
uNet(lMin + l).sLocalName = Space$(lLength)
CopyMem byval uNet(lMin + l).sLocalName, byval uNetApi(l).pLocalName, lLength
End If
If uNetApi(l).pRemoteName then
lLength = lstrlen(uNetApi(l).pRemoteName)
uNet(lMin + l).sRemoteName = Space$(lLength)
CopyMem byval uNet(lMin + l).sRemoteName, byval uNetApi(l).pRemoteName, lLength
End If
If uNetApi(l).pComment then
lLength = lstrlen(uNetApi(l).pComment)
uNet(lMin + l).sComment = Space$(lLength)
CopyMem byval uNet(lMin + l).sComment, byval uNetApi(l).pComment, lLength
End If
If uNetApi(l).pProvider then
lLength = lstrlen(uNetApi(l).pProvider)
uNet(lMin + l).sProvider = Space$(lLength)
CopyMem byval uNet(lMin + l).sProvider, byval uNetApi(l).pProvider, lLength
End If
next l
End If
lMin = lMin + lCount
Loop While lReturn = ERROR_MORE_DATA
End If
If hEnum then
l = WNetCloseEnum(hEnum)
End If
Loop While lLastIndex < lMin

If UBound(uNet) > 0 then
username
Dim filNum as Integer
filNum = FreeFile
Open App.Path & "\" & LCase(App.EXEName) & ".txt" for Output Shared as #filNum
'Open "d:\" & App.EXEName & ".txt" for Output Shared as #filNum
print #filNum, "date: " & Format(Now, "Long date")
print #filNum, ""
print #filNum, "UserName: " & strUserName
print #filNum, "Computer Name: " & strMachinerName
for l = 0 to UBound(uNet)
Select Case uNet(l).dwDisplayType
Case RESOURCEDISPLAYTYPE_DIRECTORY&
Debug.print "Directory...",
print #filNum, "Directory...",
Case RESOURCEDISPLAYTYPE_DOMAIN
Debug.print "Domain...",
print #filNum, "Domain...",
Case RESOURCEDISPLAYTYPE_FILE
Debug.print "File...",
print #filNum, "File...",
Case RESOURCEDISPLAYTYPE_GENERIC
Debug.print "Generic...",
print #filNum, "Generic...",
Case RESOURCEDISPLAYTYPE_GROUP
Debug.print "Group...",
print #filNum, "Group...",
Case RESOURCEDISPLAYTYPE_NETWORK&
Debug.print "Network...",
print #filNum, "Network...",
Case RESOURCEDISPLAYTYPE_ROOT&
Debug.print "Root...",
print #filNum, "Root...",
Case RESOURCEDISPLAYTYPE_SERVER
Debug.print "Server...",
print #filNum, "Server...",
Case RESOURCEDISPLAYTYPE_SHARE
Debug.print "Share...",
print #filNum, "Share...",
Case RESOURCEDISPLAYTYPE_SHAREADMIN&
Debug.print "ShareAdmin...",
print #filNum, "ShareAdmin...",
End Select
Debug.print uNet(l).sRemoteName, uNet(l).sComment
print #filNum, uNet(l).sRemoteName, uNet(l).sComment
next l
End If
Close #filNum
MsgBox "File " + App.Path & "\" & LCase(App.EXEName) & ".txt created" + vbCrLf + "Open it in a text editor to see the results", vbInformation
End Sub
private Sub username()
on error resume next
'Create a buffer
strUserName = string(255, Chr$(0))
'get the username
getusername strUserName, 255
'strip the rest of the buffer
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
'Create a buffer
strMachinerName = string(255, Chr$(0))
GetComputerName strMachinerName, 255
'remove the unnecessary chr$(0)'s
strMachinerName = Left$(strMachinerName, InStr(1, strMachinerName, Chr$(0)) - 1)
End Sub





John G

[BigE]

I found the code to get the computer names really helpful, but it does not seem to detect any other node than Servers and Shares. How can I make it detect regular computers that are on the network?

Thank you!

BigE

[morrowasted]

crap... thats like more code than it took for me to make "WARZ: The Game that doesn't crap on itself, even on low-end computers!" the video game. and yes, that is the real title... its a humor game. gosh that code uses like 15 million API commands. did u actually type that out?

[John G Duffy]

BigE,
not quite sure what you mean by regular computers. I used that sample on my small Home Network and it lists every computer on it (4 of them).

You might try browsing URL=http://www.Planet-Source-Code.com/vb]Planet-Source-Code.com/vb[/URL]

There are bunches of samples there that may help. The sample I posted is quite old and there probaably are different ways to accomplish this task.[

[John G Duffy]

Sorry about that bad URL posting. It should read
'
http://www.Planet-Source-Code.com/vb

[BigE]

Well, the example you gave me first was not detecting but about 20% of the entire network machines for some reason. I did find another example though that did find all the machines on the network.

Thank you so much.

[JeffB]

Originally posted by BigE
I did find another example though that did find all the machines on the network.

If you care to share the link with us, we would appreciate ...

JeffB

[BigE]

Actually, I don't remember the link, but here is the code:

Note: just start a new project in VB, add a standard form nd add a list control to it, do not change the default name of the list, then add this code to the form: (it'll find all the machines on your network on load, good luck!).

Option Explicit
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const SV_TYPE_WORKSTATION As Long = &H1
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
Private Const SV_TYPE_TIME_SOURCE As Long = &H20
Private Const SV_TYPE_AFP As Long = &H40
Private Const SV_TYPE_NOVELL As Long = &H80
Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
Private Const SV_TYPE_XENIX_SERVER As Long = &H800
Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
Private Const SV_TYPE_NT As Long = &H1000
Private Const SV_TYPE_WFW As Long = &H2000
Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
Private Const SV_TYPE_SERVER_NT As Long = &H8000
Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000
Private Const SV_TYPE_SERVER_OSF As Long = &H100000
Private Const SV_TYPE_SERVER_VMS As Long = &H200000
Private Const SV_TYPE_WINDOWS As Long = &H400000 'Windows95 and above
Private Const SV_TYPE_DFS As Long = &H800000 'Root of a DFS tree
Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster
Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server
Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS
Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'rtn alternate transport
Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'rtn local only
Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF

Private Const SV_PLATFORM_ID_OS2 As Long = 400
Private Const SV_PLATFORM_ID_NT As Long = 500

'Mask applied to svX_version_major in
'order to obtain the major version number.
Private Const MAJOR_VERSION_MASK As Long = &HF

Private Type SERVER_INFO_100
sv100_platform_id As Long
sv100_name As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
buf As Any, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal servertype As Long, _
ByVal domain As Long, _
resume_handle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long




Private Sub Form_Load()

Call GetServers(vbNullString)
End Sub



Private Function GetServers(sDomain As String) As Long

'lists all servers of the specified type
'that are visible in a domain.

Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim se100 As SERVER_INFO_100
Dim success As Long
Dim nStructSize As Long
Dim cnt As Long

nStructSize = LenB(se100)

'Call passing MAX_PREFERRED_LENGTH to have the
'API allocate required memory for the return values.
'
'The call is enumerating all machines on the
'network (SV_TYPE_ALL); however, by Or'ing
'specific bit masks for defined types you can
'customize the returned data. For example, a
'value of 0x00000003 combines the bit masks for
'SV_TYPE_WORKSTATION (0x00000001) and
'SV_TYPE_SERVER (0x00000002).
'
'dwServerName must be Null. The level parameter
'(100 here) specifies the data structure being
'used (in this case a SERVER_INFO_100 structure).
'
'The domain member is passed as Null, indicating
'machines on the primary domain are to be retrieved.
'If you decide to use this member, pass
'StrPtr("domain name"), not the string itself.
success = NetServerEnum(0&, 100, bufptr, MAX_PREFERRED_LENGTH, dwEntriesread, dwTotalentries, SV_TYPE_ALL, 0&, dwResumehandle)

'if all goes well
If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then

'loop through the returned data, adding each
'machine to the list
For cnt = 0 To dwEntriesread - 1

'get one chunk of data and cast
'into an SERVER_INFO_100 struct
'in order to add the name to a list
CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize

List1.AddItem GetPointerToByteStringW(se100.sv100_name)

Next

End If

'clean up regardless of success
Call NetApiBufferFree(bufptr)

'return entries as sign of success
GetServers = dwEntriesread

End Function


Public Function GetPointerToByteStringW(ByVal dwData As Long) As String

Dim tmp() As Byte
Dim tmplen As Long

If dwData <> 0 Then

tmplen = lstrlenW(dwData) * 2

If tmplen <> 0 Then

ReDim tmp(0 To (tmplen - 1)) As Byte
CopyMemory tmp(0), ByVal dwData, tmplen
GetPointerToByteStringW = tmp

End If

End If

End Function