模块代码:
Public Const IP_STATUS_BASE As Long = 11000
Public Const IP_SUCCESS As Long = 0
Public Const IP_BUF_TOO_SMALL As Long = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE As Long = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE As Long = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE As Long = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE As Long = (11000 + 5)
Public Const IP_NO_RESOURCES As Long = (11000 + 6)
Public Const IP_BAD_OPTION As Long = (11000 + 7)
Public Const IP_HW_ERROR As Long = (11000 + 8)
Public Const IP_PACKET_TOO_BIG As Long = (11000 + 9)
Public Const IP_REQ_TIMED_OUT As Long = (11000 + 10)
Public Const IP_BAD_REQ As Long = (11000 + 11)
Public Const IP_BAD_ROUTE As Long = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT As Long = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM As Long = (11000 + 14)
Public Const IP_PARAM_PROBLEM As Long = (11000 + 15)
Public Const IP_SOURCE_QUENCH As Long = (11000 + 16)
Public Const IP_OPTION_TOO_BIG As Long = (11000 + 17)
Public Const IP_BAD_DESTINATION As Long = (11000 + 18)
Public Const IP_ADDR_DELETED As Long = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE As Long = (11000 + 20)
Public Const IP_MTU_CHANGE As Long = (11000 + 21)
Public Const IP_UNLOAD As Long = (11000 + 22)
Public Const IP_ADDR_ADDED As Long = (11000 + 23)
Public Const IP_GENERAL_FAILURE As Long = (11000 + 50)
Public Const MAX_IP_STATUS As Long = (11000 + 50)
Public Const IP_PENDING As Long = (11000 + 255)
Public Const PING_TIMEOUT As Long = 500
Public Const WS_VERSION_REQD As Long = &H101
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const MAX_WSADescrIPtion As Long = 256
Public Const MAX_WSASYSStatus As Long = 128Public Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescrIPtion(0 To MAX_WSADescrIPtion) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo As Long
End Type
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes 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 Longpublic blnGetIPOK as BooleanPublic Function SocketsInitialize() As Boolean
   Dim WSAD As WSADATA
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS    
End FunctionPublic Function GetIPFromHostName(ByVal sHostName As String) As String
     'converts a host name to an IP address.
    Dim nBytes As Long
    Dim ptrHosent As Long  'address of hostent structure
    Dim ptrName As Long    'address of name pointer
    Dim ptrAddress As Long 'address of address pointer
    Dim ptrIPAddress As Long
    Dim lngAddress As Long
    ptrHosent = gethostbyname(sHostName & vbNullChar)
    If ptrHosent <> 0 Then
        'assign pointer addresses and offset
        'ptrName is the official name of the host (PC).
        'If using the DNS or similar resolution system,
        'it is the Fully Qualified Domain Name (FQDN)
        'that caused the server to return a reply.
        'If using a local hosts file, it is the first
        'entry after the IP address.
       ptrName = ptrHosent
        'Null-terminated list of addresses for the host.
        'The Address is offset 12 bytes from the start of
        'the HOSENT structure. Note: Here we are retrieving
        'only the first address returned. To return more than
        'one, define sAddress as a string array and loop through
        'the 4-byte ptrIPAddress members returned. The last
        'item is a terminating null. All addresses are returned
        'in network byte order.
      ptrAddress = ptrHosent + 12
        'get the IP address
      CopyMemory ptrName, ByVal ptrName, 4
      CopyMemory ptrAddress, ByVal ptrAddress, 4
      CopyMemory ptrIPAddress, ByVal ptrAddress, 4
      CopyMemory lngAddress, ByVal ptrIPAddress, 4
      GetIPFromHostName = IPToText(lngAddress)
      blnGetIPOK = True
    Else
      blnGetIPOK = False
    End If
End FunctionPrivate Function intLoWord(ByVal dw As Long) As Integer
    CopyMemory intLoWord, dw, 2
End Function
Private Function intHiWord(ByVal dw As Long) As Integer
    CopyMemory intHiWord, ByVal VarPtr(dw) + 2, 2
End Function
Private Function bytLoWord(ByVal dw As Integer) As Byte
    CopyMemory bytLoWord, dw, 1
End Function
Private Function bytHiWord(ByVal dw As Integer) As Byte
    CopyMemory bytHiWord, ByVal VarPtr(dw) + 1, 1
End FunctionPrivate Function IPToText(ByVal IPAddress As Long) As String
    IPToText = CStr(bytLoWord(intLoWord(IPAddress))) & "." & _
               CStr(bytHiWord(intLoWord(IPAddress))) & "." & _
               CStr(bytLoWord(intHiWord(IPAddress))) & "." & _
               CStr(bytHiWord(intHiWord(IPAddress)))
End Function调用方法:
If SocketsInitialize() Then
        sIPAddress = GetIPFromHostName(strHostName)
End If
if blnGetIPOK then msgbox "Get IP OK:" & sIPAddress