如何100%有效获得网卡的MAC地址！

Question

我有一段程序如下：有些系统可以获得MAC，有些得到的却是00-00-00-00-00，
Option ExplicitPublic CheckCode As LongPrivate Const NCBASTAT                       As Long = &H33
Private Const NCBNAMSZ                       As Integer = 16
Private Const HEAP_ZERO_MEMORY               As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS       As Long = &H4
Private Const NCBRESET                       As Long = &H32
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
    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 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 LongPublic Function GetMAC() As Integer  
  Dim bRet    As Byte
  Dim myNcb   As NCB
  Dim myASTAT As ASTAT
  Dim pASTAT  As Long
  Dim intMAC As Integer
  
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    With myNcb
        .ncb_command = NCBASTAT
        .ncb_lana_num = 0
        .ncb_callname = "* "
        .ncb_length = Len(myASTAT)
        pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, .ncb_length)
    End With
    If pASTAT = 0 Then
        Exit Function
    End If
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    intMAC = myASTAT.adapt.adapter_address(0)
    intMAC = intMAC + myASTAT.adapt.adapter_address(1)
    intMAC = intMAC + myASTAT.adapt.adapter_address(2)
    intMAC = intMAC + myASTAT.adapt.adapter_address(3)
    intMAC = intMAC + myASTAT.adapt.adapter_address(4)
    intMAC = intMAC + myASTAT.adapt.adapter_address(5)
    GetMAC = intMAC
    Call HeapFree(GetProcessHeap(), 0, pASTAT)End FunctionPublic Function GetMACAddress() As String  
  Dim bRet    As Byte
  Dim myNcb   As NCB
  Dim myASTAT As ASTAT
  Dim pASTAT  As Long
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    With myNcb
        .ncb_command = NCBASTAT
        .ncb_lana_num = 0
        .ncb_callname = "* "
        .ncb_length = Len(myASTAT)
        pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, .ncb_length)
    End With
    If pASTAT = 0 Then
        Exit Function
    End If
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    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))
    Call HeapFree(GetProcessHeap(), 0, pASTAT)End FunctionPrivate Function HexEx(ByVal B As Long) As String
 
  Dim aa As String    aa = Hex$(B)
    If Len(aa) < 2 Then
        aa = "0" & aa
    End If
    HexEx = aa
End Function

Answer 1

以上代码在windows xp sp1环境下还是比较好用的。
关注

Answer 2

用WMI，在NT系统下保管有用100％

Answer 3

好厉害。。
这么长的代码。不用ARP命令先刷一遍缓存就去取吗？
想获取真实网卡MAC。你可以去跟一下网卡MAC修改器，看看它是怎么取真实地址的。

Answer 4

Private Sub Command1_Click()
    Close #1
    Open "d:\test.bat" For Output As #1
    Print #1, "ipconfig.exe /all > d:\test.txt"
    Close #1
    DoEvents
    Shell "d:\test.bat", vbHide
    '延长时间2秒,等待test.bat的结果
    t1 = Int(Timer)
    Do While Int(Timer) < t1 + 2
    DoEvents
    Loop
    
    Open "d:\test.txt" For Input As #1
    Do While Not EOF(1)
        Line Input #1, X
        If InStr(X, "Physical Address") > 0 Then
            n = InStr(X, ": ")
            Gateway = Mid(X, n + 1)
            MsgBox "MAC地址：" & Gateway
        End If
    Loop
    Close #1
End Sub

Answer 5

运行ipconfig.exe这个软件我也加了，但在有些系统的Path路径不对，根本找不到这个文件

Answer 6

你程序自己带一个ipconfig呗，，它没有你就给它Copy到系统目录去

Answer 7

http://topic.csdn.net/t/20030503/12/1734474.html

Answer 8

抱歉， 上面的不是GetAdaptersInfo， 而是得到ip地址的。

Answer 9

