DNS lookup from within VB 6.0

We have an app which talks SNMP with a remote host. At connect time the user has to enter an ip address (dotted quad). I'd like to let them enter the plaintext hostname and let our app do the name->address translation.

does anyone know of something that already exists in VB or winsock APIs to do this?
Who is Participating?
mcriderConnect With a Mentor Commented:
There is a lot of code here because this can also perform a PING in VB so, Add the following to a MODULE in your program, then you can do this:


X = GetHostInfo("www.experts-exchange.com")
Debug.print X.hAddress 'THIS IS THE IP ADDRESS...



Option Explicit
Private Const WS32_NOT_ENOUGH_SOCKETS = -4
Private Const WS32_NOT_SUPPORTED = -3
Private Const WS32_NOT_RESPONDING = -2
Private Const IP_STATUS_BASE = 11000
Private Const IP_SUCCESS = 0
Private Const IP_BUF_TOO_SMALL = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Private Const IP_NO_RESOURCES = (11000 + 6)
Private Const IP_BAD_OPTION = (11000 + 7)
Private Const IP_HW_ERROR = (11000 + 8)
Private Const IP_PACKET_TOO_BIG = (11000 + 9)
Private Const IP_REQ_TIMED_OUT = (11000 + 10)
Private Const IP_BAD_REQ = (11000 + 11)
Private Const IP_BAD_ROUTE = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Private Const IP_PARAM_PROBLEM = (11000 + 15)
Private Const IP_SOURCE_QUENCH = (11000 + 16)
Private Const IP_OPTION_TOO_BIG = (11000 + 17)
Private Const IP_BAD_DESTINATION = (11000 + 18)
Private Const IP_ADDR_DELETED = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Private Const IP_MTU_CHANGE = (11000 + 21)
Private Const IP_UNLOAD = (11000 + 22)
Private Const IP_ADDR_ADDED = (11000 + 23)
Private Const IP_GENERAL_FAILURE = (11000 + 50)
Private Const MAX_IP_STATUS = 11000 + 50
Private Const IP_PENDING = (11000 + 255)
Private Const PING_TIMEOUT = 200
Private Const WS_VERSION_REQD = &H101
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type
    Address         As Long
    status          As Long
    RoundTripTime   As Long
    DataSize        As Integer
    Reserved        As Integer
    DataPointer     As Long
    Options         As ICMP_OPTIONS
    Data            As String * 250
End Type
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
    hName As String
    hAddress As String
    hStatus As String
