Reverse DNS Lookup from IP

Posted on 2000-04-07
Last Modified: 2013-11-13
I have a bunch of IPs that I need to convert back to their names (from a proxy server log) and want to resolve the addresses to the names.
I know a bit about how to do it, but would like some code to make it easy.
All I need is the function to do it, I can handle bringing in the IPs.
Question by:jagoodie
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 20

Accepted Solution

hes earned 50 total points
ID: 2694560
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_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_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
' 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_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
    ' 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)
  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

' 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) & ": " & _
  CopyMemory ByVal lHEAlias, 0&, 4
  iAliasCount = iAliasCount + 1
  ' move to next IP
  lHEAlias = lHEAlias + 4
  CopyMemory lAPointer, ByVal lHEAlias, 4

If iAddressCount > 0 Then
  ' success
  NameLookup = LookupName
  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)
' do it
lTimeOut = Val("0" & txtTimeOut.Text)
x = IcmpSendEcho(hICMP, lAddress, Space$(32), 32, _
  udtIRO, bytResponse(1), UBound(bytResponse), _
If x = 0 Then
  ' call failed
  lblAddress.Caption = "ICMP ERROR"
  lblError.Caption = CStr(IcmpGetLastError())
  ' 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)) & "." & _
  lblError.Caption = CStr(udtIER.status) & ":" & _
End If
End Sub

Private Sub Command1_Click()
Dim a As String
a = NameLookup("")
Text1.Text = a
End Sub

Private Sub Form_Load()
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
Text1.Text = MyHostName
End Sub

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

I use a textbox and a command button

Author Comment

ID: 2694588

Expert Comment

ID: 2699185
there's also a freeware
ocx that does foreward
and reverse dns lookups.
that's all it does.

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question