ADRESSE IP PAR L'API WINSOCK

'---------------------------------
' Ip INTERNET
' TheSaib pour Codes-sources.com
' Copyright Codes-sources.Com
' modIP.bas
'---------------------------------

'MsgBox Ip_courante(True)

Public Const WS_VERSION_REQD = &H101 'version nécessaire
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& 'version la + haute
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& 'version la + petite
Public Const MIN_SOCKETS_REQD = 1 'Min de socket
Public Const SOCKET_ERROR = -1 'Error d'initialisation socket
Public Const WSADESCRIPTION_LEN = 256 'Longueur du champs description
Public Const WSASYS_Status_Len = 128 'Idem champs status

Public Type HOSTENT 'Enregistre info relatif a un poste ou un réseau
    hName As Long 'Pointeur vers le domaine de la machine
    hAliases As Long 'Pointeur vers le domaine alternatif si il y a
    hAddrType As Integer 'famille d'adresse utilisé par le protocole
    hLength As Integer 'longueur en octetde chaque adresse pointé par hAddrType
    hAddrList As Long 'list des adresse
End Type

'type winsock
Public Type WSADATA 'utilsé par startup
    wVersion As Integer 'version Winsock
    wHighVersion As Integer 'Version la + haute de wsk que Win supporte
    szDescription(0 To WSADESCRIPTION_LEN) As Byte 'Implémentation de winsok qui sera utilisé (doit finir par zero)
    szSystemStatus(0 To WSASYS_Status_Len) As Byte 'statut implémentation actuell winsock
    iMaxSockets As Integer 'nombre maximum de socket possible (32327)
    iMaxUdpDg As Integer 'pas usé
    lpszVendorInfo As Long ' pas usé
End Type

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long 'Récupération erreur lié socket
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long 'Initialise socket
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long 'Destructeur de socket
Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long 'Récupere nom host
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long 'Recupere ip a partir host
Public Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Function BitPdsFort(ByVal Valeur As Integer) 'Récupère bit de poid fort du parametre
    BitPdsFort = Valeur \ &H100 And &HFF& 'Et bit a bit
End Function


Function BitPdsFaible(ByVal Valeur As Integer) 'Récupère bit de poid faible du parametre
    BitPdsFaible = Valeur And &HFF& 'Et bit a bit
End Function


Sub Init_socket() 'Initialisation des sockets
    Dim WSAD As WSADATA 'pointeur vers objet wsk
    Dim DemarrSck As Integer 'Valeur du démarrage d'un socket wsk
    Dim sBitFaible As String, sBitFort As String, sMsg As String
    DemarrSck = WSAStartup(WS_VERSION_REQD, WSAD) 'Initialisation Socket

    'Test Erreur d'init socket
    If DemarrSck <> 0 Then
        MsgBox "Erreur Winsock.dll."
        Exit Sub
    End If
    'Test si version nécessaire est indisponible
    If BitPdsFaible(WSAD.wVersion) < WS_VERSION_MAJOR Or (BitPdsFaible(WSAD.wVersion) = _
        WS_VERSION_MAJOR And BitPdsFort(WSAD.wVersion) < WS_VERSION_MINOR) Then
        sBitFort = Trim$(Str$(BitPdsFort(WSAD.wVersion)))
        sBitFaible = Trim$(Str$(BitPdsFaible(WSAD.wVersion)))
        sMsg = "Windows Sockets version : " & sBitFaible & "." & sBitFort
        MsgBox sMsg
        Exit Sub
    End If

End Sub

Public Function Ip_courante(RetourIPExterne As Boolean)
    Init_socket
    Dim hostname As String * 256 'Nom de la machine étendu de 0
    Dim host_adresse As Long 'Adresse machine
    Dim host As HOSTENT 'Type machine
    Dim Adresse_ip_host As Long 'Adresse IP
    Dim Adresse_ip_temporaire() As Byte 'Quartet temporaire
    Dim i As Integer
    Dim Adresse_ip As String 'Adresse ip de retour
    Dim Ip As String
    
    'Recupere le nom de la machine
    If gethostname(hostname, 256) = SOCKET_ERROR Then
                 MsgBox Err.Number
                 Exit Function
    Else
        hostname = Trim$(hostname)
    End If
    'Pointeur vers l'adresse
    host_adresse = gethostbyname(hostname)


    If host_adresse = 0 Then
        MsgBox "Erreur de Winsock.dll"
        Exit Function
    End If
    
    'Récupération dans le tableau de l'adresse
    RtlMoveMemory host, host_adresse, LenB(host)
    RtlMoveMemory Adresse_ip_host, host.hAddrList, 4
   
    'Recupere les 4 quartets de l'adresse
    Do
        ReDim Adresse_ip_temporaire(1 To host.hLength)
        RtlMoveMemory Adresse_ip_temporaire(1), Adresse_ip_host, host.hLength

        'Met en forme les quartets en @ Ip valide
        For i = 1 To host.hLength
            Adresse_ip = Adresse_ip & Adresse_ip_temporaire(i) & "."
        Next
        Adresse_ip = Mid$(Adresse_ip, 1, Len(Adresse_ip) - 1)
    
        'Copie de l'ip
        Interne = Mon_IP
        Externe = Adresse_ip
        Mon_IP = Adresse_ip
        
        

        Adresse_ip = ""
        host.hAddrList = host.hAddrList + LenB(host.hAddrList)
        RtlMoveMemory Adresse_ip_host, host.hAddrList, 4
    Loop While (Adresse_ip_host <> 0)
    
    
If RetourIPExterne = True Then
    Ip_courante = Externe
Else
    Ip_courante = Interne
End If
End Function

Sub DestrucSocket()
    Dim lretour As Long
    lretour = WSACleanup()


    If lretour <> 0 Then
        MsgBox "Erreur socket" & Trim$(Str$(lretour)) & " pendant sa destruction "
        Exit Sub
    End If
End Sub