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 = "MsgBox MyURL & "的IP地址是：" & Test(MyURL)
End Sub