Get a list of machines on a LAN

[Gibbo]

Hi,

Does anybody know how to search a LAN and compile a list of the machines that are currently running?

I am using VB6.

Thanks in advance,
Gibbo

[Serge]

Sure thing! Add a Listbox (List1) and a Command Button (Command1):

Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As Long
    lpRemoteName As Long
    lpComment As Long
    lpProvider As Long
End Type
   
Private Type NETRES2
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function lstrcpyA Lib "kernel32" Alias "lstrcpy" (ByVal NewString As String, ByVal OldString 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, ByVal lpBuffer As Long, ByRef lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long


Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCE_CONTEXT = &H5

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_UNKNOWN = &HFFFF

Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Const RESOURCEUSAGE_RESERVED = &H80000000

Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_DISCARDED = &H4000
Private Const GMEM_FIXED = &H0
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GMEM_LOCKCOUNT = &HFF
Private Const GMEM_MODIFY = &H80
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Const ERROR_MORE_DATA = 234

Private Const RESOURCEDISPLAYTYPE_GENERIC = 0
Private Const RESOURCEDISPLAYTYPE_DOMAIN = 1
Private Const RESOURCEDISPLAYTYPE_SERVER = 2
Private Const RESOURCEDISPLAYTYPE_SHARE = 3
Private Const RESOURCEDISPLAYTYPE_FILE = 4
Private Const RESOURCEDISPLAYTYPE_GROUP = 5
Private Const RESOURCEDISPLAYTYPE_NETWORK = 6
Private Const RESOURCEDISPLAYTYPE_ROOT = 7
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN = 8
Private Const RESOURCEDISPLAYTYPE_DIRECTORY = 9
Private Const RESOURCEDISPLAYTYPE_TREE = &HA
Private Const RESOURCEDISPLAYTYPE_NDSCONTAINER = &HB

Private m_colShares As New Collection

Private Type WKSTA_INFO_101
   wki101_platform_id As Long
   wki101_computername As Long
   wki101_langroup As Long
   wki101_ver_major As Long
   wki101_ver_minor As Long
   wki101_lanroot As Long
End Type

Private Type WKSTA_USER_INFO_1
   wkui1_username As Long
   wkui1_logon_domain As Long
   wkui1_logon_server As Long
   wkui1_oth_domains As Long
End Type

Private Declare Function WNetGetUser Lib "Mpr" Alias "WNetGetUserA" (lpName As Any, ByVal lpUserName As String, lpnLength As Long) As Long
Private Declare Function NetWkstaGetInfo Lib "Netapi32" (strServer As Any, ByVal lLevel As Long, pbBuffer As Any) As Long
Private Declare Function NetWkstaUserGetInfo Lib "Netapi32" (reserved As Any, ByVal lLevel As Long, pbBuffer As Any) As Long
Private Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal size&)
Private Declare Function NetApiBufferFree& Lib "Netapi32" (ByVal buffer&)


Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_NOTIFY = &H10
Private Const READ_CONTROL = &H20000
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const SYNCHRONIZE = &H100000
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_SZ = 1

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0

Public Function GetWorkgroup() As String
    Dim lKeyHandle As Long
    Dim lRet As Long
    Dim strBuffer As String
    Dim strKey As String
    Dim strValue As String
    
    strKey = "System\CurrentControlSet\Services\VXD\VNETSUP"
    strValue = "Workgroup"
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, KEY_READ, lKeyHandle)
    If lRet = ERROR_SUCCESS Then
        strBuffer = Space(255)
        lRet = RegQueryValueEx(lKeyHandle, strValue, 0, REG_SZ, ByVal strBuffer, Len(strBuffer))
        If lRet = ERROR_SUCCESS Then
            GetWorkgroup = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        End If
        RegCloseKey lKeyHandle
    End If
End Function

Function GetDomainName()
    Dim lngRet As Long
    Dim arrByteBuffer(512) As Byte
    Dim i As Integer
    Dim tWK_INFO As WKSTA_INFO_101
    Dim lngWK_Ptr As Long
    Dim tWK_USER As WKSTA_USER_INFO_1
    Dim lngWK_USER_Ptr As Long
    Dim strDomain As String

    If IfWinNT Then
        lngRet = NetWkstaGetInfo(ByVal 0&, 101, lngWK_Ptr)
        RtlMoveMemory tWK_INFO, ByVal tWK_INFO, Len(tWK_INFO)
        lngRet = NetWkstaUserGetInfo(ByVal 0&, 1, lngWK_USER_Ptr)
        RtlMoveMemory tWK_USER, ByVal lngWK_USER_Ptr, Len(tWK_USER)
        lstrcpyW arrByteBuffer(0), tWK_USER.wkui1_logon_domain
        'Get Every other byte of the array
        i = 0
        Do While arrByteBuffer(i) <> 0
            strDomain = strDomain & Chr(arrByteBuffer(i))
            i = i + 2
        Loop
        lngRet = NetApiBufferFree(lngWK_USER_Ptr)

        GetDomainName = strDomain
    Else
        'For Win9X get Workgroup
        GetDomainName = GetWorkgroup()
    End If
