Solved

DNS lookup from within VB 6.0

Posted on 2000-03-10
4
260 Views
Last Modified: 2013-11-13
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?
0
Comment
Question by:nicholso
  • 2
4 Comments
 
LVL 14

Accepted Solution

by:
mcrider earned 100 total points
Comment Utility
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:

Dim X as LHOSTENTRY

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


Cheers!®©


THE CODE:


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 WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Type ICMP_OPTIONS
    Ttl             As Byte
    Tos             As Byte
    Flags           As Byte
    OptionsSize     As Byte
    OptionsData     As Long
End Type
Private Type ICMP_ECHO_REPLY
    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
Public Type LHOSTENTRY
    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 WSAD As WSADATA
    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
        WSACleanup
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        GetHostInfo.hStatus = WS32_NOT_ENOUGH_SOCKETS
        WSACleanup
        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
        WSACleanup
        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) & "."
    Next
    ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    GetHostInfo.hAddress = ip_address
    GetHostInfo.hStatus = IP_SUCCESS
    WSACleanup
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 ECHO As ICMP_ECHO_REPLY
    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 ECHO As ICMP_ECHO_REPLY
    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))
    Else
        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 WSAD As WSADATA
    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
        WSACleanup
        Exit Function
    End If
    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        SysPing = WS32_NOT_ENOUGH_SOCKETS
        ECHO.status = WS32_NOT_ENOUGH_SOCKETS
        WSACleanup
        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
    Else
        If ECHO.status = 0 Then ECHO.status = IP_DEST_NET_UNREACHABLE
        SysPing = ECHO.status * -1
    End If
    IcmpCloseHandle hPort
    WSACleanup
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)
    Wend
    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
0
 
LVL 1

Expert Comment

by:kuk010998
Comment Utility
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...
0
 

Author Comment

by:nicholso
Comment Utility
thanks. Yeah it's way too much code for my purposes, but I was able to strip it down and works great.

thanks again.
0
 
LVL 14

Expert Comment

by:mcrider
Comment Utility
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!


Cheers!®©
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
The viewer will learn how to implement Singleton Design Pattern in Java.
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.

771 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now