module:
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
'
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)
Public Const SOCKET_ERROR = -1
'
Public Type IPtype
Nom As String * 256
AdresseIP As String * 64
End Type
Public Function ObtenirAdresseIP() As IPtype
Dim WSAD As WSADATA
Dim Host As HOSTENT
Dim RetVal As Long
Dim Nom As String * 256
Dim Adresse As Long
Dim IPadr As String
Dim Temp() As Byte
'
RetVal = WSAStartup(&H101, WSAD)
If RetVal <> 0 Then
MsgBox "Winsock.dll ne répond pas"
ObtenirAdresseIP.Nom = ""
ObtenirAdresseIP.AdresseIP = ""
Exit Function
End If
If gethostname(Nom, Len(Nom)) = SOCKET_ERROR Then
MsgBox "Erreur Winsock"
ObtenirAdresseIP.Nom = ""
ObtenirAdresseIP.AdresseIP = ""
Exit Function
End If
Adresse = gethostbyname(Nom)
If Adresse = 0 Then
MsgBox "Winwock.dll ne repond pas"
ObtenirAdresseIP.Nom = ""
ObtenirAdresseIP.AdresseIP = ""
Exit Function
End If
'
CopyMemory Host, Adresse, Len(Host)
CopyMemory Adresse, Host.hAddrList, 4
'
ReDim Temp(1 To Host.hLength)
'
CopyMemory Temp(1), Adresse, Host.hLength
'
For i% = 1 To Host.hLength
IPadr = IPadr & Temp(i%) & "."
Next i%
'
IPadr = Left$(IPadr, Len(IPadr) - 1)
ObtenirAdresseIP.Nom = Nom
ObtenirAdresseIP.AdresseIP = IPadr
RetVal = WSACleanup()
End Function
Form_Load()
Private Sub Form_Load()
Dim Adr As IPtype
Dim Nom As String
Dim Adresse As String
'
Adr = ObtenirAdresseIP
'
p% = InStr(Adr.Nom, Chr$(0))
If p% <> 0 Then
Nom = "Nom = " & Left$(Adr.Nom, p% - 1)
Adresse = Trim$(Adr.AdresseIP)
MsgBox Nom & vbCrLf & "Adresse IP = " & Adresse
End If
End Sub