Startseite / Tipps / VB 5/6-Tipp 0261: MAC der Netzwerkkarte(n) auslesen

VB 5/6-Tipp 0261: MAC der Netzwerkkarte(n) auslesen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "txtComputername"
' Steuerelement: Optionsfeld-Steuerelement "optOtherComputer"
' Steuerelement: Optionsfeld-Steuerelement "optThisComputer"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Sub Command1_Click()
    Dim bLanAdapter() As Byte
    Dim i As Long
    Dim numAdapter As Long
    Dim macaddr As String
    
    Me.MousePointer = vbHourglass
    
    ' Listbox leeren
    List1.Clear
    
    'Alle Adapter auslesen
    numAdapter = modNetBios.NB_EnumLanAdapter(bLanAdapter)
        
    'wurde mindestens ein aktiver Adapter gefunden
    If numAdapter > 0 Then
        'Für jeden Adapter die MAC-Adresse auslesen
        For i = 1 To numAdapter
            'diesen Adapter initalisieren
            Call modNetBios.NB_ResetAdapter(bLanAdapter(i), 20, 30)
            
            If optThisComputer.Value = True Then
                ' MAC-Adresse dieses Adapters auslesen
                List1.AddItem modNetBios.NB_GetMACAddress(bLanAdapter(i))
            Else
                ' Probieren die MAC-Adresse über diesen Adapter zu ermitteln
                macaddr = modNetBios.NB_GetMACAddress(bLanAdapter(i), txtComputername.Text)
                ' Wenn eine MAC-Adresse über diesen Adapter ermittelt wurde,
                ' dann die MAC-Adresse anzeigen
                If Len(macaddr) > 0 Then List1.AddItem macaddr
            End If
        Next i
    Else
        List1.AddItem "Keine Netzwerkadapter gefunden!"
    End If
    
    Me.MousePointer = vbDefault
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'------ Anfang Modul "modNetBios" alias modNetBios.bas ------
'Modul: modNetBios
Option Explicit

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 Sub CopyMemory_ByRef Lib "kernel32" Alias _
        "RtlMoveMemory" (hpvDest As Any, hpvSource _
        As Any, ByVal cbCopy As Long)

Private Const NCBENUM As Byte = &H37
Private Const NCBFINDNAME As Byte = &H78
Private Const NCBDELNAME As Byte = &H31
Private Const NCBADDGRNAME As Byte = &H36
Private Const NCBADDNAME As Byte = &H30
Private Const NCBASTAT As Byte = &H33
Private Const NCBNAMSZ As Byte = 16
Private Const NCBRESET As Byte = &H32

Public Const NRC_ACTSES As Long = &HF&
Public Const NRC_BADDR As Long = &H7
Public Const NRC_BRIDGE As Long = &H23
Public Const NRC_BUFLEN As Long = &H1
Public Const NRC_CANCEL As Long = &H26
Public Const NRC_CANOCCR As Long = &H24
Public Const NRC_CMDCAN As Long = &HB
Public Const NRC_CMDTMO As Long = &H5
Public Const NRC_DUPENV As Long = &H30
Public Const NRC_DUPNAME As Long = &HD
Public Const NRC_ENVNOTDEF As Long = &H34
Public Const NRC_GOODRET As Long = &H0
Public Const NRC_IFBUSY As Long = &H21
Public Const NRC_ILLCMD As Long = &H3
Public Const NRC_ILLNN As Long = &H13
Public Const NRC_INCOMP As Long = &H6
Public Const NRC_INUSE As Long = &H16
Public Const NRC_INVADDRESS As Long = &H39
Public Const NRC_INVDDID As Long = &H3B
Public Const NRC_LOCKFAIL As Long = &H3C
Public Const NRC_LOCTFUL As Long = &H11
Public Const NRC_MAXAPPS As Long = &H36
Public Const NRC_NAMCONF As Long = &H19
Public Const NRC_NAMERR As Long = &H17
Public Const NRC_NAMTFUL As Long = &HE
Public Const NRC_NOCALL As Long = &H14
Public Const NRC_NORES As Long = &H9
Public Const NRC_NORESOURCES As Long = &H38
Public Const NRC_NOSAPS As Long = &H37
Public Const NRC_NOWILD As Long = &H15
Public Const NRC_OPENERR As Long = &H3F
Public Const NRC_OSRESNOTAV As Long = &H35
Public Const NRC_PENDING As Long = &HFF&
Public Const NRC_REMTFUL As Long = &H12
Public Const NRC_SABORT As Long = &H18
Public Const NRC_SCLOSED As Long = &HA
Public Const NRC_SNUMOUT As Long = &H8
Public Const NRC_SYSTEM As Long = &H40
Public Const NRC_TOOMANY As Long = &H22

