| Option Explicit
Private Const WSADESCRIPTION_LEN = 256
Private Const WSASYS_STATUS_LEN = 128
Private Type HOSTENT
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(WSADESCRIPTION_LEN) As Byte
szSystemStatus(WSASYS_STATUS_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal _
szName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal _
wVersionRequested As Integer, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal _
Length As Long)
Public Function LookupIPAddress(ByVal sHostName As String) As String
Dim wsa As WSADATA
Dim nRet As Long
Dim nTemp As Long
Dim bTemp(0 To 3) As Byte
Dim sOut As String
Dim he As HOSTENT
'Initialize WinSock
WSAStartup &H10, wsa
'Attempt to lookup the host
nRet = gethostbyname(sHostName)
'If it failed, just return nothing
If nRet = 0 Then
sOut = ""
Else
'Take a look at the resulting hostent structure
CopyMemory he, ByVal nRet, Len(he)
'Are there atlest four bytes, then we have
' at least one address
If he.h_length >= 4 Then
'Copy the address out,
CopyMemory nTemp, ByVal he.h_addr_list, 4
CopyMemory bTemp(0), ByVal nTemp, 4
' and format it
sOut = Format(bTemp(0)) & "." & Format(bTemp(1)) & "." _
& Format(bTemp(2)) & "." & Format(bTemp(3))
Else
sOut = ""
End If
End If
WSACleanup
LookupIPAddress = sOut
End Function |