【分享】马大哈系列功能模块----取本机所有网卡MAC地址(VB6代码)
下午在群里有人问到这个问题,说是网上流传的那个代码(类似这个:取本机网卡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_MEMORYAs 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 好东东。。。顶。。不顶都不行。。:lol 谢谢马总 支持一下
页:
[1]