Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 13 19:16:10

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

RECUPERER LA MAC ADRESSE

Information sur la source

Note :

8,13 / 10

Catégorie :Réseau & Internet Classé sous :récupèrer, adresse, mac Niveau :Expert Date de création :16/10/1999 Vu :26 144

Auteur : Nix

Ecrire un message privé

Site perso

Ce membre participe au partage de revenus publicitaires

Commentaire sur cette source (14)

Ajouter un commentaire et/ou une note

Description

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

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

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

Sources du même auteur

FAIRE UN PING (ICMP) EN VB 2005 (LE PLUS SIMPLEMENT DU MONDE...

IMPRIMER LE CONTENU D'UN RICHTEXTBOX

TESTEUR DE REGEX (REGULAR EXPRESSIONS)

FORCER LE REBOOT SOUS WINDOWS NT OU WINDOWS 2000 (REDÉMARRAG...

COMPTER LES MOTS DANS UNE CHAINE DE CARACTÈRE

Toutes les sources de Nix

Sources de la même categorie

GESTIONNAIRE DE TÉLÉCHARGEMENT, AVEC REPRISE ET MULTITHREADI... par Madx23

CONVERTIR DU TEXTE RTF EN CODE HTML ET VICE-VERSA par vicosta

DICTIONAIRE TEXT/AUDIO/VISUELLE ANGLAIS AVEC WEBBROWSER CONT... par majnounmajda

NSLOOKUP EN VB.NET OU COMMENT FAIRE UNE REQÛETE DNS EN PRÉCI... par ShareVB

MINI SEVEUR HTTP AVEC INTERFACE GRAPHIQUE ET IMPLÉMENTATIONS... par lemout

Toutes les sources de la catégorie Réseau & Internet

Sources en rapport avec celle ci

INFORMATIONS SUR LES INTERFACES RÉSEAUX par Mayzz

RÉCUPÉRER L'INDEX D'UNE ADRESSE IP LOCALE À PARTIR DE L'ADRE... par Philippe734

SPACE - UN SPACE MAC POUR WINDOWS par vbnino

CONTROLE UTILISATEUR IPBOX POUR LA SAISIE D'ADRESSE IP par foliv57

LISTER LES ADRESSES MAC par thepoe

Commentaires et avis

Commentaire de Ben le 30/12/2001 17:00:47

Bonjour,

J'ai un petit souci avec ce code... en effet il m'indique n'importe quoi sous win95...
J'utilise VB5 et pourtant il marche tres bien avec win98...
Pourriez vous m'indiquer s'il existe une solution à ce problème ?

D'avance merci et bravo pour ce superbe site...

Ben

Commentaire de kilyn le 20/02/2002 12:17:36

Salut !

J'ai trouvé sur "microsoft.fr" en tapant le mot clé "mac" dans la zone de recherche de la page d'accueil un meilleur code pour récupérer la mac adresse. Ce prog marche sur toutes les versions de windows. Mais je sais pas s'il est valable sous VB5 car je l'ai programmé en VB6.

Mais je te le donne quand même au cas où ça pourrait servir :

'A mettre dans un module
Public Const NCBASTAT As Long = &H33
Public Const NCBNAMSZ As Long = 16
Public Const NCBRESET As Long = &H32

Public Type NET_CONTROL_BLOCK
    ncb_command As Byte
    ncb_retcode As Byte
    ncb_lsn As Byte
    ncb_num As Byte
    ncb_buffer As Long
    ncb_length As Integer
    ncb_callname As String * NCBNAMSZ
    ncb_name As String * NCBNAMSZ
    ncb_rto As Byte
    ncb_sto As Byte
    ncb_post As Long
    ncb_lana_num As Byte
    ncb_cmd_cplt As Byte
    ncb_reserve(9) As Byte
    ncb_event As Long
End Type

Public Type ADAPTER_STATUS
    adapter_address(5) As Byte
    rev_major As Byte
    reserved0 As Byte
    adapter_type As Byte
    rev_minor As Byte
    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

Public Type NAME_BUFFER
    name As String * NCBNAMSZ
    name_num As Integer
    name_flags As Integer
End Type

Public Type ASTAT
    adapt As ADAPTER_STATUS
    NameBuff(30) As NAME_BUFFER
End Type

Public Declare Function Netbios Lib "netapi32.dll" (pncb As NET_CONTROL_BLOCK) As Byte

Public Function MACAddress() As String
    Dim macAdr As String
    Dim ncb As NET_CONTROL_BLOCK
    Dim adapter As ASTAT

    ncb.ncb_command = NCBRESET
    Call Netbios(ncb)

    ncb.ncb_command = NCBASTAT
    ncb.ncb_lana_num = 0
    ncb.ncb_callname = "* "
    ncb.ncb_buffer = VarPtr(adapter)
    ncb.ncb_length = Len(adapter)

    Call Netbios(ncb) 'renvoie entre autre la mac adresse dans une structure
    For i = 0 To 5
        macAdr = macAdr & Format$(Hex(adapter.adapt.adapter_address(i)), "00") & " "
    Next i

    macAdr = Trim(macAdr) 'Enlève les espces à droite et à gauche de la chaîne
    MACAddress = macAdr

End Function

Private Sub Form_load()
    MsgBox MACAddress
End Sub

Commentaire de Marcial le 27/06/2003 12:40:37

slt,
Quelqu'un sait-il comment récupérer une adresse Mac provenant d'une éventuelle seconde carte reseau ?

Commentaire de spet le 09/07/2003 15:52:22

Salut tout le monde...

Je viens de tester vos deux programmes pour recuperer l'adresse Mac.
J'ai un probléme sur une machine...
En effet, l'@ de la carte est : 00 02 A5 0A 88 4C

et par le prog, j'obtiens: 00 02 A5 A 88 4C

Il me manque un chiffre... :(
Quelqu'un serait ce qui se passe???

Merci de votre aide.

Spet.

Commentaire de VHJ le 25/07/2003 12:37:42

Salut,
J'ai essayé tous les bouts de codes pour récupérer la Mac Adresse, résultat il sme retournent que des 00 00 00 00 00 00

Commentaire de fifipil909 le 22/08/2003 12:02:48

salut ba moi ca marche nikel par contre le pied serais de pouvoir trouver les adresse MAC de pc distant !!

si kelkun a des news la dessus je suis preneur

merci !

Commentaire de bibi79 le 17/10/2003 09:20:35

Bonjour, Je suis tout nouveau.
Moi, j'utilise l'ARP. L'adresse MAC est stocké dans l'ARP lorsque que tu fais un ping d'une adresse IP. Je fais un scan IP via un ping et régulierement je fais un ARP -a > fichier .txt
Puis je traite le fichier en cherchant la ligne avec mon IP rechercher au bout j'ai mon adresse MAC
Et cela fonctionne assez bien
Voila bon courrage

Commentaire de aazouf le 08/03/2004 22:21:57

Pour ceux dont il manque le 0 voici le bout de code à changer dans le for

    For I = 0 To 5
        If Len(Format$(Hex(adapter.adapt.adapter_address(I)), "00")) < 2 Then
            macAdr = macAdr & "0"
        End If
        macAdr = macAdr & Format$(Hex(adapter.adapt.adapter_address(I)), "00") & " "
    Next I

Commentaire de redsentry le 11/05/2004 16:49:50

Ca marche du premier coup sur Xp-Home et W98.
sans les zéros du début mais je m'en gratte

Excellent Nix

Commentaire de ftjarod le 16/06/2004 16:05:28

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.

Commentaire de VBSorcier le 27/04/2005 12:28:39

ce code il est aussi dans msdn

"HOWTO: Get Network Adapter Address from Visual Basic"

Commentaire de alkaesare le 02/11/2006 15:43:28

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

Commentaire de Ouneufe le 27/11/2007 11:29:58

ça ne m'affiche que des zéros, désespérant.

Commentaire de FrancisVif le 05/01/2011 11:45:01

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

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

URGENT !!! Récupérer la mac adresse à partir d'une adresse ip [ par kilyn ] J'aimerais savoir comment récupérer en VB la mac adresse de ma carte réseau à partir d'une adresse réseau. Serait-il possible de le faire sans les API codification de l'adresse MAC [ par yul ] je desire connaitre le constructeur de la carte reseau a partir de l'adresse mac. normalement dans la codification une partie de l'adresse mac corresp Lire la MAC Adresse [ par Jije ] Comment obtenir sur un reseau ethernet la MAC adresse d'un autre PC sous VB (Le protocole installé est TCP/IP)?Merci! MAC Adresse d'un poste distant [ par Lily ] Bonjour,Je cherche désespérément le moyen de connaître la MAC Adresse d'une machine dont on connaît l'IP ?Mon but : pinguer une machine, récupérer son Mac adresse en reseau [ par Membraxe ] Salut, je voudrais savoir comment recuperer la MAC adresse de chaque poste de mon reseau a partir d'un seul poste.merci d'avance Connaitre une adr. IP depuis une adr. MAC [ par Alain ] Comment peut-on faire sous vb pour connaître l'adresse IP d'un périphérique connecté sur le réseau s'il on connait son adresse MAC (physique)?Merci d' Comment recuperer l'adresse mac d'une machine distante? [ par RaSTaDiNo ] Bonjourtout est dans le titre ;)Mercii lire la mac adresse [ par jasonfly ] J'ai trouvé sur ce site un programme pour lire la mac adresse. Malheureusement, le programme me donne comme sortie : 0.0.0.0.0.0Je suis presque sûr qu adresse mac hub, routeur etc [ par ac2n ] Récupérer une adresse mac d'un pc, facile (nbtstat ou arp)mais l'adresse mac d'un hub ,imprimante réseau, switch ou routeur est ce possible ? dans les Trouver adresse MAC en VB [ par bouv ] A l'aide !!!Je cherche l'adresse MAC d'une carte réseau en VB.C'est pour protéger un soft.Quelqu'un peut-il m'aider SVP ?

Nos sponsors

Derniers Blogs

TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice

[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio

TECHDAYS PARIS 2012 : CHUCK MORRIS N'A PAS PEUR DES MALWARES, CE SONT LES MALWARES QUI ONT PEUR DE CHUCK MORRIS par ROMELARD Fabrice

[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz

SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc

Forum

RE : UN NOM EGALE UNE COULEUR par ucfoutu

RE : UN NOM EGALE UNE COULEUR par mibri

RE : UN NOM EGALE UNE COULEUR par ucfoutu

RE : UN NOM EGALE UNE COULEUR par mibri

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Creation de newsletter sur une page Facebook
Budget : 400€
fichier d-export de site OS commerce ver plateforme logistique-CDC disponible
Budget : 1 200€
Creation d-un site-pour formulaire Visa
Budget : 4 000€

Logiciels

DocTranslate (V3.1.0.0)
DOCTRANSLATE (V3.1.0.0)

DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom...

Cliquez pour télécharger DocTranslate
Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System