A voir également:
- Comment récupérer l'adresse IP et autres infos réseau sans Wsock ?
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Tag ip session ✓ - Forum PHP
- Ouverture auto d'une session - Forum PHP
- Ouvrir une session windows d'un pc sur le reseau local - Forum Visual Basic 6
- Violation d'accès à l'adresse ✓ - Forum Delphi / Pascal
2 réponses
Salut, voici un exemple qui peut t'aider.
Mettre ce code dans un 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
'
Ensuite mettre ce code dans une feuille :
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 = Left$(Adr.Nom, p% - 1)
Adresse = Trim$(Adr.AdresseIP)
Label1 = Nom & vbCrLf & Adresse
End If
End Sub
'
Mettre ce code dans un 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
'
Ensuite mettre ce code dans une feuille :
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 = Left$(Adr.Nom, p% - 1)
Adresse = Trim$(Adr.AdresseIP)
Label1 = Nom & vbCrLf & Adresse
End If
End Sub
'
Vas sur http://vbaccelerator.com, tu y trouvera une classe pour lire le registre facile à utiliser, ensuite, moi j'ai trouvé divers renseignements dans ces deux clé et celles dessous:
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\0000
et
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\0000
et
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\MSTCP