vb 获取本机MAC地址

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)

Public Function GetMACAddress() As String
    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
        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
        GetMACAddress = PhysicalAddress
        PhysicalAddress = ""
        pAdapt = AdapterInfo.Next
        '查找下一个网卡
        If pAdapt <> 0 Then
            CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
        End If
End Function