End Type
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
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
    (ByVal IcmpHandle As Long) As Long
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
    (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _
    ByVal RequestData As String, ByVal RequestSize As Integer, _
    ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
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 Declare Function gethostname Lib "WSOCK32.DLL" _
   (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (ByVal szHost As String) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, _
    ByVal hpvSource As Long, ByVal cbCopy As Long)
Private G_lhEntry As LHOSTENTRY

Public Function GetHostInfo(lHost As String) As LHOSTENTRY
    Dim rVal As Long
    Dim hostname As String * 256
    Dim hostent_addr As Long
    Dim host As HOSTENT
    Dim hostip_addr As Long
    Dim temp_ip_address() As Byte
    Dim iVal As Integer
    Dim ip_address As String
    rVal = WSAStartup(WS_VERSION_REQD, WSAD)
    If rVal <> 0 Then
        GetHostInfo.hStatus = WS32_NOT_RESPONDING
        Exit Function
    End If
    If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
        CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
        GetHostInfo.hStatus = WS32_NOT_SUPPORTED
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        GetHostInfo.hStatus = WS32_NOT_ENOUGH_SOCKETS
        Exit Function
    End If
    GetHostInfo.hStatus = SOCKET_ERROR
    GetHostInfo.hName = Trim$(LCase$(lHost))
    hostname = Left$(lHost + String(256, Chr$(0)), 256)
    hostent_addr = gethostbyname(hostname)
    If hostent_addr = 0 Then
        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 iVal = 1 To host.hLength
        ip_address = ip_address & temp_ip_address(iVal) & "."
    ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    GetHostInfo.hAddress = ip_address
    GetHostInfo.hStatus = IP_SUCCESS
End Function

Public Function GetPingMsg(status As Long) As String
    Dim msg As String
    Select Case status
        Case WS32_NOT_ENOUGH_SOCKETS:  msg = "Not enough sockets available"
        Case WS32_NOT_SUPPORTED:       msg = "Socket version not supported"
        Case WS32_NOT_RESPONDING:      msg = "Winsock 32 not responding"
        Case IP_SUCCESS:               msg = "OK"
        Case IP_BUF_TOO_SMALL:         msg = "IP buf too small"
        Case IP_DEST_NET_UNREACHABLE:  msg = "Destination network unreachable"
        Case IP_DEST_HOST_UNREACHABLE: msg = "Destination host unreachable"
        Case IP_DEST_PROT_UNREACHABLE: msg = "Destination protocol unreachable"
        Case IP_DEST_PORT_UNREACHABLE: msg = "Destination port unreachable"
        Case IP_NO_RESOURCES:          msg = "IP no resources"
        Case IP_BAD_OPTION:            msg = "IP bad option"
        Case IP_HW_ERROR:              msg = "IP hardware error"
        Case IP_PACKET_TOO_BIG:        msg = "IP packet too big"
        Case IP_REQ_TIMED_OUT:         msg = "Request timed out"
        Case IP_BAD_REQ:               msg = "Bad request"
        Case IP_BAD_ROUTE:             msg = "Bad route"
        Case IP_TTL_EXPIRED_TRANSIT:   msg = "IP TTL expired transit"
        Case IP_TTL_EXPIRED_REASSEM:   msg = "IP TTL expired reassem"
        Case IP_PARAM_PROBLEM:         msg = "IP param problem"
        Case IP_SOURCE_QUENCH:         msg = "IP source quench"
        Case IP_OPTION_TOO_BIG:        msg = "IP option too big"
        Case IP_BAD_DESTINATION:       msg = "IP bad destination"
        Case IP_ADDR_DELETED:          msg = "IP address deleted"
        Case IP_SPEC_MTU_CHANGE:       msg = "IP spec mtu change"
        Case IP_MTU_CHANGE:            msg = "IP mtu change"
        Case IP_UNLOAD:                msg = "IP unload"
        Case IP_ADDR_ADDED:            msg = "IP address added"
        Case IP_GENERAL_FAILURE:       msg = "IP general failure"
        Case IP_PENDING:               msg = "IP pending"
        Case PING_TIMEOUT:             msg = "Ping timeout"
        Case Else:                     msg = "Unknown message returned"
    End Select
    GetPingMsg = msg
End Function

Private Function CvtHiByte(ByVal wParam As Integer)
    CvtHiByte = wParam \ &H100 And &HFF&
End Function

Private Function CvtLoByte(ByVal wParam As Integer)
    CvtLoByte = wParam And &HFF&
End Function

Public Function IsHostAlive(lHost As String) As Boolean
    Dim pos As Integer
    IsHostAlive = False
    SysPing lHost, ECHO
    If ECHO.status = IP_SUCCESS Then IsHostAlive = True
End Function

Public Function GetPingString(lHost As String) As String
    Dim pos As Integer
    SysPing lHost, ECHO
    If ECHO.status = IP_SUCCESS Then
        GetPingString = "Reply from " & G_lhEntry.hAddress & ": bytes=" & Trim$(CStr(ECHO.DataSize)) _
            & " time=" & Trim$(CStr(ECHO.RoundTripTime)) & "ms TTL=" _
            & Trim$(CStr(ECHO.Options.Ttl))
        GetPingString = GetPingMsg(ECHO.status)
    End If
End Function

Private Function SysPing(lhostname As String, ECHO As ICMP_ECHO_REPLY, Optional EchoString As String) As Long
    Dim hPort As Long
    Dim dwAddr As Long
    Dim iOpt As Long
    Dim rVal As Long
    Dim eString As String
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
    eString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ012345": If Not EchoString = "" Then eString = EchoString
    G_lhEntry = GetHostInfo(lhostname)
    If Not G_lhEntry.hStatus = 0 Then
        SysPing = IP_BAD_DESTINATION
        ECHO.status = IP_BAD_DESTINATION
        Exit Function
    End If
    dwAddr = CvtIPAddrClng(G_lhEntry.hAddress)
    If dwAddr = 0 Then
        SysPing = IP_BAD_DESTINATION
        ECHO.status = IP_BAD_DESTINATION
        Exit Function
    End If
    rVal = WSAStartup(WS_VERSION_REQD, WSAD)
    If rVal <> 0 Then
        SysPing = WS32_NOT_RESPONDING
        ECHO.status = WS32_NOT_RESPONDING
        Exit Function
    End If
    If CvtLoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (CvtLoByte(WSAD.wversion) = WS_VERSION_MAJOR And _
        CvtHiByte(WSAD.wversion) < WS_VERSION_MINOR) Then
        SysPing = WS32_NOT_SUPPORTED
        ECHO.status = WS32_NOT_SUPPORTED
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        SysPing = WS32_NOT_ENOUGH_SOCKETS
        ECHO.status = WS32_NOT_ENOUGH_SOCKETS
        Exit Function
    End If
    hPort = IcmpCreateFile()
    rVal = IcmpSendEcho(hPort, dwAddr, eString, Len(eString), 0, ECHO, Len(ECHO), PING_TIMEOUT)
    If rVal = 1 Then
        SysPing = IP_SUCCESS
        If ECHO.status = 0 Then ECHO.status = IP_DEST_NET_UNREACHABLE
        SysPing = ECHO.status * -1
    End If
    IcmpCloseHandle hPort
End Function
Private Function CvtIPAddrClng(ByVal tmp As String) As Long
    Dim iVal As Integer
    Dim IpWord(4) As String
    CvtIPAddrClng = 0: iVal = 0
    While InStr(tmp, ".") > 0
        iVal = iVal + 1
        IpWord(iVal) = Mid(tmp, 1, InStr(tmp, ".") - 1)
        tmp = Mid(tmp, InStr(tmp, ".") + 1)
    iVal = iVal + 1
    IpWord(iVal) = tmp
    If iVal <> 4 Then Exit Function
    CvtIPAddrClng = Val("&H" & Right("00" & Hex(IpWord(4)), 2) & _
        Right("00" & Hex(IpWord(3)), 2) & Right("00" & Hex(IpWord(2)), 2) & _
        Right("00" & Hex(IpWord(1)), 2))
End Function
The WinSock *control* (or the higher-level msinet.ocx) will look up host names automatically for you. It will also return a host name after you successfully connect with an IP number.

However, if you want do do *only* the DNS lookup without actually sending packets to the host in question, then you'll need to use the API directly. In that case, yell an I'll add a class module that does just that. Or, if you need more than just one IP to a name or vice versa, the control will not do, but my class will.

Oops, mcrider was quicker - his code seems good, too on a first glance, my only complaint'd be that CvtIPAddrClng could be substituted more elegantly by a function exported by the winsock DLL itself...
nicholsoAuthor Commented:
thanks. Yeah it's way too much code for my purposes, but I was able to strip it down and works great.

thanks again.
And if you ever need it, you have the code to ping systems... One of the cooler functions in that code I gave you is "IsHostAlive".  It returns a TRUE or a FALSE if the host passed on the argument can be connected to...

Thanks for the points! Glad I could help!

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.