新建Command1

Option Explicit

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 NET_CONTROL_BLOCK
    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 Netbios Lib "netapi32.dll" _
                          (pncb As NET_CONTROL_BLOCK) 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

'hHeap为要分配的内存块来自的堆的句柄,可以是从HeapCreate（）创建的动态堆句柄
'     也可以是由GetProcessHeap（）得到的默认堆句柄。
'参数dwFlags指定了影响堆分配的各个标志。该标志将覆盖在调用HeapCreate（）时所指定的相应标志，可能的取值为：
'标志   说明
'HEAP_GENERATE_EXCEPTIONS 该标志指定在进行诸如内存越界操作等情况时将抛出一个异常而不是简单的返回NULL指针
'HEAP_NO_SERIALIZE 强制对HeapAlloc（）的调用将与访问同一个堆的其他线程不按照顺序进行
'HEAP_ZERO_MEMORY 如果使用了该标志，新分配内存的内容将被初始化为0

'dwBytes设定了要从堆中分配的内存块的大小。

'如果HeapAlloc（）执行成功，将会返回从堆中分配的内存块的地址。
'如果由于内存不足或是其他一些原因而引起HeapAlloc（）函数的执行失败，将会引发异常。

Private Declare Function HeapAlloc Lib "kernel32" _
                          (ByVal hHeap As Long, ByVal dwFlags As Long, _
                          ByVal dwBytes As Long) As Long

'hHeap为要包含要释放内存块的堆的句柄
'dwFlags为堆栈的释放选项可以是0，也可以是HEAP_NO_SERIALIZE
'lpMem为指向内存块的指针。

'如果函数成功执行，将释放指定的内存块，并返回TRUE。
'该函数的主要作用是可以用来帮助堆管理器回收某些不使用的物理存储器以腾出更多的空闲空间，
'但是并不能保证一定会成功。
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
                          ByVal dwFlags As Long, lpMem As Any) As Long

Private Const NCBENUM As Long = &H37
Private Const MAX_LANA As Long = 254

Private Type LANA_ENUM
    Length As Byte
    Lana(MAX_LANA) As Byte
End Type

Private Sub Command1_Click()
    Dim NCB As NET_CONTROL_BLOCK
    Dim bRet As Byte
    Dim AST As ASTAT
    Dim pASTAT As Long
    Dim Lana As LANA_ENUM

    'NCB_buffer字段的值是,要发送的数据缓冲区的地址,或者要在其中存放接收到的数据的缓冲区的地址。
    NCB.ncb_buffer = VarPtr(Lana)     '取LANA_ENUM结构地址
    NCB.ncb_length = Len(Lana)        '填充结构大小
    NCB.ncb_command = NCBENUM         '枚举系统网卡
    pASTAT = Netbios(NCB)

    NCB.ncb_command = NCBRESET        '重置网卡。网卡在接受新的NCB命令之前必须重置。
    NCB.ncb_lana_num = Lana.Lana(0)   '获取网卡ID
    Netbios NCB

    '接受本地或远程接口卡的状态。使用此命令后，NCB_buffer成员指向由ADAPTER_STATUS结构填充的缓冲区，随后是NAME_BUFFER结构的数组。
    NCB.ncb_command = NCBASTAT

    NCB.ncb_callname = "*"            '重新填充结构
    NCB.ncb_length = Len(AST)
    Netbios NCB

    Debug.Print Err.LastDllError

    'GetProcessHeap获取进程当前的默认堆,HeapAlloc返回从堆中分配的内存块的地址。
    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, NCB.ncb_length)

    If pASTAT = 0 Then

        Debug.Print "memory allcoation failed!"
        Exit Sub

    End If

    CopyMemory AST, NCB.ncb_buffer, Len(AST)

    MsgBox Format$(Hex$(AST.adapt.adapter_address(0)), "00") & " " & _
           Format$(Hex$(AST.adapt.adapter_address(1)), "00") _
           & " " & Hex$(AST.adapt.adapter_address(2)) & " " _
           & Format$(Hex$(AST.adapt.adapter_address(3)), "00") _
           & " " & Format$(Hex$(AST.adapt.adapter_address(4)), "00") & " " _
           & Format$(Hex$(AST.adapt.adapter_address(5)), "00")

    '释放内存块的堆的句柄
    HeapFree GetProcessHeap(), 0, pASTAT
End Sub