Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to detect terminals on a network?

Status
Not open for further replies.

sairajendra

Programmer
Aug 22, 2001
9
0
0
ID
Hi all,

How to detect terminals on a network?
Any idea is accepted.
(I think it can be done either by winsocks or API calls!!)
Please help!!!
 
'Win98 and VB6

'This will get the network name and all computers and their IPs, that are 'booted to the LAN
'Paste this into a module

Option Explicit

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
Dim strWinsockNotResponding As Long

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 &quot;Socket error &quot; & Trim$(Str$(lReturn)) & &quot; occurred in Cleanup &quot;
End
End If
End Sub

Public Function GetIPHostName(sHostName$) As String
If Not SocketsInitialize Then
GetIPHostName = &quot;&quot;
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 &quot;Network Name &quot; & 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 = &quot;&quot;
GetIPNums (PointerToString(NR.lpRemoteName))
Form1.List1.AddItem &quot;Network Computer #&quot; & i & &quot; &quot; & PointerToString(NR.lpRemoteName) & vbTab & &quot;IP: &quot; & 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 &quot;Can't resolve name.&quot;
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) & &quot;.&quot;
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 = &quot;Windows Sockets version &quot; & sLowByte & &quot;.&quot; & sHighByte & _
&quot; is not supported by winsock.dll &quot;
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 = &quot;This application requires a minimum of &quot; & _
Trim$(Str$(MIN_SOCKETS_REQD)) & &quot; supported sockets.&quot;
Exit Function

End If
SocketsInitialize = &quot;&quot;
End Function



'Put this on a form with a list1 and a Winsock1 and a Command1


Private Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End Sub

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

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top