1, API-Guide提取

Option Explicit

Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132

Type IP_ADDR_STRING
Next As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End Type

Type IP_ADAPTER_INFO
Next As Long
ComboIndex As Long
AdapterName As String * MAX_ADAPTER_NAME_LENGTH
Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
AddressLength As Long
Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
Index As Long
Type1 As Long
DhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
HaveWins As Boolean
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type

Public Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Sub main()

    Dim i As Integer, FixedInfoSize&, AdapterInfoSize&
    Dim PhysicalAddress  As String
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim pAdapt As Long

    '获得网络参数
    GetNetworkParams ByVal 0&, FixedInfoSize
    '建立网络参数信息缓冲区
    ReDim FixedInfoBuffer(FixedInfoSize - 1)

    '获取适配器信息
    GetAdaptersInfo ByVal 0&, AdapterInfoSize
    '建立适配器信息缓冲区
    ReDim AdapterInfoBuffer(AdapterInfoSize - 1)

    GetAdaptersInfo AdapterInfoBuffer(0), AdapterInfoSize

    '拷贝AdapterInfo结构
    CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
    pAdapt = AdapterInfo.Next

    Do While pAdapt <> 0

        For i = 0 To AdapterInfo.AddressLength - 1

            PhysicalAddress = PhysicalAddress & Format$(Hex$(AdapterInfo.Address(i)), "00")

            If i < AdapterInfo.AddressLength - 1 Then

                PhysicalAddress = PhysicalAddress & "-"

            End If

        Next

        MsgBox "Physical Address: " & PhysicalAddress

        PhysicalAddress = ""

        pAdapt = AdapterInfo.Next

        '查找下一个网卡
        If pAdapt <> 0 Then

            CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)

        End If

    Loop

End Sub

'btw,再好的手册也有终结版，令人感慨，以后得靠自己了。

2, 根据IP获取MAC

Option Explicit

