Con las apis del winsock
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetHostByName Lib "ws2_32" Alias "gethostbyname" (ByVal hostname As String) As Long
Private Declare Function WSAStartup Lib "ws2_32" (ByVal wVersionRequired As Long, lpWSAData As WSADATA) As Long
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 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
Public Function IPHost(Host As String) As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim Hostent As Hostent
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
Dim WSA As WSADATA
WSAStartup 257, WSA
lpHost = GetHostByName(Host)
If lpHost <> 0 Then
CopyMemory Hostent, lpHost, Len(Hostent)
CopyMemory dwIPAddr, Hostent.h_addr_list, 4
ReDim tmpIPAddr(1 To Hostent.h_length)
CopyMemory tmpIPAddr(1), dwIPAddr, Hostent.h_length
For i = 1 To Hostent.h_length
sIPAddr = sIPAddr & tmpIPAddr(i) & "."
Next
IPHost = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
End If
End Function
EJEMPLOS DE USO
Sub form_load()
'ASI SE USA
MsgBox IPHost("www.google.es")
MsgBox IPHost("foro.elhacker.net")
'ASI NO SE USA
MsgBox IPHost("http://www.google.es/")
MsgBox IPHost("http://foro.elhacker.net")
End Sub
Autor
En línea