End Function

Private Function IfWinNT() As Boolean
    Dim os As OSVERSIONINFO
    Dim lngRet As Long
    
    os.dwOSVersionInfoSize = Len(os)
    lngRet = GetVersionEx(os)
    
    If lngRet <> 0 Then
        Select Case os.dwPlatformId
            Case VER_PLATFORM_WIN32_NT
                IfWinNT = True
            Case Else
                IfWinNT = False
        End Select
    End If
End Function

Public Sub LoadLANComps(p_strDomain As String)
    Dim tNetRes As NETRES2
    Dim lngRet As Long
    Dim lngHndEnum As Long
    Dim lngBuffer As Long
    Dim lngBufferPtr As Long
    Dim lngBufferPtrTemp As Long
    Dim lngCount As Long
    Dim tNR As NETRESOURCE
    Dim i As Integer
    Dim strCompName As String
    
    On Error Resume Next
    
    With tNetRes
        .lpRemoteName = p_strDomain
        .dwDisplayType = 1
    End With
    
    lngRet = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNetRes, lngHndEnum)
    
    If lngRet <> 0 Then
        MsgBox "Error getting computers on the LAN.", vbCritical, "Error"
        Exit Sub
    End If
    
    lngBuffer = 1024 * 10
    
    lngBufferPtr = GlobalAlloc(GPTR, lngBuffer)
    
    Do
        'Number of entries to return from enumeration: -1 causes all objects to be returned
        lngCount = -1
        lngRet = WNetEnumResource(lngHndEnum, lngCount, lngBufferPtr, lngBuffer)
        If lngRet = ERROR_MORE_DATA Then
            'Enumeration indicates that the lngBufferPtr is not big enough to hold all of the information in the
            'NETRESOURCE structure. lngBuffer has been updated to hold the required amount of space.
            GlobalFree lngBufferPtr   'Free up memory
            lngBufferPtr = GlobalAlloc(GPTR, lngBuffer)  'Allocate a new space for the lngBuffer requested by the enumeration
        Else
            If lngRet = 0 Then
                lngBufferPtrTemp = lngBufferPtr
                For i = 1 To lngCount
                    CopyMemory tNR, ByVal lngBufferPtrTemp, LenB(tNR)
                    strCompName = lstrcpy(tNR.lpRemoteName)
                    
                    'Trim 2 double slashes
                    If strCompName <> "" Then
                        strCompName = Mid(strCompName, InStr(strCompName, "\\") + 2)
                        'Add computer name to the collection
                        m_colShares.Add strCompName, strCompName
                    End If
                    
                    'Step forward in the buffer by the length of the copied structure
                    lngBufferPtrTemp = lngBufferPtrTemp + LenB(tNR)
                Next
            End If
        End If
    Loop Until lngCount = 0
    
    WNetCloseEnum lngHndEnum
    'Free up memory
    GlobalFree lngBufferPtr
End Sub

Private Function lstrcpy(lStrPointer As Long) As String
    Dim strBuffer As String

    strBuffer = String(255, vbNullChar)
    lstrcpyA strBuffer, lStrPointer
    lstrcpy = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End Function

Private Sub Command1_Click()
    Dim strDomain As String
    Dim objCollItem As Variant
    
    strDomain = GetDomainName
    
    Call LoadLANComps(strDomain)
    
    For Each objCollItem In m_colShares
        List1.AddItem objCollItem
    Next
End Sub

This will enumerate all computers in the current domain or workgroup.

[whatadonk]

This code is great.... Thank you very much Serge

Now once we have compiled the list of machines on the LAN
How do we get an IP address from each one?

Any help would be greatly appreciated

Thanking you in advance
whatadonk

Well to get the Ip of yuor machine, you type : -

txtText1.text = Winsock1.LocalIP

Hope this helps in any way.

[cas21]

'Try this

