GetHostByName Timeout

Is there a way to set the GetHostByName timeout parameter? My program just freezes when the user specifies a invalid internet-address. Is there a way to keep the program from freezing during the execution of the GetHostByName API?
ask98Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dirtdartCommented:
Declare Function setsockopt Lib "wsock32.dll" (Socket As Long, Level As Long, OptName As Long, ByVal OptVal As String, OptLen As Long)

Socket is, of course, the open socket.
Level should be set to SOL_SOCKET (&HFFFF).
OptName should be SO_RCVTIMEO (&H1006).
OptVal should be the timeout length.
OptLen is the length of the OptVal string.

This may not work in VB.  The last time I tried programming sockets in VB, they simply wouldn't work as expected.
0
EDDYKTCommented:
I don't have problem on gethostbyname time out.

I ping the address before accessing it.




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
Private 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

Private 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

Private 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


Private 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

Private 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




Private Sub Command1_Click()
If IsHostAlive("gateway") = True Then
      'Do your FTP HERE
   Else
      'HOST IS NOT VALID OR IS NOT ONLINE
   End If

End Sub
0
ask98Author Commented:
Thanks, that's a nice piece of code! But I can't seem to get any serves online. Does it work with http:// url too? What's the format of the gateway string?
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

ask98Author Commented:
Thanks, that's a nice piece of code! But I can't seem to get any serves online. Does it work with http:// url too? What's the format of the gateway string?
0
ask98Author Commented:
Thanks, that's a nice piece of code! But I can't seem to get any serves online. Does it work with http:// url too? What's the format of the gateway string?
0
EDDYKTCommented:
gateway = 129.45.45.45 (ip address etc)

I don't think that will work for http://

unless you have to restore the ip address from http:// before using this routine.
0
hesCommented:
How do you have your gethostbyname coded. my routine doesn't hang ?
0
ask98Author Commented:

Public Function GetHostByNameAlias(ByVal HostName$) As Long
    'Return IP address as a long, in network byte order
    Dim phe&
    Dim heDestHost As HostEnt
    Dim addrList&
    Dim retIP&
    retIP = inet_addr(HostName$)
    If retIP = INADDR_NONE Then
        'Connects to internet here for dialup users
        phe = gethostbyname(HostName$)
        If phe <> 0 Then
            MemCopy heDestHost, ByVal phe, hostent_size
            MemCopy addrList, ByVal heDestHost.h_addr_list, 4
            MemCopy retIP, ByVal addrList, heDestHost.h_length
        Else
            retIP = INADDR_NONE
        End If
    End If
    GetHostByNameAlias = retIP
End Function

In this example HostName$ would be something like www.experts-exchange.com or www.altavista.com. But if I specify an invalid url like www.ftp.altavista.com.tu, the program hangs for 3 seconds before resuming with phe value set to -1.
0
hesCommented:
Option Explicit

Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const ERROR_SUCCESS       As Long = 0
Public Const WS_VERSION_REQD     As Long = &H101
Public Const WS_VERSION_MAJOR    As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR    As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD    As Long = 1
Public Const SOCKET_ERROR        As Long = -1

Public Type HOSTENT
   hName      As Long
   hAliases   As Long
   hAddrType  As Integer
   hLen       As Integer
   hAddrList  As Long
End Type

Public Type WSADATA
   wVersion      As Integer
   wHighVersion  As Integer
   szDescription(0 To MAX_WSADescription)   As Byte
   szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
   wMaxSockets   As Integer
   wMaxUDPDG     As Integer
   dwVendorInfo  As Long
End Type

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
   
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Declare Function gethostname Lib "WSOCK32.DLL" _
   (ByVal szHost As String, ByVal dwHostLen As Long) As Long
   
Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (ByVal szHost As String) As Long
   
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Public Function GetIPAddress(sHostName) As String

  ' Dim sHostName    As String * 256
   Dim lpHost    As Long
   Dim HOST      As HOSTENT
   Dim dwIPAddr  As Long
   Dim tmpIPAddr() As Byte
   Dim i         As Integer
   Dim sIPAddr  As String
   
   If Not SocketsInitialize() Then
      GetIPAddress = ""
      Exit Function
   End If
     
   If gethostname(sHostName, 256) = SOCKET_ERROR Then
      GetIPAddress = ""
      MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
              " has occurred. Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
     
   sHostName = Trim$(sHostName)
   lpHost = gethostbyname(sHostName)
     
   If lpHost = 0 Then
      GetIPAddress = ""
      MsgBox "Windows Sockets are not responding. " & _
              "Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
     
   CopyMemory HOST, lpHost, Len(HOST)
   CopyMemory dwIPAddr, HOST.hAddrList, 4
   
   ReDim tmpIPAddr(1 To HOST.hLen)
   CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
   
     For i = 1 To HOST.hLen
      sIPAddr = sIPAddr & tmpIPAddr(i) & "."
   Next
   
     GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
   
   SocketsCleanup
     
End Function




Public Function HiByte(ByVal wParam As Integer)

    HiByte = wParam \ &H100 And &HFF&

End Function

Public Function LoByte(ByVal wParam As Integer)

    LoByte = wParam And &HFF&

End Function

Public Sub SocketsCleanup()

    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
     
End Sub

Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   Dim sLoByte As String
   Dim sHiByte As String
   
   If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
      MsgBox "The 32-bit Windows Socket is not responding."
      SocketsInitialize = False
      Exit Function
   End If
   
   
   If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " & _
                CStr(MIN_SOCKETS_REQD) & " supported sockets."
         
        SocketsInitialize = False
        Exit Function
    End If
   
   
   If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
     (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
      HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
       
      sHiByte = CStr(HiByte(WSAD.wVersion))
      sLoByte = CStr(LoByte(WSAD.wVersion))
       
      MsgBox "Sockets version " & sLoByte & "." & sHiByte & _
             " is not supported by 32-bit Windows Sockets."
       
      SocketsInitialize = False
      Exit Function
       
   End If
     
     
  'must be OK, so lets do it
   SocketsInitialize = True
         
End Function


0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ask98Author Commented:
Thanks.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.