asked on

Network IP and Hostname

I need to scan thru a LAN and list all active computers. Get their hostname and username. I have made a subnet-scanner, which scans forexample 192.168.2. and a range from 0 to 255.
This doesn't go very quickly, so I wondered if there was some other way to do this.

If 200p is not enough, I can give you more. Also, my internet connection is VERY restricted, so it might be a while before I check for an response.

Thanks,

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com

ASKER CERTIFIED SOLUTION

mcrider

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mannen

ASKER

Well, this looks good. Trying the code tonight.

Thanks,

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com

mannen

ASKER

Thanks, that was a complete answer to my question. BUT:

I really asked wrong, what I wanted to know was: How do I get a computers name on a network, using the computers IP.

I am giving you the points, since you answered this question though...

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com

mcrider

Ok, here you go... Add the following to a MODULE then you can call this anywhere in your program to convert an IP address to a hostname:

Dim lHostName As String
lHostName = LookupIP("127.0.0.1")

The variable lHostName will contain the hostname of whatever IP address you pass...

Since this is a completely different answer, I would appreciate it if you open a new question with the title "FOR MCRIDER ONLY" and assign some points to it so I can get credit for this.

Cheers!

THE CODE:

Option Explicit
Private Type ICMPReqOpt
TTL As Byte ' time-to-live
tos As Byte ' type-of-service
flags As Byte ' see below
optsize As Byte ' length of options string
options As String ' use empty string
End Type
Private Type ICMPEchoReply
Address(1 To 4) As Byte ' address of system responding
status As Long ' error code
triptime As Long ' time in milliseconds
datasize As Integer ' buffer size
reserved As Integer ' not used
replydata As String ' buffer returned
ipoptions As ICMPReqOpt ' options structure
End Type
' ICMP API calls
Private Declare Function IcmpCreateFile Lib "ICMP.DLL" () As Long
Private Declare Function IcmpCloseHandle Lib "ICMP.DLL" _
(ByVal lngHandle As Long) As Integer
Private Declare Function IcmpSendEcho Lib "ICMP.DLL" _
(ByVal lngHandle As Long, ByVal lIP As Long, _
strData As String, ByVal intDataLen As Integer, _
usrOpt As ICMPReqOpt, bytBuff As Byte, _
ByVal lngRepLen As Long, ByVal lTimeOut As Long) As Long
Private Declare Function IcmpGetLastError Lib "wsock32.dll" _
Alias "WSAGetLastError" () As Long
' ICMP error codes
Private Const ICMP_SUCCESS = 0
Private Const ICMP_BUFFER_TOO_SMALL = 11001
Private Const ICMP_NET_UNREACHABLE = 11002
Private Const ICMP_HOST_UNREACHABLE = 11003
Private Const ICMP_DEST_PROT_UNREACHABLE = 11004
Private Const ICMP_DEST_PORT_UNREACHABLE = 11005
Private Const ICMP_NO_RESOURCES = 11006
Private Const ICMP_BAD_OPTION = 11007
Private Const ICMP_HW_ERROR = 11008
Private Const ICMP_PACKET_TOO_BIG = 11009
Private Const ICMP_REQ_TIMED_OUT = 11010
Private Const ICMP_BAD_REQ = 11011
Private Const ICMP_BAD_ROUTE = 11012
Private Const ICMP_TTL_EXPIRED_TRANSMIT = 11013
Private Const ICMP_TTL_EXPIRED_REASSEM = 11014
Private Const ICMP_PARAM_PROBLEM = 11015
Private Const ICMP_SOURCE_QUENCH = 11016
Private Const ICMP_OPTION_TOO_BIG = 11017
Private Const ICMP_BAD_DESTINATION = 11018
Private Const ICMP_ADDRESS_DELETED = 11019
Private Const ICMP_SPEC_MTU_CHANGE = 11020
Private Const ICMP_MTU_CHANGE = 11021
Private Const ICMP_UNLOAD = 11022
Private Const ICMP_GENERAL_FAILURE = 11050
Private Const ICMP_PENDING = 11255
' ICMP flags
Private Const ICMP_FLAG_NO_FRAGMENT = 2
' ICMP type-of-service options
Private Const ICMP_ECHO_REQUEST = 7
Private Const ICMP_END_OF_LIST = 0
Private Const ICMP_SECURITY = 1
Private Const ICMP_LOOSE_SOURCE_ROUTE = &H82
Private Const ICMP_STRICT_SOURCE_ROUTE = &H83
Private Const ICMP_RECORD_ROUTE = &H89
Private Const ICMP_TIMESTAMP = 7
Private Const ICMP_STREAM_id = &H44
Private Const ICMP_NOOP = &H88
' we also need some basic Winsock stuff
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Const AF_INET = 2

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
imaxudp As Integer
lpszvenderinfo As Long
End Type
Private Declare Function gethostname Lib "wsock32.dll" _
(ByVal hostname As String, ByVal nbytes As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" _
(ByVal hostname As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32.dll" _
(haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
(ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
' and a way to copy memory directly...
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(lpString As Any) As Long
' finally, we need a handle for ICMP
Private hICMP As Long
Function StartWSA() As Boolean
Dim udtWSAData As WSADATA
StartWSA = True
If WSAStartup(257, udtWSAData) <> 0 Then
MsgBox "Unable to initialize Winsock", vbOKOnly, "Winsock Error"
StartWSA = False
Exit Function
End If
hICMP = IcmpCreateFile()
If hICMP = 0 Then
MsgBox "Unable to initialize ICMP", vbOKOnly, "ICMP Error"
StartWSA = False
End If
End Function
Private Function TextToIP(ByVal IPAddress As String) As Long
Dim x As Integer ' scratch
Dim iOctet As Integer ' octet value
Dim bytIP(1 To 4) As Byte ' temp IP storage
Dim lIP As Long ' IP value
Dim iDots As Integer ' count of dots found
lIP = 0
iOctet = 0
iDots = 0
For x = 1 To Len(IPAddress)
If Mid$(IPAddress, x, 1) = "." Then
iDots = iDots + 1
If iDots > 3 Then Exit For ' bad format!
bytIP(iDots) = iOctet
iOctet = 0
Else
' add digit but restrict to 8 bits
iOctet = (iOctet * 10 + Val("0" & Mid$(IPAddress, x, 1))) And 255
End If
Next 'x
bytIP(4) = iOctet ' save last one
CopyMemory lIP, bytIP(1), 4 ' copy to LONG value
TextToIP = lIP ' copy to return value
End Function
Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Private Function MyHostName() As String
Dim sTemp As String
Dim x As Long
sTemp = Space$(256)
x = gethostname(sTemp, Len(sTemp))
x = InStr(sTemp, vbNullChar)
If x > 0 Then sTemp = Left$(sTemp, x - 1)
MyHostName = sTemp
End Function
Function LookupIP(ByVal IP_Address As String) As String
' routine to convert IP to hostname
Dim x As Long ' scratch
Dim nbytes As Long
Dim sTarget As String ' null-delimited hostname
Dim lHostent As Long ' address of hostent structure
Dim lHEName As Long ' address of name pointer
Dim lHEAlias As Long ' address of alias pointer
Dim lHEAddress As Long ' address of address pointer
Dim lIPPointer As Long ' address of IP address
Dim lAPointer As Long ' address of Alias

Dim iAliasCount As Long
Dim iAddressCount As Long
Dim sIP() As String
Dim sAlias() As String
Dim sAddress() As String

'STARTUP SOCKET
If StartWSA() = False Then
LookupIP = ""
Exit Function ' failed!
End If
'default values
iAliasCount = 0
iAddressCount = 0
LookupIP = ""
' lookup by IP or name
If IsNumeric(Left$(IP_Address, 1)) Then
lHostent = gethostbyaddr(TextToIP(IP_Address), 4, AF_INET)
Else
sTarget = IP_Address & vbNullChar
lHostent = gethostbyname(sTarget) ' do actual winsock call
End If
If lHostent = 0 Then
LookupIP = ""
Exit Function ' failed!
End If
lHEName = lHostent ' set pointer addresses
lHEAlias = lHostent + 4
lHEAddress = lHostent + 12
' convert addresses of pointers to the pointers...
CopyMemory lHEName, ByVal lHEName, 4
CopyMemory lHEAlias, ByVal lHEAlias, 4
CopyMemory lHEAddress, ByVal lHEAddress, 4

' Get resolved hostname
nbytes = lstrlen(ByVal lHEName)
If nbytes > 0 Then
IP_Address = Space$(nbytes)
CopyMemory ByVal IP_Address, ByVal lHEName, nbytes
LookupIP = IP_Address
End If

'CLEAN UP SOCKET
If hICMP Then Call IcmpCloseHandle(hICMP)
Call WSACleanup
End Function

mannen

ASKER

Thanks!!

Ofcourse I will give you some more points...

I will post a new question with your suggested title 'For McRider only' in the next 24 hours.

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com

mcrider

Cool! Glad I could help you again!

Cheers!

mannen

ASKER

Oops... don't jump through the roof yet :(

Sorry, but the code didn't work, maybe I am doing something wrong, I don't know. First I tried to implement it to my program, that didn't work, then I did this:

1. Opened a new project.
2. Added your code to a module.
3. Added a form with two textboxes and one commandbutton.
4. Made the commandbutton code say:
Text2.Text = LookupIP(Text1.Text)

This didn't work, do you have any idea?

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com

mcrider

Whoa! I just did some testing and found a HUGE bug in microsoft's winsock driver!

The gethostbyaddr API will only work properly if there is an entry in the \WINDOWS\HOSTS file for the IP address. This is NOT supposed to happen with DNS enabled!

Ok... Using the code I gave you, try this:

Add an entry to the HOSTS file for one of your systems you're trying to identify and run your code. If you don't have a HOSTS file in the WINDOWS directory, microsoft provides a sample file called HOSTS.SAM. Just copy the HOSTS.SAM to HOSTS and then edit it to add a host... The code will work after you do this...

Cheers!

mannen

ASKER

I'm terribly sorry, McRider...

But I have had a VERY busy time at work the last weeks, and forgot all about my question. I am sorry, but this solution is not acceptable... You realize, ofcourse, that it is not your fault. If you want the points for this answer, I will give you them for your trouble.

If you want the points, just say so in a comment here.

Thanks for some excellent help and thanks for trying. You are a really good programmer :)

Vidar Braut Haarr
AmigoSoft Productions
folk@popmail.com