Option Explicit
 
' alle benötigten API-Deklarationen
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
 
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const NCBRESET = &H32
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
 
Private Type NCB
  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 ' Reserved, must be 0
  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
 
' MAC-Adresse der Netzwerk-Karte ermitteln
Public Function MAC_Address() As String
  Dim strucNCB As NCB
  Dim strucASTAT As ASTAT
  Dim bResult As Byte
  Dim lResult As Long
  Dim sAddress As String
  Dim sBuffer As String
  Dim i As Integer
 
  With strucNCB
    ' Struktur füllen
    .ncb_command = NCBRESET
    bResult = Netbios(strucNCB)
    .ncb_command = NCBASTAT
    .ncb_lana_num = 0
    .ncb_callname = "*               "
    .ncb_length = Len(strucASTAT)
 
    ' Heap-Speicher reservieren
    lResult = HeapAlloc(GetProcessHeap(), _
      HEAP_GENERATE_EXCEPTIONS Or _
      HEAP_ZERO_MEMORY, .ncb_length)
 
    If lResult <> 0 Then
      .ncb_buffer = lResult
      bResult = Netbios(strucNCB)
      CopyMemory strucASTAT, .ncb_buffer, Len(strucASTAT)
 
      ' MAC-Adresse
      For i = 0 To 5
        sBuffer = Hex$(strucASTAT.adapt.adapter_address(i))
        sAddress = sAddress & IIf(Len(sBuffer) = 2, _
          sBuffer, "0" & sBuffer) & " "
      Next i
 
      ' Heap-Speicher wieder freigeben
      HeapFree GetProcessHeap(), 0, lResult
    End If
 
    If Len(sAddress) Then
      ' MAC-Adresse existiert
      MAC_Address = Trim$(sAddress)
    Else
      ' keine MAC-Adresse vorhanden
      MAC_Address = "nicht verfügbar"
    End If
  End With
End Function
 
Private Sub Command1_Click()
MsgBox MAC_Address
End Sub

____________________________________