如何获取网站的IP地址(非Ping方法)?如:获取 www.baidu.com 的IP要求:
1、不要Ping 或tracert 的方法。
2、尽可能不要用到控件..请求高手!

解决方案 »

  1.   

    Option Explicit
    Const SOCKET_ERROR = 0
    Private Type WSAdata
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To 255) As Byte
        szSystemStatus(0 To 128) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End Type
    Private Type Hostent
        h_name As Long
        h_aliases As Long
        h_addrtype As Integer
        h_length As Integer
        h_addr_list As Long
    End Type
    Private Type IP_OPTION_INFORMATION
        TTL As Byte
        Tos As Byte
        Flags As Byte
        OptionsSize As Long
        OptionsData As String * 128
    End Type
    Private Type IP_ECHO_REPLY
        Address(0 To 3) As Byte
        Status As Long
        RoundTripTime As Long
        DataSize As Integer
        Reserved As Integer
        data As Long
        Options As IP_OPTION_INFORMATION
    End Type
    Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
    Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
    Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
    Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
    Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
    Private Sub Form_Load()
       Const HostName = "163.com"
       Dim hFile&, AddrList&, Address&, rIP$
       Dim lpWSAdata As WSAdata, hHostent As Hostent, OptInfo As IP_OPTION_INFORMATION, EchoReply As IP_ECHO_REPLY
       Call WSAStartup(&H101, lpWSAdata)
       If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
          CopyMemory hHostent.h_name, ByVal GetHostByName(HostName & String(64 - Len(HostName), 0)), Len(hHostent)
          CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
          CopyMemory Address, ByVal AddrList, 4
       End If
       hFile = IcmpCreateFile()
       If hFile = 0 Then MsgBox "检测失败": Exit Sub
       OptInfo.TTL = 255
       If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
          rIP = CStr(EchoReply.Address(0)) & "." & CStr(EchoReply.Address(1)) & "." & CStr(EchoReply.Address(2)) & "." & CStr(EchoReply.Address(3))
       Else
          MsgBox "Timeout"
       End If
       If EchoReply.Status = 0 Then
           MsgBox HostName & " 的IP地址是: " & rIP & " 共使用 " & CStr(EchoReply.RoundTripTime) & " 毫秒"
       Else
           MsgBox "检测失败 ..."
       End If
       Call IcmpCloseHandle(hFile)
       Call WSACleanup
    End Sub
      

  2.   

    非常感谢 cbm666 提供的经典源码.测试很成功!