'This will get the network name and all computers booted to the LAN
'Paste this into a module

Option Explicit

Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Public 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

Public Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" ( _
ByVal hEnum As Long, _
lpcCount As Long, _
ByVal lpBuffer As Long, _
lpBufferSize As Long) As Long

Public Declare Function WNetCloseEnum Lib "mpr.dll" ( _
ByVal hEnum As Long) As Long

'RESOURCE ENUMERATION.
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000

Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function CopyPointer2String Lib "KERNEL32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long

Public Sub DoNetEnum()
Dim hEnum As Long, lpBuff As Long, NR As NETRESOURCE
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long

'Setup the NETRESOURCE input structure.
NR.lpRemoteName = 0
cbBuff = 10000
cCount = &HFFFFFFFF


'Open a Net enumeration operation handle: hEnum.
res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NR, hEnum)

If res = 0 Then
'Create a buffer large enough for the results.
'10000 bytes should be sufficient.
lpBuff = GlobalAlloc(GPTR, cbBuff)
'Call the enumeration function.
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
p = lpBuff
'WNetEnumResource fills the buffer with an array of
'NETRESOURCE structures. Walk through the list and print
'each local and remote name.
For i = 1 To cCount
' All we get back are the Global Network Containers --- Enumerate each of these
CopyMemory NR, ByVal p, LenB(NR)
Form1.Show
Form1.List1.AddItem "Network Name " & PointerToString(NR.lpRemoteName)

DoNetEnum2 NR
p = p + LenB(NR)
Next i
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum) 'Close the enumeration
End If
End Sub

Private Function PointerToString(p As Long) As String
'The values returned in the NETRESOURCE structures are pointers to
'ANSI strings so they need to be converted to Visual Basic Strings.
Dim s As String
s = String(255, Chr$(0))
CopyPointer2String s, p
PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Public Sub DoNetEnum2(NR As NETRESOURCE)
Dim hEnum As Long, lpBuff As Long
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long

'Setup the NETRESOURCE input structure.
cbBuff = 10000
cCount = &HFFFFFFFF

'Open a Net enumeration operation handle: hEnum.

res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NR, hEnum)

If res = 0 Then
'Create a buffer large enough for the results.
'10000 bytes should be sufficient.
lpBuff = GlobalAlloc(GPTR, cbBuff)
'Call the enumeration function.
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
p = lpBuff
'WNetEnumResource fills the buffer with an array of
'NETRESOURCE structures. Walk through the list and print
'each remote name.
For i = 1 To cCount
CopyMemory NR, ByVal p, LenB(NR)
Form1.List1.AddItem "Network Computer #" & i & " " & PointerToString(NR.lpRemoteName)
p = p + LenB(NR)
Next i
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum) 'Close the enumeration
Else
End If
End Sub


'This is for form1 which has a list1

Private Sub Form_Load()
DoNetEnum

End Sub

[whatadonk]

Ok so now that i can get a list of computer names on a LAN,
for example

Network Name HOME
Network Computer #1 \\SomeCoputerName
Network Computer #2 \\OldComputer

i would like to be able to go back through this list of networked computer names and find an IP for Network Computers 1 & 2

i.e.

Network Computer #1 \\SomeCoputerName IP: 234.123.0.4
Network Computer #2 \\OldComputer IP: 243.123.0.7

this is because in order to initialise communication over a network using Winsock controls i need to know to the IP address of the computer to communicate with

Hope this clarifys things, thanks everyone for helping me out

whatadonk

[cas21]

'I found this on the web, but haven't tried it. Maybe it
'will get you pointed in the direction.

'If you know name of PC then you must modify GetIPHostName() function
'from http://www.vbsquare.com/howto/getip.htm


Public Function GetIPHostName(sHostName$) As String
If Not SocketsInitialize() Then
GetIPHostName = ""
Exit Function
End If
GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
SocketsCleanup

End Function

'And call:

MsgBox "IP is " & GetIPHostName(Name_your_other_PC)

[jp_schwartz]

Hi guys!!!

Where can I find the SocketsInitialize() function?

[Serge]

Here you go:

