1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| Option Explicit
'code recuperé et adapté depuis cette adresse
'http://allapi.mentalis.org/apilist/GetNetworkParams.shtml
'This example was created by George Bernier (bernig@dinomail.qc.ca)
Private Const MAX_HOSTNAME_LEN = 132
Private Const MAX_DOMAIN_NAME_LEN = 132
Private Const MAX_SCOPE_ID_LEN = 260
Private Const MAX_ADAPTER_NAME_LENGTH = 260
Private Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Private Const ERROR_BUFFER_OVERFLOW = 111
Private Type IP_ADDR_STRING
Next As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End Type
Private Type IP_ADAPTER_INFO
Next As Long
ComboIndex As Long
AdapterName As String * MAX_ADAPTER_NAME_LENGTH
Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
AddressLength As Long
Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
Index As Long
Type As Long
DhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
HaveWins As Boolean
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type
Private Type FIXED_INFO
HostName As String * MAX_HOSTNAME_LEN
DomainName As String * MAX_DOMAIN_NAME_LEN
CurrentDnsServer As Long
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId As String * MAX_SCOPE_ID_LEN
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End Type
Private Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Private Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Form_Load()
PenseBete
End Sub
Public Sub PenseBete()
Dim error As Long
Dim FixedInfoSize As Long
Dim AdapterInfoSize As Long
Dim AdapterInfo As IP_ADAPTER_INFO
Dim Adapt As IP_ADAPTER_INFO
Dim FixedInfo As FIXED_INFO
Dim pAdapt As Long
Dim Buffer2 As IP_ADAPTER_INFO
Dim FixedInfoBuffer() As Byte
Dim AdapterInfoBuffer() As Byte
FixedInfoSize = 0
error = GetNetworkParams(ByVal 0&, FixedInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetNetworkParams sizing failed with error " & error
Exit Sub
End If
End If
ReDim FixedInfoBuffer(FixedInfoSize - 1)
error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
If error = 0 Then
CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
Else
MsgBox "GetNetworkParams failed with error " & error
Exit Sub
End If
'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
'Note: IP_ADAPTER_INFO contains a linked list of adapter entries.
AdapterInfoSize = 0
error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetAdaptersInfo sizing failed with error " & error
Exit Sub
End If
End If
ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
' Get actual adapter information
error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
If error <> 0 Then
MsgBox "GetAdaptersInfo failed with error " & error
Exit Sub
End If
CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
pAdapt = AdapterInfo.Next
Dim DhcpServ As String
Do While pAdapt <> 0
CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
If Buffer2.Type = 71 Then ' pour chez moi OUI, reste a adapter
DhcpServ = Replace(Buffer2.DhcpServer.IpAddress, Chr(0), "")
If DhcpServ <> "" Then
MsgBox "Activé"
Else
MsgBox "Desactivé"
End If
Exit Do
End If
'pour la suite de la boucle pour les autre(s) connexion(s), si le sans fil n'est pas le premier dans la liste
pAdapt = Buffer2.Next
If pAdapt <> 0 Then
CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
End If
Loop
End Sub |
Partager