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

马大哈

这个是我根据MSDN示例翻译的,系统要求为至少XP.

GetAdaptersAddresses是从ipconfig.exe的导入表里看到的,哈.

封装后,使用很简单,如下调用:

1. msgbox GetPhysicalAddress()(0)      '第一个网卡的MAC地址

复制代码

代码:

1. Option Explicit
   
2. '*************************************************************************
   
3. '**模 块 名：ModGetPhysicalAddress
   
4. '**说 明：取得本机所有网卡的MAC地址
   
5. '**创 建 人：嗷嗷叫的老马
   
6. '**日 期：2010年09月28日
   
7. '**备 注: 紫水晶工作室 版权所有
   
8. '** 更多模块/类模块请访问我站: http://www.m5home.com
   
9. '**版 本：V1.0
   
10. '*************************************************************************
    
11. 
    
12. Private Const HEAP_ZERO_MEMORY As Long = &H8&
    
13. Private Const ERROR_BUFFER_OVERFLOW As Long = &H6F&
    
14. Private Const GAA_FLAG_INCLUDE_PREFIX As Long = &H10&
    
15. Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = &H8&
    
16. Private Const MAX_ADAPTER_NAME_LENGTH As Long = &H100&
    
17. Private Const AF_UNSPEC As Long = &H0&
    
18. Private Const NO_ERROR As Long = &H0&
    
19. 
    
20. Private Enum IF_TYPE
    
21. IF_TYPE_OTHER = 1
    
22. IF_TYPE_ETHERNET_CSMACD = 6
    
23. IF_TYPE_ISO88025_TOKENRING = 9
    
24. IF_TYPE_PPP = 23
    
25. IF_TYPE_SOFTWARE_LOOPBACK = 24
    
26. IF_TYPE_ATM = 37
    
27. IF_TYPE_IEEE80211 = 71
    
28. IF_TYPE_TUNNEL = 131
    
29. IF_TYPE_IEEE1394 = 144
    
30. End Enum
    
31. 
    
32. Private Enum IF_OPER_STATUS
    
33. IfOperStatusUp = 1
    
34. IfOperStatusDown = 2
    
35. IfOperStatusTesting = 3
    
36. IfOperStatusUnknown = 4
    
37. IfOperStatusDormant = 5
    
38. IfOperStatusNotPresent = 6
    
39. IfOperStatusLowerLayerDown = 7
    
40. End Enum
    
41. 
    
42. Private Type IP_ADAPTER_ADDRESSES
    
43. Length As Long '原型里的联合体,直接拆开
    
44. IfIndex As Long
    
45. pNext As Long '指向下一个IP_ADAPTER_ADDRESSES结构的指针,类似单向链表了
    
46. AdapterName As Long 'PCHAR
    
47. FirstUnicastAddress As Long 'IP_ADAPTER_UNICAST_ADDRESS
    
48. FirstAnycastAddress As Long 'IP_ADAPTER_ANYCAST_ADDRESS
    
49. FirstMulticastAddress As Long 'IP_ADAPTER_MULTICAST_ADDRESS
    
50. FirstDnsServerAddress As Long 'IP_ADAPTER_DNS_SERVER_ADDRESS
    
51. lpDnsSuffix As Long 'PWCHAR
    
52. lpDescription As Long 'PWCHAR
    
53. lpFriendlyName As Long 'PWCHAR
    
54. PhysicalAddress(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
    
55. PhysicalAddressLength As Long
    
56. Flags As Long
    
57. MTU As Long
    
58. IfType As IF_TYPE
    
59. OperStatus As IF_OPER_STATUS
    
60. End Type
    
61. 
    
62. Private Declare Function GetAdaptersAddresses Lib "iphlpapi" ( _
    
63. ByVal Family As Long, _
    
64. ByVal Flags As Long, _
    
65. ByVal Reserved As Long, _
    
66. ByVal AdapterAddresses As Long, _
    
67. ByRef SizePointer As Long) As Long
    
68. 
    
69. Private Declare Function GetProcessHeap Lib "Kernel32" ( _
    
70. ) As Long
    
71. 
    
72. Private Declare Function HeapAlloc Lib "Kernel32" ( _
    
73. ByVal hHeap As Long, _
    
74. ByVal dwFlags As Long, _
    
75. ByVal dwBytes As Long) As Long
    
76. 
    
77. Private Declare Function HeapReAlloc Lib "Kernel32" ( _
    
78. ByVal hHeap As Long, _
    
79. ByVal dwFlags As Long, _
    
80. ByVal lpMem As Long, _
    
81. ByVal dwBytes As Long) As Long
    
82. 
    
83. Private Declare Function HeapFree Lib "Kernel32" ( _
    
84. ByVal hHeap As Long, _
    
85. ByVal dwFlags As Long, _
    
86. ByVal lpMem As Long) As Long
    
87. 
    
88. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    
89. ByVal Destination As Long, _
    
90. ByVal Source As Long, _
    
91. ByVal Length As Long)
    
