用vb取网卡mac地址为什么取不出来？■■■

Question

在csdn上找了取网卡mac地址的vb程序，但在取出来的是0000000。哪位高手能提供一种解决方法。谢谢了！   

Answer 1

小弟到是知道一种笨方法 IPCONFIG /ALL >1.TXT
延时 分析字符串  不过好象不大稳定哈

Answer 2

Private Sub Command1_Click()
Dim oAdapters As Object, oAdapter As Object
On Error Resume Next
Set oAdapters = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each oAdapter In oAdapters
MsgBox "MAC ADDRESS:  " & Replace(oAdapter.macaddress, ":", " ")
Exit For
Next
End Sub

Answer 3

你用getmac >>1.txt
然后分析1.txt

Answer 4

Option ExplicitPrivate Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private 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 TypePrivate 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 LongPrivate Sub Command1_Click()
    Dim myNcb As NCB
    Dim bRet As Byte
    Dim myASTAT As ASTAT, tempASTAT As ASTAT
    Dim pASTAT As Long
    
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    myNcb.ncb_command = NCBASTAT
    myNcb.ncb_lana_num = 0
    myNcb.ncb_callname = "*　　　　　　 "
    myNcb.ncb_length = Len(myASTAT)
    
    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
    If pASTAT = 0 Then Exit Sub
    
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    
    Debug.Print 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

Answer 5

我曾经遇到过这样的问题，当时的机器是双网卡，一块PCI的，一块WIFI的，WIFI在使用，PCI没有插网线，结果取到的就是0，但同样的程序在单网卡的机器或双网卡都通的机器上没有任何问题

Answer 6

BUGStudio(BUG) ( ) 信誉：100    Blog  2007-2-5 20:26:57  得分: 0  
的读出来00000000
Private Sub Command1_Click()
Dim oAdapters As Object, oAdapter As Object
On Error Resume Next
Set oAdapters = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each oAdapter In oAdapters
MsgBox "MAC ADDRESS:  " & Replace(oAdapter.macaddress, ":", " ")
Exit For
Next
End Sub这个可以

Answer 7

这个做法，可以的，wifi在线+普通卡断线。Sub main()Dim oAdapters As Object, oAdapter As Object
On Error Resume Next
Set oAdapters = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each oAdapter In oAdapters
MsgBox "MAC ADDRESS:  " & Replace(oAdapter.macaddress, ":", " ")
Exit For
NextEnd Sub  

Answer 8

cangwu_lee(橙子) ( ) 信誉：98    Blog   加为好友  2007-2-10 23:33:26  得分: 0  
 
 
   
这个做法，可以的，wifi在线+普通卡断线。Sub main()Dim oAdapters As Object, oAdapter As Object
On Error Resume Next
Set oAdapters = GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each oAdapter In oAdapters
MsgBox "MAC ADDRESS:  " & Replace(oAdapter.macaddress, ":", " ")
Exit For
NextEnd Sub  ==========================================================
2003下测试通过

Answer 9

....没发言的份了....一般的API函数写的代码取的时候都有可能取不回来...几位大虾写的WMI方式应该没问题....另外还有个办法,就是写一段汇编存到数组然后调用....

Answer 10

Sub wmiGetMac()
  Dim WmiObjSet, Obj
  Set WmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                            InstancesOf("Win32_NetworkAdapterConfiguration")
  On Local Error Resume Next
  For Each Obj In WmiObjSet
      MsgBox Obj.MACAddress
      MsgBox Obj.Description
      MsgBox Obj.DNSHostName
      MsgBox Obj.DNSDomain
      If Not IsNull(Obj.IPAddress) Then
         For i = 0 To UBound(Obj.IPAddress)
             MsgBox "IP address:" & Obj.IPAddress(i)
         Next
      End If
  Next
End Sub