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
Printable View
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
Sure thing! Add a Listbox (List1) and a Command Button (Command1):
This will enumerate all computers in the current domain or workgroup.Code: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 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 : -
Hope this helps in any way.Code:txtText1.text = Winsock1.LocalIP
'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
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
'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)
Hi guys!!!
Where can I find the SocketsInitialize() function?
Here you go:
Make sure you have everything declared properly.Code: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
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!!!
Sure thing:
Code: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
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!!!
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
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!!!:)
cas21Quote:
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
The link gives a 404 error.
'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
cas21, I get a can't resolve name error?
'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]
Still the same error? :confused:
'I have vb6. This works on my computer
'Did you put a winsock control on the form?
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.
I'll try it again tommorrow morning, 60 hr week this week... time to go home and get some shut eye.
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"
Try this code...it's a bit shorter, not so many loose ends...
Code: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
am i the only one who does not have the Active DS type library?
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.