MAC地址获取全家福
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
