【分享】马大哈系列功能模块----取本机所有网卡MAC地址(VB6代码)

马大哈 · 发表于 2011-1-5 18:41:21

下午在群里有人问到这个问题,说是网上流传的那个代码(类似这个: 取本机网卡MAC地址)无法在多网卡情况下正常工作.

于是试了一下,果然如此.而系统的ipconfig.exe却能正确取得每个网卡(网络连接)的物理地址.

马上查看了一下ipconfig.exe都调用了些什么API,发现了一个GetAdaptersAddresses(仅支持XP及以上)函数....

然后在网上一翻,居然没有VB6调用的例子,只有一个MSDN里C语言的示例,汗

没办法,翻译吧....

原MSDN内容如下:

http://msdn.microsoft.com/en-us/library/aa365915(VS.85).aspx

折腾了一会儿,封装得比较简单,调用只需要:

msgbox GetPhysicalAddress()(0) '第一个网卡的MAC地址函数会把所有网络连接的MAC地址放到数组里返回.

复制代码

以后就方便了

不过要注意的是,这个API只支持XP及以上系统.所以2000啥的就免了吧

在XP以下肯定也有办法,不过现在就不搞了 ,毕竟现在少有人还用2000吧.....

具体代码如下:

Option Explicit
'*************************************************************************
'**模块名：ModGetPhysicalAddress
'**说明：取得本机所有网卡的MAC地址
'**创建人：嗷嗷叫的老马
'**日期：2010年09月28日
'**备注: 紫水晶工作室版权所有
'** 更多模块/类模块请访问我站: http://www.m5home.com
'**版本：V1.0
'*************************************************************************
Private Const HEAP_ZERO_MEMORY As Long = &H8&
Private Const ERROR_BUFFER_OVERFLOW As Long = &H6F&
Private Const GAA_FLAG_INCLUDE_PREFIX As Long = &H10&
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = &H8&
Private Const MAX_ADAPTER_NAME_LENGTH As Long = &H100&
Private Const AF_UNSPEC As Long = &H0&
Private Const NO_ERROR As Long = &H0&
Private Enum IF_TYPE
IF_TYPE_OTHER = 1
IF_TYPE_ETHERNET_CSMACD = 6
IF_TYPE_ISO88025_TOKENRING = 9
IF_TYPE_PPP = 23
IF_TYPE_SOFTWARE_LOOPBACK = 24
IF_TYPE_ATM = 37
IF_TYPE_IEEE80211 = 71
IF_TYPE_TUNNEL = 131
IF_TYPE_IEEE1394 = 144
End Enum
Private Enum IF_OPER_STATUS
IfOperStatusUp = 1
IfOperStatusDown = 2
IfOperStatusTesting = 3
IfOperStatusUnknown = 4
IfOperStatusDormant = 5
IfOperStatusNotPresent = 6
IfOperStatusLowerLayerDown = 7
End Enum
Private Type IP_ADAPTER_ADDRESSES
Length As Long '原型里的联合体,直接拆开
IfIndex As Long
pNext As Long '指向下一个IP_ADAPTER_ADDRESSES结构的指针,类似单向链表了
AdapterName As Long 'PCHAR
FirstUnicastAddress As Long 'IP_ADAPTER_UNICAST_ADDRESS
FirstAnycastAddress As Long 'IP_ADAPTER_ANYCAST_ADDRESS
FirstMulticastAddress As Long 'IP_ADAPTER_MULTICAST_ADDRESS
FirstDnsServerAddress As Long 'IP_ADAPTER_DNS_SERVER_ADDRESS
lpDnsSuffix As Long 'PWCHAR
lpDescription As Long 'PWCHAR
lpFriendlyName As Long 'PWCHAR
PhysicalAddress(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
PhysicalAddressLength As Long
Flags As Long
MTU As Long
IfType As IF_TYPE
OperStatus As IF_OPER_STATUS
End Type
Private Declare Function GetAdaptersAddresses Lib "iphlpapi" ( _
ByVal Family As Long, _
ByVal Flags As Long, _
ByVal Reserved As Long, _
ByVal AdapterAddresses As Long, _
ByRef SizePointer As Long) 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 HeapReAlloc Lib "Kernel32" ( _
ByVal hHeap As Long, _
ByVal dwFlags As Long, _
ByVal lpMem As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "Kernel32" ( _
ByVal hHeap As Long, _
ByVal dwFlags As Long, _
ByVal lpMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByVal Destination As Long, _
ByVal Source As Long, _
ByVal Length As Long)
Private Declare Function lstrlenW Lib "Kernel32" ( _
ByVal ptr As Long) As Long
Private Function GetStrFromPtr(ByVal ptr As Long) As String
'从指针得到字符串
Dim Buffer() As Byte
Dim lpSize As Long
lpSize = lstrlenW(ptr) * 2
If lpSize <> 0 Then
ReDim Buffer(lpSize)
CopyMemory VarPtr(Buffer(0)), ptr, lpSize
GetStrFromPtr = Buffer
End If
End Function
Private Function GetHex(ByRef inByte() As Byte) As String
'将字节数据以十六进制字符串输出
Dim I As Long, J() As String, K As Long
ReDim J(UBound(inByte))
For I = 0 To UBound(J)
J(I) = "00"
RSet J(I) = CStr(Hex(inByte(I)))
Next
GetHex = Replace(Join(J(), "-"), " ", "0")
End Function
Public Function GetPhysicalAddress() As String()
'取网卡MAC地址
'
'无输入参数.
'返回值:
' 字符串数组,包含本机所有网络连接的MAC地址.
'备注:
' 每个网络连接并不一定对应一个物理网卡,但仍然可以拥有MAC地址
Dim IPAA As IP_ADAPTER_ADDRESSES, pAdapterAddresses As Long
Dim outBufLen As Long, Flags As Long, Family As Long
Dim lRet As Long, dwIndex As Long, I As Long
Dim outBuff() As String
Flags = GAA_FLAG_INCLUDE_PREFIX
Family = AF_UNSPEC
outBufLen = 0
pAdapterAddresses = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, 32)
lRet = GetAdaptersAddresses(Family, Flags, 0, pAdapterAddresses, outBufLen) '第一次调用,如果缓冲区不够,会在outBufLen里返回所需要的缓冲区大小
'原示例中使用一次性分配大量空间的做法,觉得不太爽:)
If lRet = ERROR_BUFFER_OVERFLOW Then '如果返回溢出,则重分配足够的内存
pAdapterAddresses = HeapReAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, pAdapterAddresses, outBufLen)
End If
lRet = GetAdaptersAddresses(Family, Flags, 0, pAdapterAddresses, outBufLen) '这次是正式取了
If lRet = NO_ERROR Then
I = 0
ReDim outBuff(I)
Call CopyMemory(VarPtr(IPAA.Length), pAdapterAddresses, LenB(IPAA)) '复制第一个结构
outBuff(I) = GetHex(IPAA.PhysicalAddress())
Debug.Print GetStrFromPtr(IPAA.lpFriendlyName); IPAA.OperStatus; IPAA.IfType
Debug.Print outBuff(I)
Debug.Print
Do While IPAA.pNext <> 0
I = I + 1
ReDim Preserve outBuff(I)
Call CopyMemory(VarPtr(IPAA.Length), ByVal IPAA.pNext, Len(IPAA)) '复制下一个结构,pNext中保存的是指向下一个结构的指针
outBuff(I) = GetHex(IPAA.PhysicalAddress())
Debug.Print GetStrFromPtr(IPAA.lpFriendlyName); IPAA.OperStatus; IPAA.IfType
Debug.Print outBuff(I)
Debug.Print
Loop
End If
HeapFree GetProcessHeap, 0, pAdapterAddresses
GetPhysicalAddress = outBuff
End Function

复制代码

为了方便,打个包上传吧:

http://www.m5home.com/blog/article.asp?id=510

yxcsky · 发表于 2011-3-17 22:19:30

好东东。。。顶。。不顶都不行。。

upring · 发表于 2015-9-6 10:18:05

谢谢马总支持一下

账号		自动登录	找回密码
密码			加入我们

【分享】马大哈系列功能模块----取本机所有网卡MAC地址(VB6代码)

论坛牛人

贡献奖

关注奖

最佳版主

进步奖

人气王

疯狂作品奖

精英奖

赞助论坛勋章

乐于助人勋章