Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionOption Explicit 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) Public 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 Const ERROR_SUCCESS = 0 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 Public Function GetMAC() As String() Dim error As Long Dim AdapterInfoSize As Long, i As Integer, PhysicalAddress As String Dim AdapterInfo As IP_ADAPTER_INFO, Adapt As IP_ADAPTER_INFO Dim pAdapt As Long, Buffer2 As IP_ADAPTER_INFO Dim ret() As String, Idx As Long ' Tableau indiquant le dernier index du tableau à retourner (à base zéro, donc on initialise à -1) Idx = -1 ' Premier appel à GetAdaptersInfo() pour connaitre la taille du buffer à envoyer AdapterInfoSize = 0 error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize) ' Si l'appel à provoquer une erreur If error <> ERROR_SUCCESS Then ' Si cette erreur est différente de "Dépasement de capacité du buffer" ... If error <> ERROR_BUFFER_OVERFLOW Then ' ... Alors je ne sais pas quoi faire !! Exit Function End If End If ' On dimensionne le buffer avec la valeur renvoyer par le 1er appel ReDim AdapterInfoBuffer(AdapterInfoSize - 1) ' Cette fois, on récupère les infos avec un second appel à GetAdaptersInfo() error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize) ' Si l'appel a provoquer une erreur ... If error <> ERROR_SUCCESS Then ' ... Alors je ne sais pas quoi faire !! Exit Function End If ' On stocke les données dans une variable de type IP_ADAPTER_INFO CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo) Do ' Un adaptateur de plus, donc une MAC Address de plus : On redimensionne le tableau Idx = Idx + 1 ReDim Preserve ret(Idx) ' On va parcourir tous les octets de l'adresse MAC ... For i = 0 To AdapterInfo.AddressLength - 1 ' On ajoute l'octet en cours en le formattant un peu (passage en Héxa et ajout de zéro devant ' pour tomber toujours sur deux caractères) PhysicalAddress = PhysicalAddress & Right$("00" & Hex(AdapterInfo.Address(i)), 2) & "-" Next ' On mémorise l'adresse obtenue en supprimant le dernier "-" inutile ret(Idx) = Left$(PhysicalAddress, Len(PhysicalAddress) - 1) ' On tente d'accèder à l'adaptateur suivant pAdapt = AdapterInfo.Next ' S'il y a un adaptateur suivant, on stocke ses infos If pAdapt <> 0 Then CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo) Loop Until pAdapt = 0 ' On renvoie le tout GetMAC = ret End Function
Dim M() as string, i as long M = GetMac() For i = 0 to ubound(M) msgbox M(i) Next