Code - Visual Basic Research Center

~ Edito ~

12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période.
Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes.

~ Rechercher ~

~ Annuaire VB ~

~ Partenaires ~

Retour à la liste des fonctions

Fonction : ObtenirAdresseIP
Pour récupérer l'adresse IP de la machine de manière "simple", en passant par des fonctions API.
Origine : Janick Tremblay
(Consulté 21875 fois.)

' Déclaration des types
Public Type HOSTENT
    hName As Long
    haliases As Long
    hAddrtype As Integer
    hLength As Integer
    hAddrList As Long
End Type

Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 256) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxsockets As Integer
    iMaxUpDg As Integer
    lpszVendorInfo As Long
End Type

' Déclarations des fonctions API
Public Declare Function WSAStartup Lib "wsock32.dll" _
     (ByVal wVersion&, lpWSAData As WSADATA) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long

Public Declare Function gethostname Lib "wsock32.dll" _
     (ByVal HostName As String, ByVal HostLen As Integer) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" _
     (ByVal HostName As String) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
     (Dest As Any, ByVal source As Long, ByVal cbCopy As Long)

Private Const SOCKET_ERROR = -1

' Type utilisateur
Public Type IPtype
    Nom As String * 256
    AdresseIP As String * 64
End Type

' Origine : Janick Tremblay
' E-mail : jafi@videotron.ca

Public Function ObtenirAdresseIP() As IPtype
' Cette fonction récupère le nom et
' l'adresse IP de la machine locale
Dim WSAD As WSADATA
Dim Host As HOSTENT
Dim lgRetVal As Long
Dim stNom As String * 256
Dim lgAdresse As Long
Dim stIPadr As String
Dim Temp() As Byte
Dim lgFor As Long
' Initialisation
ObtenirAdresseIP.Nom = vbNullString
ObtenirAdresseIP.AdresseIP = vbNullString
' Vérifie l'accès à la DLL
If (WSAStartup(&H101, WSAD) <> 0) Then
    MsgBox "WINSOCK.DLL ne répond pas.", vbExclamation, "Echec"
    Exit Function
End If
' Récupération du nom
If (gethostname(stNom, Len(stNom)) = SOCKET_ERROR) Then
    MsgBox "Erreur Winsock", vbExclamation, "Echec"
    Exit Function
End If
' Récupération de l'adresse IP
lgAdresse = gethostbyname(stNom)
If (lgAdresse = 0) Then
    MsgBox "WINSOCK.DLL ne répond pas.", vbExclamation, "Echec"
    Exit Function
End If

CopyMemory Host, lgAdresse, Len(Host)
CopyMemory lgAdresse, Host.hAddrList, 4
ReDim Temp(1 To Host.hLength)
CopyMemory Temp(1), lgAdresse, Host.hLength
' Récomposition de l'adresse
For lgFor = 1 To Host.hLength
    stIPadr = stIPadr & Temp(lgFor) & "."
Next lgFor
stIPadr = Left$(stIPadr, Len(stIPadr) - 1)
lgRetVal = WSACleanup()
' Retourne les valeurs
ObtenirAdresseIP.Nom = stNom
ObtenirAdresseIP.AdresseIP = stIPadr
End Function

Public Sub Main()
Dim Adr As IPtype
Dim stNom As String, stAdr As String
Dim lgTmp As Long
' Récupération des informations
Adr = ObtenirAdresseIP
lgTmp = InStr(Adr.Nom, Chr$(0))
If (lgTmp <> 0) Then
    stNom = "Nom = " & Left$(Adr.Nom, lgTmp - 1)
    stAdr = Trim$(Adr.AdresseIP)
End If
' Affiche le résultat
MsgBox stNom & vbCrLf & "Adresse IP = " & stAdr, vbOKOnly, "IP"
End Sub

Retour à la liste des fonctions