Public Sub Initialize()

Public Function GetIPAddress(ByVal sLookupName As String) As String

The below sample shows will determine the IP address of codeoftheweek.com.

    Dim ICMP As New cICMP

    ICMP.Initialize
    MsgBox "codeoftheweek.com IP address is " & ICMP.GetIPAddress("codeoftheweek.com")
    Set ICMP = Nothing

Create a new class module and paste this source code into it. Change the name of the class module to cICMP. If you have any questions, email us at help@codeoftheweek.com

Option Explicit

'----------------------------------------------------------------------
'
'   Module Name:    cICMP
'   Written By:     C&D Programming Corp.
'   Create Date:    1/2000
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------

Option Explicit

' Basic Winsock definitions
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 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

Public Sub Initialize()
    Dim uWSAData As WSADATA

    If WSAStartup(257, uWSAData) <> 0 Then
      MsgBox "Unable to initialize Winsock", vbOKOnly, "Winsock Error"
      Exit Sub
    End If

End Sub

Private Function TextToIP(ByVal sIPAddress As String) As Long
    Dim x As Integer
    Dim iOctet As Integer   ' octet value
    Dim bIP(1 To 4) As Byte ' IP storage for each octet
    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(sIPAddress)
        If Mid$(sIPAddress, x, 1) = "." Then
            iDots = iDots + 1
            If iDots > 3 Then Exit For ' bad format!
            bIP(iDots) = iOctet
            iOctet = 0
        Else
            ' add digit but restrict to 8 bits
            iOctet = (iOctet * 10 + Val("0" & Mid$(sIPAddress, x, 1))) And 255
        End If
    Next
    bIP(4) = iOctet ' save last one
    CopyMemory lIP, bIP(1), 4 ' copy to LONG value
    TextToIP = lIP ' copy to return value
End Function

Private Function IPToText(ByVal sIPAddress As String) As String
    IPToText = CStr(Asc(Mid$(sIPAddress, 1, 1))) & "." & _
               CStr(Asc(Mid$(sIPAddress, 2, 1))) & "." & _
               CStr(Asc(Mid$(sIPAddress, 3, 1))) & "." & _
               CStr(Asc(Mid$(sIPAddress, 4, 1)))
End Function

' Converts hostname (such as microsoft.com) to an IP address
' Gets first IP address that belongs to the name

Public Function GetIPAddress(ByVal sLookupName As String) As String
    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 lhostentName As Long        ' address of name pointer
    Dim lhostentAddress As Long     ' address of address pointer
    Dim lIPPointer As Long          ' address of IP address

    Dim sAddress As String

    'default values
    GetIPAddress = ""

    ' if an IP was specified, use gethostbyaddr instead
    If IsNumeric(Left$(sLookupName, 1)) Then
        lhostent = gethostbyaddr(TextToIP(sLookupName), 4, AF_INET)
    Else
        sTarget = sLookupName & vbNullChar
        lhostent = gethostbyname(sTarget) ' do actual winsock call
    End If
    If lhostent = 0 Then
        GetIPAddress = 0
        Exit Function ' failed!
    End If
    lhostentName = lhostent ' set pointer addresses
    lhostentAddress = lhostent + 12
    ' convert addresses of pointers to the pointers...
    CopyMemory lhostentName, ByVal lhostentName, 4
    CopyMemory lhostentAddress, ByVal lhostentAddress, 4

    ' Get resolved hostname
    nbytes = lstrlen(ByVal lhostentName)
    If nbytes > 0 Then
        sLookupName = Space$(nbytes)
        CopyMemory ByVal sLookupName, ByVal lhostentName, nbytes
    End If

    ' get all IP addresses
    CopyMemory lIPPointer, ByVal lhostentAddress, 4
    If lIPPointer = 0 Then
        GetIPAddress = ""
    Else
        sAddress = "    " ' holder for address
        CopyMemory ByVal sAddress, ByVal lIPPointer, 4
        CopyMemory ByVal lhostentAddress, 0&, 4 ' null for next call
        GetIPAddress = IPToText(sAddress)
    End If
End Function

Private Sub Class_Terminate()
    Call WSACleanup
End Sub