Private Sub SocketsInitialize()
    Dim WSAD As WSADATA
    Dim lngRetVal As Integer
    Dim strLowByte As String
    Dim strHighByte As String
    Dim strMsg As String

    lngRetVal = WSAStartup(WS_VERSION_REQD, WSAD)

    If lngRetVal <> 0 Then
        MsgBox "Winsock.dll is not responding."
        End
    End If

    If LoByte(WSAD.wversion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wversion) = _
        WS_VERSION_MAJOR And HiByte(WSAD.wversion) < WS_VERSION_MINOR) Then

        strHighByte = Trim(Str(HiByte(WSAD.wversion)))
        strLowByte = Trim(Str(LoByte(WSAD.wversion)))
        strMsg = "Windows Sockets version " & strLowByte & "." & strHighByte
        strMsg = strMsg & " is not supported by winsock.dll "
        MsgBox strMsg
        End
    End If

    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        strMsg = "This application requires a minimum of "
        strMsg = strMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox strMsg
        End
    End If
End Sub

Make sure you have everything declared properly.

[jp_schwartz]

An apologize to this... but how are declared the following:

WSADATA
WS_VERSION_REQD
WS_VERSION_MAJOR
WS_VERSION_MINOR
MIN_SOCKETS_REQD

Thank you very much!!!

[Serge]

Sure thing:

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1


Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type

[jp_schwartz]

Serge, I´m so sorry, but I still need some declarations from the last code you sent me.

Please..???

WSASYS_Status_Len
WSADescription_Len
HiByte
LoByte
WSAStartup
SocketsCleanup

Thank you very, very, very, very, very, very, very, very, very, very, very much!!!

[icccy]

Here are the asked declarations :

[code]
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
wVersionRequired As Long, lpWSAData As WSADATA) As Long

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Const WSASYS_Status_Len = 128

Private Const WSADescription_Len = 256

Private Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function

Private Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function

Private Function SocketsCleanup() As Long
SocketsCleanup = WSACleanup()
End Function

[badgers]

WOW
how long did it take to come up with that code!!!!!!
please tell me you didn't see this post and then
come up with that off the top of your head!!!

[amitabh]

Originally posted by cas21
'I found this on the web, but haven't tried it. Maybe it
'will get you pointed in the direction.

'If you know name of PC then you must modify GetIPHostName() function
'from http://www.vbsquare.com/howto/getip.htm

cas21
The link gives a 404 error.

[cas21]

'Here is the complete working program
'This will get the network name and all computers booted to the LAN & IPs

'Paste this into a module

Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String

Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Public 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

Public Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" ( _
ByVal hEnum As Long, _
lpcCount As Long, _
ByVal lpBuffer As Long, _
lpBufferSize As Long) As Long

Public Declare Function WNetCloseEnum Lib "mpr.dll" ( _
ByVal hEnum As Long) As Long

'RESOURCE ENUMERATION.
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3

Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_UNKNOWN = &HFFFF

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000

Public Const GMEM_FIXED = &H0
Public Const GMEM_ZEROINIT = &H40
Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Public Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function CopyPointer2String Lib "KERNEL32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long

Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
Public Const WSADescription_Len = 256
Public Const WSASYS_Status_Len = 128

Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

Public Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, _
lpWSAData As WSADATA) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Public Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal _
hpvSource&, ByVal cbCopy As Long)

Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function

Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function

Sub SocketsCleanup()
Dim lReturn As Long
lReturn = WSACleanup()
If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If
End Sub

Public Function GetIPHostName(sHostName$) As String
If Not SocketsInitialize Then
GetIPHostName = ""
Exit Function
End If
GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
SocketsCleanup
End Function

Public Sub DoNetEnum()
Dim hEnum As Long, lpBuff As Long, NR As NETRESOURCE
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long

'Setup the NETRESOURCE input structure.
NR.lpRemoteName = 0
cbBuff = 10000
cCount = &HFFFFFFFF

'Open a Net enumeration operation handle: hEnum.
res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NR, hEnum)

If res = 0 Then
'Create a buffer large enough for the results.
'10000 bytes should be sufficient.
lpBuff = GlobalAlloc(GPTR, cbBuff)
'Call the enumeration function.
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
p = lpBuff
'WNetEnumResource fills the buffer with an array of
'NETRESOURCE structures. Walk through the list and list
'each local and remote name.
For i = 1 To cCount
' All we get back are the Global Network Containers --- Enumerate each of these
CopyMemory NR, ByVal p, LenB(NR)
Form1.Show
Form1.List1.AddItem "Network Name " & PointerToString(NR.lpRemoteName)

DoNetEnum2 NR
p = p + LenB(NR)
Next i
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum) 'Close the enumeration
End If
End Sub

Public Function PointerToString(p As Long) As String
'The values returned in the NETRESOURCE structures are pointers to
'ANSI strings so they need to be converted to Visual Basic Strings.
Dim s As String
s = String(255, Chr$(0))
CopyPointer2String s, p
PointerToString = Left(s, InStr(s, Chr$(0)) - 1)
End Function

