VBA获取网卡的物理地址

来源:原创 点击数:11141 　 | 收藏 | 复制

时　间:2008-11-17 20:37:37
作　者:江羽 ID：3967 城市：南昌
摘　要:如何获取电脑的网卡物理地址
正　文:

如何获取电脑的网卡物理地址

有些网络代理商通过用户的网卡物理地址来限制某用户的多电脑接入，我以前用广电网络就是如此，为了让我的另一台电脑都能用宽带，我就曾尝试手动修改网卡的物理地址，实现了两台电脑的同时上网，哈哈！下面共享一段获取网卡物理地址的源码。

代码如下:

Option Explicit





Private 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 Long





Public 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 Function



Private Function HexEx(ByVal B As Long) As String



  Dim strH As String



    strH = Hex$(B)

    If Len(strH) < 2 Then

        strH = "0" & strH

    End If

    HexEx = strH



End Function