模块代码:
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
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
谢谢,我给你加分了。