Ben, ca fait ce que je vous ai dit. C' est pour trouver l' IP d' un site utilisant le protocole HTTP avec Winsck.dll
Il faut pas marquer "htp://" dans la boite
Source / Exemple :
Private Const AF_INET = 2
Private Const INVALID_SOCKET = -1
Private Const WSA_DESCRIPTIONLEN = 256
Private Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Private Const WSA_SYS_STATUS_LEN = 128
Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Private Const INADDR_NONE = &HFFFF
Private Const hostent_size = 16
Private Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo 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
Private Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Private Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Private saZero As sockaddr
Private WSAStartedUp As Boolean
Private lSocket As Long
'*****************************************************
Private Sub Form_Load()
Dim sSave As String
'************ Demarrage de WinSock
Dim StartupData As WSADataType
If Not WSAStartedUp Then
If Not WSAStartup(&H101, StartupData) Then
WSAStartedUp = True
sSave = StartupData.szDescription
Else
WSAStartedUp = False
End If
End If
site = InputBox("Site internet à chercher (faut pas mettre http://):", "Recherche d' IP")
' *** version de winsock
If InStr(1, sSave, Chr$(0)) > 0 Then sSave = Left$(sSave, InStr(1, sSave, Chr$(0)) - 1)
'connecte au site
ip = ConnectSock(site, 80, 0, False)
If Len(ip) >= 14 Then MsgBox ip
End Sub
Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal Async%) As String
Dim s&, SelectOps&, Dummy&
Dim sockin As sockaddr
SockReadBuffer$ = ""
sockin = saZero
sockin.sin_family = AF_INET
sockin.sin_port = htons(Port) 'port
If sockin.sin_port = INVALID_SOCKET Then
ConnectSock = INVALID_SOCKET
MsgBox "Problème de port!"
Exit Function
End If
' recupere add IP bizzare(-60...)
sockin.sin_addr = GetHostByNameAlias(Host$)
' verifie
If sockin.sin_addr = INADDR_NONE Then
ConnectSock = INVALID_SOCKET
MsgBox "Problème d' addrese!"
Exit Function
End If
retIpPort$ = getascip$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
ConnectSock = retIpPort$
End Function
' recuperer IP
Function GetHostByNameAlias(ByVal hostname$) As Long
On Error Resume Next
Dim phe&
Dim heDestHost As HostEnt
Dim addrList&
Dim retIP&
retIP = inet_addr(hostname) 'doit etre =-1
If retIP = INADDR_NONE Then
phe = gethostbyname(hostname) 'connection-->donne 1IP
If phe <> 0 Then
MemCopy heDestHost, ByVal phe, hostent_size
MemCopy addrList, ByVal heDestHost.h_addr_list, 4
MemCopy retIP, ByVal addrList, heDestHost.h_length
Else
retIP = INADDR_NONE
End If
End If
GetHostByNameAlias = retIP '=?
If Err Then GetHostByNameAlias = INADDR_NONE
End Function
Function getascip(ByVal inn As Long) As String
On Error Resume Next
Dim lpStr&
Dim nStr&
Dim retString$
retString = String(32, 0) '32*chr(0) :petits carrés
lpStr = inet_ntoa(inn)
If lpStr = 0 Then
getascip = "255.255.255.255"
Exit Function
End If
nStr = lstrlen(lpStr) '14
If nStr > 32 Then nStr = 32
MemCopy ByVal retString, ByVal lpStr, nStr
retString = Left(retString, nStr) 'ip+carres
getascip = retString 'IP !!!
If Err Then getascip = "255.255.255.255"
End Function
Private Sub Form_Unload() 'Cancel As Integer)
Dim Ret&
'Ferme le socket
closesocket lSocket
'Fin de winsock
If WSAIsBlocking() Then
Ret = WSACancelBlockingCall()
End If
Ret = WSACleanup()
WSAStartedUp = False
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.