Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const IP_SUCCESS As Long = 0
Private Const SOCKET_ERROR As Long = -1
Private Const AF_INET As Long = 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 WSAStartup Lib "wsock32.dll" _
(ByVal VersionReq As Long, _
WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function inet_addr Lib "wsock32.dll" _
(ByVal s 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 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 Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Sub SocketsCleanup()
If WSACleanup() <> 0 Then
' MsgBox "终止Windows套接字错误", vbExclamation
End If
End Sub
'通过ip得到主机名
Public Function GetHostName(ByVal sAddress As String) As String
Dim ptrHosent As Long
Dim hAddress As Long
Dim nbytes As Long
If SocketsInitialize() Then
'转换地址字符串为一个long值
hAddress = inet_addr(sAddress)
'获取HOSTENT结构的指针,该结构中包含了对应于网络地址的名称和地址
ptrHosent = gethostbyaddr(hAddress, 4, AF_INET)
If ptrHosent <> 0 Then
'转换地址,并获取已解析的主机名
CopyMemory ptrHosent, ByVal ptrHosent, 4
nbytes = lstrlen(ByVal ptrHosent)
If nbytes > 0 Then
sAddress = Space$(nbytes)
CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
GetHostName = sAddress
End If
Else: GetHostName = "" 'MsgBox "gethostbyaddr函数调用失败!"
End If 'If ptrHosent
SocketsCleanup
End If 'If SocketsInitialize
End Function