Option Explicit
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 256) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHostname As String, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As String) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Const WS_VERSION_REQD = &H101
Private Function Test(URL As String) As String
InitializeWinSock
Test = GetAddressByName(URL)
TerminateWinSock
End Function
Private Function GetAddressByName(strHostname As String)
Dim lngAddr As Long
Dim udtHost As HOSTENT
Dim lngIP As Long
Dim bteTmp() As Byte
Dim i As Integer
Dim strIP As String
lngAddr = gethostbyname(strHostname)
If lngAddr = 0 Then
MsgBox "Kein Host gefunden."
GetAddressByName = Null
Exit Function
End If
RtlMoveMemory udtHost, lngAddr, LenB(udtHost)
RtlMoveMemory lngIP, udtHost.hAddrList, 4
ReDim bteTmp(1 To udtHost.hLength)
RtlMoveMemory bteTmp(1), lngIP, udtHost.hLength
For i = 1 To udtHost.hLength
strIP = strIP & bteTmp(i) & "."
Next
strIP = Mid$(strIP, 1, Len(strIP) - 1)
GetAddressByName = strIP
End Function
Private Sub InitializeWinSock()
Dim udtWSAD As WSADATA
Dim lngRet As Long
lngRet = WSAStartup(WS_VERSION_REQD, udtWSAD)
If lngRet <> 0 Then
MsgBox "Winsock.dll konnte nicht initialisiert werden."
End
End If
End Sub
Private Sub TerminateWinSock()
Dim lngRet As Long
lngRet = WSACleanup()
If lngRet <> 0 Then
MsgBox "Fehler " & lngRet & " beim Beenden von Winsock.dll"
End
End If
End Sub
Private Sub Command1_Click()
Dim MyURL As String
MyURL = "domain"
MsgBox MyURL & "的IP地址是：" & Test(MyURL)
End Sub