Private Declare Function inet_addr Lib "wsock32.dll" (ByVal IP As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'DestIP目标IP地址，IPAddr 结构. ARP请求试图获取指定IP地址相应的物理地址。
'SrcIP发送者IP地址，IPAddr 结构.这个参数是可选的，调用者可以指定参数为NULL。
'PAddr指向一个ULONG 变量数组. DestIP 指定的IP地址的物理地址获取存放在数组的首六个字节。
'PhyAddrLen输入时, 指定缓冲区最大字节数接受MAC地址。输出时t, 指定 pMacAddr 被写入的字节数.
'SendARP 函数发送ARP请求获取指定IP地址相应的物理地址。
Private Declare Function SendARP Lib "iphlpapi.dll" (ByVal DestIP As Long, ByVal SrcIP As Long, PAddr As Long, PhyAddrLen As Long) As Long

Private Const NO_ERROR = 0

Private Sub cmdExit_Click()

    End

End Sub

Private Sub cmdGet_Click()

    Dim sRemotePAddress As String

    If Len(txtRemoteIP.Text) > 0 Then

        If GetRemotePAddress(txtRemoteIP.Text, sRemotePAddress) Then

            labRemoteAddress.Caption = sRemotePAddress

        Else

            labRemoteAddress.Caption = "获取远程网卡物理地址失败。"

        End If

    End If

End Sub

'sRemoteIP - 远程网卡的IP地址
'sRemotePAddress - 用来反回获取的物理地址
'如果成功, 函数返回真, 否则返回假
Private Function GetRemotePAddress(ByVal sRemoteIP As String, sRemotePAddress As String) As Boolean

    Dim lRemoteIP As Long
    Dim lPAddr As Long
    Dim bPAddr() As Byte
    Dim PhyAddrLen As Long
    Dim i As Long
    Dim tmp As String

    '将IP地址转换成正确的地址
    lRemoteIP = inet_addr(sRemoteIP)

    If lRemoteIP <> 0 Then

        '设定 PhyAddrLen
        PhyAddrLen = 6

        'SendARP函数发送ARP请求获取指定IP地址相应的物理地址
        If SendARP(lRemoteIP, 0&, lPAddr, PhyAddrLen) = NO_ERROR Then

            If lPAddr <> 0 And PhyAddrLen <> 0 Then

                '将得到的值存入字节数组
                ReDim bPAddr(0 To PhyAddrLen - 1)
                CopyMemory bPAddr(0), lPAddr, ByVal PhyAddrLen

                '生成以单字节十六进制表示的物理地址字串
                For i = 0 To PhyAddrLen - 1

                    If bPAddr(i) = 0 Then

                        tmp = tmp & "00-"

                    Else

                        tmp = tmp & Hex$(bPAddr(i)) & "-"

                    End If

                Next

                If Len(tmp) > 0 Then

                    sRemotePAddress = Left$(tmp, Len(tmp) - 1)
                    GetRemotePAddress = True

                End If
                Exit Function

            Else

                GetRemotePAddress = False

            End If

        Else

            GetRemotePAddress = False

        End If

    Else

        GetRemotePAddress = False

    End If

End Function

 

 

3,不完善的微软高手写的例子

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

'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 Sub Command1_Click()

    Dim myNcb As NCB

    Dim bRet As Byte

    Dim myASTAT As ASTAT

    Dim pASTAT As Long

    '重置网卡。网卡在接受新的NCB命令之前必须重置。

    myNcb.ncb_command = NCBRESET

    bRet = Netbios(myNcb)

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

    myNcb.ncb_command = NCBASTAT

    myNcb.ncb_callname = "*               "

    myNcb.ncb_length = Len(myASTAT)

    Debug.Print Err.LastDllError

    'GetProcessHeap获取进程当前的默认堆,HeapAlloc返回从堆中分配的内存块的地址。

    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _

             Or HEAP_ZERO_MEMORY, myNcb.ncb_length)

    If pASTAT = 0 Then

        Debug.Print "memory allcoation failed!"

        Exit Sub

    End If

    'ncb_buffer字段的值是,要发送的数据缓冲区的地址,或者要在其中存放接收到的数据的缓冲区的地址。

    myNcb.ncb_buffer = pASTAT

    bRet = Netbios(myNcb)

    Debug.Print Err.LastDllError

    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)

    MsgBox Format$(Hex$(myASTAT.adapt.adapter_address(0)), "00") & " " & _

           Format$(Hex$(myASTAT.adapt.adapter_address(1)), "00") _

           & " " & Hex$(myASTAT.adapt.adapter_address(2)) & " " _

           & Format$(Hex$(myASTAT.adapt.adapter_address(3)), "00") _

           & " " & Format$(Hex$(myASTAT.adapt.adapter_address(4)), "00") & " " _

           & Format$(Hex$(myASTAT.adapt.adapter_address(5)), "00")

    '释放内存块的堆的句柄

    HeapFree GetProcessHeap(), 0, pASTAT

End Sub

4,IPCONFIG取MAC

Option Explicit

Private Sub Command1_Click()

    Call GetMacAddress

End Sub

Function GetMacAddress() As String

    Dim i&, j&, OutChar$

    Dim fn As Byte, pos1&, pos2&, ArrayChar$(1)

    '输出IP信息

    Shell "cmd  /c  ipconfig/all >  C:\Ping", vbHide

    fn = FreeFile

RETRY:

    Open "c:\ping" For Binary Access Read As #fn

   

    OutChar$ = Space$(FileLen("c:\ping"))

    '读取IP信息

    Get #fn, , OutChar$

    Close #fn

    If Len(OutChar$) = 0 Then GoTo RETRY

   

    '搜索Physical Address

    pos1 = InStr(OutChar$, "Physical Address")

    Do While pos1 <> 0

        

        '搜索:标志

        pos2 = InStr(pos1, OutChar$, ":")

        '取MAC Address, 长度18

        ArrayChar(j) = Mid$(OutChar$, pos2 + 1, 18)

        '判断是否有多个网卡

        pos1 = InStr(pos2, OutChar$, "Physical Address")

        If pos1 <> 0 Then j = j + 1

    Loop

    For i = 1 To j + 1

        MsgBox "第" & i & "个网卡的MAC ADDRESS 是" & ArrayChar(i - 1)

    Next

    Kill "C:\Ping"

End Function