example for gethostbyaddr function

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 (haven't figured this yet)
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

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 NameLookup(ByVal LookupName As String) As String
' routine to convert hostname to IP
' this routine actually gets all known aliases
' and IP addresses but only returns the first IP
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

'default values
iAliasCount = 0
iAddressCount = 0
NameLookup = ""
' lookup by IP or name
If IsNumeric(Left$(LookupName, 1)) Then
  Debug.Print "Resolve IP: " & LookupName
  lHostent = gethostbyaddr(TextToIP(LookupName), 4, AF_INET)
Else
  Debug.Print "Resolve Name: " & LookupName
  sTarget = LookupName & vbNullChar
  lHostent = gethostbyname(sTarget) ' do actual winsock call
End If
If lHostent = 0 Then
  NameLookup = 0
  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
  LookupName = Space$(nbytes)
  CopyMemory ByVal LookupName, ByVal lHEName, nbytes
Debug.Print "Full name: " & LookupName
End If

' get all IP addresses
CopyMemory lIPPointer, ByVal lHEAddress, 4
Do While lIPPointer ' end-of-list is null pointer
  ReDim Preserve sAddress(iAddressCount + 1)
  sAddress(iAddressCount) = Space$(4)
  CopyMemory ByVal sAddress(iAddressCount), ByVal lIPPointer, 4
Debug.Print "IP address " & CStr(iAddressCount) & _
  ": " & IPToText(sAddress(iAddressCount))
  CopyMemory ByVal lHEAddress, 0&, 4 ' null for next call
  iAddressCount = iAddressCount + 1
  ' move to next IP
  lHEAddress = lHEAddress + 4
  CopyMemory lIPPointer, ByVal lHEAddress, 4
Loop

' get any/all aliases
CopyMemory lAPointer, ByVal lHEAlias, 4
Do While lAPointer ' end-of-list is a null
  ReDim Preserve sAlias(iAliasCount + 1)
  nbytes = lstrlen(ByVal lAPointer)
  sAlias(iAliasCount) = Space$(nbytes)
  CopyMemory ByVal sAlias(iAliasCount), ByVal lAPointer, nbytes
Debug.Print "Alias " & CStr(iAliasCount) & ": " & _
  sAlias(iAliasCount)
  CopyMemory ByVal lHEAlias, 0&, 4
  iAliasCount = iAliasCount + 1
  ' move to next IP
  lHEAlias = lHEAlias + 4
  CopyMemory lAPointer, ByVal lHEAlias, 4
Loop

If iAddressCount > 0 Then
  ' success
  NameLookup = IPToText(sAddress(0))
Else
  NameLookup = "" ' weird!
End If
End Function

Private Sub cmdResolve_Click()
Dim LookupName As String
Dim sIP As String
LookupName = txtIP.Text
sIP = NameLookup(LookupName)
txtIP.Text = sIP
End Sub

Private Sub cmdPing_Click()
Dim lAddress As Long ' IP address to ping
Dim lTimeOut As Long ' Timeout in milliseconds
Dim udtIRO As ICMPReqOpt ' ICMP Request Options
Dim udtIER As ICMPEchoReply ' ICMP Response
Dim bytResponse(1 To 4096) As Byte ' response buffer
Dim x As Long ' scratch
' convert IP Address
lAddress = TextToIP(Trim$(txtIP.Text))
' build request packet
udtIRO.TTL = Val("0" & txtTimeToLive.Text)
udtIRO.tos = ICMP_ECHO_REQUEST ' we want a simple PING
udtIRO.options = "" ' no options...
udtIRO.optsize = Len(udtIRO.options)
udtIRO.flags = ICMP_FLAG_NO_FRAGMENT
' do it
lTimeOut = Val("0" & txtTimeOut.Text)
x = IcmpSendEcho(hICMP, lAddress, Space$(32), 32, _
  udtIRO, bytResponse(1), UBound(bytResponse), _
  lTimeOut)
If x = 0 Then
  ' call failed
  lblAddress.Caption = "ICMP ERROR"
  lblError.Caption = CStr(IcmpGetLastError())
Else
  ' copy buffer to structure to make it easier
  CopyMemory udtIER.Address(1), bytResponse(1), LenB(udtIER)
  lblAddress.Caption = CStr(udtIER.Address(1)) & "." & _
    CStr(udtIER.Address(2)) & "." & _
    CStr(udtIER.Address(3)) & "." & _
    CStr(udtIER.Address(4))
  lblError.Caption = CStr(udtIER.status) & ":" & _
    CStr(udtIER.triptime)
End If
End Sub

Private Sub Form_Load()
Dim udtWSAData As WSADATA
If WSAStartup(257, udtWSAData) 0 Then
  MsgBox "Unable to initialize Winsock", vbOKOnly, "Winsock Error"
  Unload Me
  Exit Sub
End If
hICMP = IcmpCreateFile()
If hICMP = 0 Then
  MsgBox "Unable to initialize ICMP", vbOKOnly, "ICMP Error"
  Unload Me
  Exit Sub
End If
txtIP.Text = MyHostName
End Sub

Private Sub Form_Unload(Cancel As Integer)
If hICMP Then Call IcmpCloseHandle(hICMP)
Call WSACleanup
Set Form1 = Nothing
End Sub

this don't work it's always return cannot initialise winsock

good it's work thank alot ;)