Public Sub DoNetEnum2(NR As NETRESOURCE)
Dim hEnum As Long, lpBuff As Long
Dim cbBuff As Long, cCount As Long
Dim p As Long, res As Long, i As Long

'Setup the NETRESOURCE input structure.
cbBuff = 10000
cCount = &HFFFFFFFF

'Open a Net enumeration operation handle: hEnum.

res = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NR, hEnum)

If res = 0 Then
'Create a buffer large enough for the results.
'10000 bytes should be sufficient.
lpBuff = GlobalAlloc(GPTR, cbBuff)
'Call the enumeration function.
res = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
If res = 0 Then
p = lpBuff
'WNetEnumResource fills the buffer with an array of
'NETRESOURCE structures. Walk through the list and print
'each remote name.
For i = 1 To cCount
CopyMemory NR, ByVal p, LenB(NR)
ip_address = ""
GetIPNums (PointerToString(NR.lpRemoteName))
Form1.List1.AddItem "Network Computer #" & i & " " & PointerToString(NR.lpRemoteName) & vbTab & "IP: " & ip_address
p = p + LenB(NR)
Next i
End If
If lpBuff <> 0 Then GlobalFree (lpBuff)
WNetCloseEnum (hEnum) 'Close the enumeration
End If
End Sub
Public Function GetIPNums(Compname)
hostent_addr = gethostbyname(Mid(Compname, 3))
If hostent_addr = 0 Then
MsgBox "Can't resolve name."
Exit Function
End If '
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)

End Function

Public Function SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte, sHighByte, sMsg As String

iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

If iReturn <> 0 Then
SocketsInitialize = strWinsockNotResponding
Exit Function
End If

If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
SocketsInitialize = "Windows Sockets version " & sLowByte & "." & sHighByte & _
" is not supported by winsock.dll "
Exit Function
End If

'iMaxSockets is not used in winsock 2. So the following check is only
'necessary for winsock 1. If winsock 2 is requested,
'the following check can be skipped.

If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
SocketsInitialize = "This application requires a minimum of " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
Exit Function

End If
SocketsInitialize = ""
End Function




'Put this on a form with a list1

Private Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End Sub

Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
DoNetEnum
SocketsInitialize
End Sub



'There you go

[JamesM]

cas21, I get a can't resolve name error?

[cas21]

'Sorry about that. Add the following to the module

Dim strWinsockNotResponding As Long

'Also add the winsock control to Form

[Edited by cas21 on 01-20-2001 at 12:48 PM]

[JamesM]

Still the same error?

[cas21]

'I have vb6. This works on my computer
'Did you put a winsock control on the form?

[JamesM]

I am also using vb6, and yep put the winsock control on the form?

I am trying to run it over an NT network at work.

[JamesM]

I'll try it again tommorrow morning, 60 hr week this week... time to go home and get some shut eye.

[badgers]

I am on NT also, I get a msgbox indicating:
"Can't Resolve Name"
I get a list of some things but not much.
I think that this program depends on network security settings under my login.
it seems to "work"

[Babbalouie]

Try this code...it's a bit shorter, not so many loose ends...

Public Function GetComputersInADomain(aryUsers() As String) As Long

    'Notes:  Requires a global array to be pased in if list of users wanted
    'Notes:  Very slow if domain name not valid
    'Notes:  Must set a reference to Active DS Type Library for this to work
    
Dim TheDomain As IADsDomain
Dim Computer As IADsComputer
Dim strDomain As String
Dim x As Long

    'Accept the Domain name
    strDomain = InputBox("Domain Name: ")

    'Use the WinNT Directory Services
    strDomain = "WinNT://" & strDomain

    'Create the Domain object
    Set TheDomain = GetObject(strDomain)

    'Search for Computers in the Domain
    TheDomain.Filter = Array("Computer")

    'Enumerate each computer in the domain
    For Each Computer In TheDomain
        x = x + 1
        ReDim Preserve aryUsers(x)
        aryUsers(x) = Computer.Name
    Next Computer

    'Clean up
    GetComputersInADomain = x
    Set Computer = Nothing
    Set TheDomain = Nothing

End Function

[badgers]

am i the only one who does not have the Active DS type library?

[stever2003]

I am trying to make a client/server application for a LAN. Could somebody suggest a code to find machines on the LAN that are only running my software? Thanx.