抓取網卡序號(PhysicalAddress)

本程式只能抓取第一張網卡序號。
可以用來確認電腦身份。
以下程式碼要貼到模組上，使用時呼叫GetPhysicalAddress即可，傳回值為String。

複製程式碼(Copy to clipboard)

'此程式碼放置於模組內
Option Explicit

Public Const MAX_HOSTNAME_LEN = 132
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
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
            Type 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 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 GetPhysicalAddress() As String
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress  As String
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim Buffer2 As IP_ADAPTER_INFO

    On Error GoTo ErrMsg

    GetAdaptersInfo ByVal 0&, AdapterInfoSize

    ReDim AdapterInfoBuffer(AdapterInfoSize - 1)

    GetAdaptersInfo AdapterInfoBuffer(0), AdapterInfoSize

    CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)

    CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
   
    For i = 0 To Buffer2.AddressLength - 1
        PhysicalAddress = PhysicalAddress & Right("0" & Hex(Buffer2.Address(i)), 2)
        If i < Buffer2.AddressLength - 1 Then
            PhysicalAddress = PhysicalAddress & "-"
        End If
    Next
    GetPhysicalAddress = PhysicalAddress
    Exit Function
ErrMsg:
    GetPhysicalAddress = "Error"
End Function