Private Type NCB
  ncb_Command As Byte
  ncb_RetCode As Byte
  ncb_LSN As Byte
  ncb_Num As Byte
  ncb_pBuffer 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

Private 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

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 Type ENUM_LANA
    bCount As Byte
    bLana(300) As Byte
End Type

Public Function NB_EnumLanAdapter(bLanArray() As Byte) As Long
    Dim myNcb As NCB
    Dim bRetEnum As ENUM_LANA
    
    'NetBios Command Enum setzen
    myNcb.ncb_Command = NCBENUM
    
    'Bufferpointer eintragen
    myNcb.ncb_pBuffer = VarPtr(bRetEnum)
    
    'Größe des Buffers angeben
    myNcb.ncb_Length = Len(bRetEnum)
    
    'Alle aktiven Netzwerkkarten enumerieren
    If Netbios(myNcb) = NRC_GOODRET Then
    
        'Anzahl der aktiven Netzwerkkarten auslesen
        If bRetEnum.bCount Then
            NB_EnumLanAdapter = CLng(bRetEnum.bCount)
            
            'Nur auslesen, wenn mindestens 1 Netzwerkkarte gefunden wurde
            'Return Array anpassen
            ReDim bLanArray(1 To bRetEnum.bCount)
            
            'Daten ins Array kopieren
            CopyMemory_ByRef bLanArray(1), bRetEnum.bLana(0), bRetEnum.bCount
        End If
    End If
End Function

Public Function NB_ResetAdapter(lLanNumber As Byte, lSessions As Long, lMaxNames As Long) As Long
    Dim myNcb As NCB
    
    'Welche Netzwerkkarte soll resetet werden
    myNcb.ncb_Lana_Num = lLanNumber
    
    'NetBios Command setzen
    myNcb.ncb_Command = NCBRESET
    myNcb.ncb_LSN = 0

    'Maximale Anzahl an Sessions seztzen
    Mid$(myNcb.ncb_CallName, 1, 1) = Chr$(lSessions)
    
    'Maximale Anzahl an Namen setzen
    Mid$(myNcb.ncb_CallName, 3, 1) = Chr$(lMaxNames)
    
    'Netzwerkkarte reseten
    If Netbios(myNcb) = NRC_GOODRET Then NB_ResetAdapter = 1
End Function

Public Function NB_GetMACAddress(lLanNumber As Byte, Optional Server As String = "*") As String
    Dim myNcb As NCB
    Dim bRet As Byte
    Dim myASTAT As ASTAT
    
    'NetBios Command setzen
    myNcb.ncb_Command = NCBASTAT
    
    'Welche Netzwerkkarte soll benutzt werden
    myNcb.ncb_Lana_Num = lLanNumber
    
    'Server setzen, dies kann auch ein RemoteHost sein!
    myNcb.ncb_CallName = Server
    
    'Größe des Speichers setzen
    myNcb.ncb_Length = Len(myASTAT)
    
    'Buffer eintragen
    myNcb.ncb_pBuffer = VarPtr(myASTAT) 'pASTAT
    
    'Karte auslesen
    If Netbios(myNcb) = NRC_GOODRET Then
    
        'Daten in die neue
        NB_GetMACAddress = _
                   HexEx(myASTAT.adapt.adapter_address(0)) & "-" & _
                   HexEx(myASTAT.adapt.adapter_address(1)) & "-" & _
                   HexEx(myASTAT.adapt.adapter_address(2)) & "-" & _
                   HexEx(myASTAT.adapt.adapter_address(3)) & "-" & _
                   HexEx(myASTAT.adapt.adapter_address(4)) & "-" & _
                   HexEx(myASTAT.adapt.adapter_address(5))
    End If
End Function

Private Function HexEx(ByVal lNumber As Long) As String
    HexEx = Hex(lNumber)
    If Len(HexEx) = 1 Then HexEx = "0" & HexEx
End Function
'------- Ende Modul "modNetBios" alias modNetBios.bas -------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 39 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.