Attribute VB_Name = "ModGetMAC"
Option Explicit
'*************************************************************************
'**模 块 名：ModGetMAC
'**创 建 人：嗷嗷叫的老马
'**日    期：2006年12月27日
'**描    述：取得本机及远程MAC地址
'**版    本：V1.0
'*************************************************************************

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
    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 '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 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
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 Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long
Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long
Private Declare Function SendARP Lib "iphlpapi.dll" (ByVal DestIP As Long, _
                                                     ByVal SrcIP As Long, _
                                                     pMacAddr As Long, _
                                                     PhyAddrLen As Long) As Long

Public Function GetMAC() As String
    '返回本机MAC地址
    Dim tmp As String
    Dim pASTAT As Long
    Dim NCB As NET_CONTROL_BLOCK
    Dim AST As ASTAT
    
    NCB.ncb_command = NCBRESET
    
    Call Netbios(NCB)
    
    NCB.ncb_callname = "* "
    NCB.ncb_command = NCBASTAT
    NCB.ncb_lana_num = 0
    NCB.ncb_length = Len(AST)
    
    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _
    Or HEAP_ZERO_MEMORY, NCB.ncb_length)
    
    If pASTAT = 0 Then
        Debug.Print "memory allocation failed!"
        Exit Function
    End If
    
    NCB.ncb_buffer = pASTAT
    Call Netbios(NCB)
    
    CopyMemory AST, NCB.ncb_buffer, Len(AST)
    
    tmp = Format$(Hex(AST.adapt.adapter_address(0)), "00") & "-" & _
    Format$(Hex(AST.adapt.adapter_address(1)), "00") & "-" & _
    Format$(Hex(AST.adapt.adapter_address(2)), "00") & "-" & _
    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
    GetMAC = tmp
End Function

Public Function GetMACRemote(ByVal sRemoteIP As String, sRemoteMacAddress As String) As Boolean
    '返回目标IP的MAC地址
    Dim dwRemoteIP  As Long
    Dim pMacAddr    As Long
    Dim bpMacAddr() As Byte
    Dim PhyAddrLen  As Long
    Dim cnt         As Long
    Dim tmp         As String
      
    dwRemoteIP = inet_addr(sRemoteIP)
    If dwRemoteIP <> 0 Then
       PhyAddrLen = 6
       If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
          If pMacAddr <> 0 And PhyAddrLen <> 0 Then
             ReDim bpMacAddr(0 To PhyAddrLen - 1)
             CopyMemory bpMacAddr(0), VarPtr(pMacAddr), ByVal PhyAddrLen
             For cnt = 0 To PhyAddrLen - 1
                 If bpMacAddr(cnt) = 0 Then
                    tmp = tmp & "00-"
                 Else
                    tmp = tmp & Hex$(bpMacAddr(cnt)) & "-"
                 End If
             Next
             If Len(tmp) > 0 Then
                sRemoteMacAddress = Left$(tmp, Len(tmp) - 1)
                GetMACRemote = True
             End If
             Exit Function
          Else
            GetMACRemote = False
          End If
       Else
          GetMACRemote = False
       End If
    Else
      GetMACRemote = False
    End If
End Function