Option Explicit
  Private Const MAX_ADAPTER_NAME_LENGTH                    As Long = 256
  Private Const MAX_ADAPTER_DESCRIPTION_LENGTH      As Long = 128
  Private Const MAX_ADAPTER_ADDRESS_LENGTH              As Long = 8
  Private Const ERROR_SUCCESS      As Long = 0
    
  Private Type IP_ADDRESS_STRING
          IpAddr(0 To 15)      As Byte
  End Type
    
  Private Type IP_MASK_STRING
          IpMask(0 To 15)      As Byte
  End Type
    
  Private Type IP_ADDR_STRING
          dwNext          As Long
          IpAddress    As IP_ADDRESS_STRING
          IpMask          As IP_MASK_STRING
          dwContext    As Long
  End Type
    
  Private Type IP_ADAPTER_INFO
      dwNext                                As Long
      ComboIndex                        As Long     '保留
      sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))                    As Byte
      sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3))      As Byte
      dwAddressLength              As Long
      sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))                  As Byte
      dwIndex                              As Long
      uType                                  As Long
      uDhcpEnabled                    As Long
      CurrentIpAddress            As Long
      IpAddressList                  As IP_ADDR_STRING
      GatewayList                      As IP_ADDR_STRING
      DhcpServer                        As IP_ADDR_STRING
      bHaveWins                          As Long
      PrimaryWinsServer          As IP_ADDR_STRING
      SecondaryWinsServer      As IP_ADDR_STRING
      LeaseObtained                  As Long
      LeaseExpires                    As Long
  End Type
    
    
  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
      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
    
  Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" (pTcpTable As Any, pdwSize As Long) As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)
  Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
  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
    
  Public Function EthernetAddress(LanaNumber As Long) _
  As String
    
      Dim udtNCB               As NCB
      Dim bytResponse   As Byte
      Dim udtASTAT           As ASTAT
      Dim udtTempASTAT   As ASTAT
      Dim lngASTAT           As Long
      Dim strOut               As String
      Dim x                         As Integer
    
      udtNCB.ncb_command = NCBRESET
      bytResponse = Netbios(udtNCB)
      udtNCB.ncb_command = NCBASTAT
      udtNCB.ncb_lana_num = LanaNumber
      udtNCB.ncb_callname = "*  "
      udtNCB.ncb_length = Len(udtASTAT)
      lngASTAT = HeapAlloc(GetProcessHeap(), _
  HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
    
      strOut = ""
      If lngASTAT Then
          udtNCB.ncb_buffer = lngASTAT
          bytResponse = Netbios(udtNCB)
          CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
            With udtASTAT.adapt
              For x = 0 To 5
                  strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
              Next x
          End With
          HeapFree GetProcessHeap(), 0, lngASTAT
      End If
      EthernetAddress = strOut
  End Function
    
    Public Function LocalIPAddress() As String
        Dim cbRequired     As Long
        Dim buff()             As Byte
        Dim Adapter           As IP_ADAPTER_INFO
        Dim AdapterStr     As IP_ADDR_STRING
        Dim ptr1                 As Long
        Dim sIPAddr           As String
        Dim found               As Boolean
        Dim iFound   As Integer
        iFound = 0
        sIPAddr = ""
        Dim sReturn   As String
        sReturn = ""
        Call GetAdaptersInfo(ByVal 0&, cbRequired)
        If cbRequired = 0 Then Exit Function
        ReDim buff(0 To cbRequired - 1) As Byte
        If GetAdaptersInfo(buff(0), cbRequired) <> ERROR_SUCCESS Then Exit Function
        
        '获取存放在buff()中的数据的指针
          ptr1 = VarPtr(buff(0))
          Do While (ptr1 <> 0)
              '将第一个网卡的数据转换到IP_ADAPTER_INFO结构中
                CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
                With Adapter
                    'IpAddress.IpAddr成员给出了DHCP的IP地址
                      Dim k As Long
                      For k = 1 To .dwAddressLength
                          sReturn = sReturn & Right("0" & Hex(AscB(MidB(.sIPAddress, k, 1))), 2) & "-"
                      Next k
                      sReturn = Left(sReturn, Len(sReturn) - 1) & vbCrLf
                      ptr1 = .dwNext
                End With     'With  Adapter
        '不再有网卡时，ptr1的值为0
          Loop    'Do  While  (ptr1  <>  0)
      '返回结果字符串
        LocalIPAddress = sReturn
  End Function
        
  Private Sub Command1_Click()
  Debug.Print LocalIPAddress
  End Sub

Answer 10

Private Sub Command1_Click()
  Debug.Print LocalIPAddress
  End Sub===========
这个函数是从别人那里修改的， 没注意那些名字. 所以应该叫
LocalMACAddress
还有
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))                  As Byte
也应该是 
sMACAddress.....