TROUVER L'IP D' UN SITE INTERNET AVEC L 'API WINSOCK

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