Recuperer la mac adresse

Soyez le premier à donner votre avis sur cette source.

Snippet vu 29 742 fois - Téléchargée 88 fois


Contenu du snippet

Faites un Form(Form1) avec Bouton(Command1)
Malheureusement le source n'était pas commenté et je ne sais pas qui en est l'auteur
En tout cas, il fonctionne bien

Source / Exemple :


Option Explicit
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

    Private Type NCB
        ncb_command As Byte 'Integer
        ncb_retcode As Byte 'Integer
        ncb_lsn As Byte 'Integer
        ncb_num As Byte ' Integer
        ncb_buffer As Long 'String
        ncb_length As Integer
        ncb_callname As String * NCBNAMSZ
        ncb_name As String * NCBNAMSZ
        ncb_rto As Byte 'Integer
        ncb_sto As Byte ' Integer
        ncb_post As Long
        ncb_lana_num As Byte 'Integer
        ncb_cmd_cplt As Byte  'Integer
        ncb_reserve(9) As Byte ' Reserved, must be 0
        ncb_event As Long
    End Type
    Private Type ADAPTER_STATUS
        adapter_address(5) As Byte 'As String * 6
        rev_major As Byte 'Integer
        reserved0 As Byte 'Integer
        adapter_type As Byte 'Integer
        rev_minor As Byte 'Integer
        duration As Integer
        frmr_recv As Integer
        frmr_xmit As Integer
        iframe_recv_err As Integer
        xmit_aborts As Integer
        xmit_success As Long
        recv_success As Long
        iframe_xmit_err As Integer
        recv_buff_unavail As Integer
        t1_timeouts As Integer
        ti_timeouts As Integer
        Reserved1 As Long
        free_ncbs As Integer
        max_cfg_ncbs As Integer
        max_ncbs As Integer
        xmit_buf_unavail As Integer
        max_dgram_size As Integer
        pending_sess As Integer
        max_cfg_sess As Integer
        max_sess As Integer
        max_sess_pkt_size As Integer
        name_count As Integer
   End Type
   Private Type NAME_BUFFER
        name  As String * NCBNAMSZ
        name_num As Integer
        name_flags As Integer
   End Type
   Private Type ASTAT
        adapt As ADAPTER_STATUS
        NameBuff(30) As NAME_BUFFER
   End Type

   Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
   Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
   Private Declare Function GetProcessHeap Lib "kernel32" () As Long
   Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
   Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
   Sub Command1_Click()
       Dim myNcb As NCB
       Dim bRet As Byte
       myNcb.ncb_command = NCBRESET
       bRet = Netbios(myNcb)

       myNcb.ncb_command = NCBASTAT
       myNcb.ncb_lana_num = 0
       myNcb.ncb_callname = "*               "

       Dim myASTAT As ASTAT, tempASTAT As ASTAT
       Dim pASTAT As Long
       myNcb.ncb_length = Len(myASTAT)
       Debug.Print Err.LastDllError
       pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _
                Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
       If pASTAT = 0 Then
          Debug.Print "memory allcoation failed!"
          Exit Sub
       End If
       myNcb.ncb_buffer = pASTAT
       bRet = Netbios(myNcb)
       Debug.Print Err.LastDllError
       CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
       MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & _
              Hex(myASTAT.adapt.adapter_address(1)) _
              & " " & Hex(myASTAT.adapt.adapter_address(2)) & " " _
              & Hex(myASTAT.adapt.adapter_address(3)) _
              & " " & Hex(myASTAT.adapt.adapter_address(4)) & " " _
              & Hex(myASTAT.adapt.adapter_address(5))
       HeapFree GetProcessHeap(), 0, pASTAT
   End Sub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
2
Date d'inscription
mardi 15 décembre 2009
Statut
Membre
Dernière intervention
10 septembre 2012

Bon allez, il est sympa que j'apporte aussi ma contribution ...
Voici donc ma méthode pour trouver une adresse MAC, faites-en bon usage, et apportez vos commentaires si nécessaire.
Francis

Option Explicit

Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long
Private Declare Function SendARP Lib "iphlpapi.dll" (ByVal DestIP As Long, ByVal SrcIP As Long, pMacAddr As Long, PhyAddrLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)

Sub Form_Load()

Dim MonIp As String, MacLue As String, MaMac As String

' Pour lire l'adresse IP de la machine, ajouter au préalable un contrôle Winsock dans votre feuille nommé Winsock1 '
' Sinon, prédéfinir l'adresse IP de la machine, ou n'importe quelle autre présente sur le réseau) '

MonIp = Winsock1.LocalIP
' MonIp = "192.168.1.1" ' Exemple pour l'adresse MAC d'une LiveBox

If Len(MonIp) > 0 Then
MaMac = LireAdresseMac(MonIp)
If MaMac = "" Then
MaMac = "Erreur de lecture Adresse Mac sur IP:" & MonIp
End If
Else
MaMac = "Erreur d'adresse IP !"
End If

MsgBox MaMac
End

End Sub

Function LireAdresseMac(IpLue As String) As String

Dim NumeroIp As Long, AdresseMac As Long, LongueurAdresse As Long, TableMac() As Byte, n As Integer, Octet As String

NumeroIp = inet_addr(IpLue)

If NumeroIp <> 0 Then
LongueurAdresse = 6
If SendARP(NumeroIp, 0, AdresseMac, LongueurAdresse) = 0 Then
If (AdresseMac <> 0) And (LongueurAdresse <> 0) Then
ReDim TableMac(0 To LongueurAdresse - 1)
CopyMemory TableMac(0), AdresseMac, ByVal LongueurAdresse
For n = 0 To LongueurAdresse - 1
Octet = Hex(TableMac(n))
LireAdresseMac = LireAdresseMac & IIf(Len(Octet) < 2, "0" & Octet, Octet)
If n < LongueurAdresse - 1 Then
LireAdresseMac = LireAdresseMac & "-"
End If
Next
End If
End If
End If

End Function
Messages postés
60
Date d'inscription
mardi 4 septembre 2001
Statut
Membre
Dernière intervention
19 janvier 2009

ça ne m'affiche que des zéros, désespérant.
Messages postés
5
Date d'inscription
jeudi 30 mars 2006
Statut
Membre
Dernière intervention
22 décembre 2006

slt je voudrais bien savoir si il y a un moyen pour sécuriser une application VB6 a part l'dresse MAC
et merci d'avance
Messages postés
102
Date d'inscription
jeudi 31 mars 2005
Statut
Membre
Dernière intervention
29 avril 2007

ce code il est aussi dans msdn

"HOWTO: Get Network Adapter Address from Visual Basic"
Messages postés
2
Date d'inscription
mardi 21 octobre 2003
Statut
Membre
Dernière intervention
12 mai 2006

Il faut rendre a César ce qui apartient a César...
Le code vient de : http://vbnet.mvps.org/index.html?code/network/macaddress.htm.

Ce code reste néamoins stable, mais uniquement pour les configs avec 1 carte réseau...
Des modifs restent à aporter avec une config à plusieurs cartes.
A optimiser peut-être.
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.