Option Explicit
'// 下面是API用到的一些常数
Private Const IP_SUCCESS As Long = 0
Private Const SOCKET_ERROR As Long = -1
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const AF_INET As Long = 2
'// API用到的一些结构
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private 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
'// 这是用到的一系列API，至于每一个API的具体功能，网上随便找本VB API大全 手册之类的，看看就知道了
'有一些参数用到了上面用到的结构和常数
'kernel32
Private Declare Sub apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes As Long)
Private Declare Function apiStrLen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
'wsock32
Private Declare Function apiGetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal hostname As String) As Long
Private Declare Function apiWSAStartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function apiWSACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Private Declare Function apiInetAddr Lib "wsock32.dll" Alias "inet_addr" (ByVal s As String) As Long
Private Declare Function apiGetHostByAddr Lib "wsock32.dll" Alias "gethostbyaddr" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
'// 下面是对要使用的API的封装
'这里所谓封装就是把由于参数、返回值甚至函数名称等这些
'不符合习惯或者不方便使用 而进行的进一步包装
Private Function InitializeSocket() As Boolean
Dim WSAD As WSADATA
'attempt to initialize the socket
InitializeSocket = apiWSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Private Sub CloseSocket()
'try to close the socket
If apiWSACleanup() <> 0 Then
MsgBox "Error calling apiWSACleanup.", vbCritical
End If
End Sub
Public Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address.，hostname to ip
Dim nBytes As Long
Dim ptrHosent As Long
Dim hstHost As HOSTENT
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String 'declare this as Dim sAddress(1) As String if you want 2 ip addresses returned
'如果你需要返回2个IP的话，就定义成2个元素的数组
'初始化socket
If InitializeSocket() = True Then
'try to get the IP
ptrHosent = apiGetHostByName(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'获取IP地址数据
apiCopyMemory hstHost, ByVal ptrHosent, LenB(hstHost)
apiCopyMemory ptrIPAddress, ByVal hstHost.hAddrList, 4
'填充缓冲区
sAddress = Space$(4)
'if you want multiple domains returned,
'fill all items in sAddress array with 4 spaces
'如果要返回多个域，把sAddress数组的每个元素都用4个空格填充
apiCopyMemory ByVal sAddress, ByVal ptrIPAddress, hstHost.hLength
'change this to
'CopyMemory ByVal sAddress(0), ByVal ptrIPAddress, hstHost.hLength
'if you want an array of ip addresses returned
'(some domains have more than one ip address associated with it)
'如果你要返回一组IP地址的话把这条语句改成
'CopyMemory ByVal sAddress(0), ByVal ptrIPAddress, hstHost.hLength
'(在某些域有不止一个IP地址与之相关联)
'获取IP地址
GetIPFromHostName = IPToText(sAddress)
'if you are using multiple addresses, you need IPToText(sAddress(0)) & "," & IPToText(sAddress(1))
'etc
'如果你使用多地址，就用 IPToText(sAddress(0)) & "," & IPToText(sAddress(1))
End If
Else
MsgBox "Failed to open Socket."
End If
End Function
Private Function IPToText(ByVal IPAddress As String) As String
'把字符转换成数字
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Public Function GetHostNameFromIP(ByVal sIPAddress As String) As String
Dim ptrHosent As Long
Dim hAddress As Long
Dim sHost As String
Dim nBytes As Long
'打开socket
If InitializeSocket() = True Then
'convert string address to long datatype ，string to long
hAddress = apiInetAddr(sIPAddress)
'check if an error ocucred，是否出错
If hAddress <> SOCKET_ERROR Then
'obtain a pointer to the HOSTENT structure，获取一个指向 HOSTENT结构的指针
'that contains the name and address，这个结构包含 对应给定网络地址的名称和地址
'corresponding to the given network address.
ptrHosent = apiGetHostByAddr(hAddress, 4, AF_INET)
If ptrHosent <> 0 Then
'convert address and
'get resolved hostname ，转换地址格式，获取主机名
apiCopyMemory ptrHosent, ByVal ptrHosent, 4
nBytes = apiStrLen(ByVal ptrHosent)
If nBytes > 0 Then
'fill the IP address buffer，填充IP地址缓冲区
sHost = Space$(nBytes)
apiCopyMemory ByVal sHost, ByVal ptrHosent, nBytes
GetHostNameFromIP = sHost
End If
Else
MsgBox "Call to gethostbyaddr failed." '调用失败
End If
'close the socket，关闭socket
CloseSocket
Else
MsgBox "Invalid IP address" '无效的IP地址
End If
Else
MsgBox "Failed to open Socket" '打开socket失败
End If
End Function
Private Sub cmdResolve_Click()
Dim cResolve As clsResolve
Set cResolve = New clsResolve
MsgBox cResolve.GetHostNameFromIP("66.111.65.129")
MsgBox cResolve.GetIPFromHostName("microsoft.com")
End Sub
我机子上没装vb，没试，你们试试吧