92. 
    
93. Private Declare Function lstrlenW Lib "Kernel32" ( _
    
94. ByVal ptr As Long) As Long
    
95. 
    
96. Private Function GetStrFromPtr(ByVal ptr As Long) As String
    
97. '从指针得到字符串
    
98. Dim Buffer() As Byte
    
99. Dim lpSize As Long
    
100. 
     
101. lpSize = lstrlenW(ptr) * 2
     
102. If lpSize <> 0 Then
     
103. ReDim Buffer(lpSize)
     
104. CopyMemory VarPtr(Buffer(0)), ptr, lpSize
     
105. GetStrFromPtr = Buffer
     
106. End If
     
107. End Function
     
108. 
     
109. Private Function GetHex(ByRef inByte() As Byte) As String
     
110. '将字节数据以十六进制字符串输出
     
111. Dim I As Long, J() As String, K As Long
     
112. 
     
113. ReDim J(UBound(inByte))
     
114. 
     
115. For I = 0 To UBound(J)
     
116. J(I) = "00"
     
117. RSet J(I) = CStr(Hex(inByte(I)))
     
118. Next
     
119. 
     
120. GetHex = Replace(Join(J(), "-"), " ", "0")
     
121. End Function
     
122. 
     
123. Public Function GetPhysicalAddress() As String()
     
124. '取网卡MAC地址
     
125. '
     
126. '无输入参数.
     
127. '返回值:
     
128. ' 字符串数组,包含本机所有网络连接的MAC地址.
     
129. '备注:
     
130. ' 每个网络连接并不一定对应一个物理网卡,但仍然可以拥有MAC地址
     
131. Dim IPAA As IP_ADAPTER_ADDRESSES, pAdapterAddresses As Long
     
132. Dim outBufLen As Long, Flags As Long, Family As Long
     
133. Dim lRet As Long, dwIndex As Long, I As Long
     
134. Dim outBuff() As String
     
135. 
     
136. Flags = GAA_FLAG_INCLUDE_PREFIX
     
137. Family = AF_UNSPEC
     
138. outBufLen = 0
     
139. 
     
140. pAdapterAddresses = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, 32)
     
141. 
     
142. lRet = GetAdaptersAddresses(Family, Flags, 0, pAdapterAddresses, outBufLen) '第一次调用,如果缓冲区不够,会在outBufLen里返回所需要的缓冲区大小
     
143. '原示例中使用一次性分配大量空间的做法,觉得不太爽:)
     
144. 
     
145. If lRet = ERROR_BUFFER_OVERFLOW Then '如果返回溢出,则重分配足够的内存
     
146. pAdapterAddresses = HeapReAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, pAdapterAddresses, outBufLen)
     
147. End If
     
148. 
     
149. lRet = GetAdaptersAddresses(Family, Flags, 0, pAdapterAddresses, outBufLen) '这次是正式取了
     
150. 
     
151. If lRet = NO_ERROR Then
     
152. I = 0
     
153. ReDim outBuff(I)
     
154. 
     
155. Call CopyMemory(VarPtr(IPAA.Length), pAdapterAddresses, LenB(IPAA)) '复制第一个结构
     
156. outBuff(I) = GetHex(IPAA.PhysicalAddress())
     
157. 
     
158. Debug.Print GetStrFromPtr(IPAA.lpFriendlyName); IPAA.OperStatus; IPAA.IfType
     
159. Debug.Print outBuff(I)
     
160. Debug.Print
     
161. 
     
162. Do While IPAA.pNext <> 0
     
163. I = I + 1
     
164. ReDim Preserve outBuff(I)
     
165. 
     
166. Call CopyMemory(VarPtr(IPAA.Length), ByVal IPAA.pNext, Len(IPAA)) '复制下一个结构,pNext中保存的是指向下一个结构的指针
     
167. outBuff(I) = GetHex(IPAA.PhysicalAddress())
     
168. 
     
169. Debug.Print GetStrFromPtr(IPAA.lpFriendlyName); IPAA.OperStatus; IPAA.IfType
     
170. Debug.Print outBuff(I)
     
171. Debug.Print
     
172. Loop
     
173. End If
     
174. HeapFree GetProcessHeap, 0, pAdapterAddresses
     
175. GetPhysicalAddress = outBuff
     
176. End Function

复制代码

打包下载地址:

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