创建一个模块，优点在于，如果插入移动硬盘什么的。也不会导致机器码的变化。
Imports System.Management
Imports System.Security.Cryptography
Imports System.Text
Module 机器码
Public 全局变量_机器码 As String = GetUniqueId16()
Private Function GetCpuId() As String
Return GetWMIProperty("SELECT ProcessorId FROM Win32_Processor", "ProcessorId")
End Function
' 获取 BIOS 序列号
Private Function GetBiosId() As String
Return GetWMIProperty("SELECT SerialNumber FROM Win32_BIOS", "SerialNumber")
End Function
' 获取主板序列号
Private Function GetBoardId() As String
Return GetWMIProperty("SELECT SerialNumber FROM Win32_BaseBoard", "SerialNumber")
End Function
' 获取物理硬盘序列号
Private Function GetDiskSerial() As String
Return GetSystemDiskSerial()
End Function
' 通用函数：安全获取 WMI 属性
Private Function GetWMIProperty(query As String, prop As String) As String
Try
Dim searcher As New ManagementObjectSearcher(query)
For Each obj As ManagementObject In searcher.Get()
Dim val = obj(prop)
If val IsNot Nothing AndAlso Not String.IsNullOrWhiteSpace(val.ToString()) Then
Dim s = val.ToString().Trim()
If Not s.ToLower().Contains("default") AndAlso
Not s.ToLower().Contains("to be filled") Then
Return s
End If
End If
Next
Catch
End Try
Return ""
End Function
Public Function GetUniqueId16() As String
Dim cpu = GetCpuId()
Dim bios = GetBiosId()
Dim board = GetBoardId()
Dim disk = GetSystemDiskSerial() ' ← 用系统盘对应物理盘序列号
Dim raw = cpu & "-" & bios & "-" & board & "-" & disk
Dim md5 = System.Security.Cryptography.MD5.Create().ComputeHash(Encoding.UTF8.GetBytes(raw))
Dim full = BitConverter.ToString(md5).Replace("-", "").ToLower()
Return full.Substring(8, 16) '取中间16位
End Function
' 取系统盘盘符（通常是 C:），来自 Win32_OperatingSystem.SystemDrive
Private Function GetSystemDriveLetter() As String
Try
Using searcher As New ManagementObjectSearcher("SELECT SystemDrive FROM Win32_OperatingSystem")
For Each os As ManagementObject In searcher.Get()
Dim sd = TryCast(os("SystemDrive"), String)
If Not String.IsNullOrWhiteSpace(sd) Then
Return sd.Trim()
End If
Next
End Using
Catch
End Try
Return "C:" ' 兜底
End Function
' 从字符串中过滤掉无效/占位的序列号
Private Function CleanSerial(s As String) As String
If String.IsNullOrWhiteSpace(s) Then Return ""
Dim t = s.Trim()
Dim tl = t.ToLowerInvariant()
If tl.Contains("default") OrElse tl.Contains("to be filled") OrElse tl = "none" Then Return ""
Return t
End Function
' 通过“系统逻辑盘 -> 分区 -> 物理磁盘”的关联，精确锁定系统盘所在物理磁盘并取序列号
Private Function GetSystemDiskSerial() As String
Dim sysDrive As String = GetSystemDriveLetter() ' 例如 "C:"
Try
' 1) 逻辑盘 (C:)
Dim q1 As String = $"ASSOCIATORS OF {{Win32_LogicalDisk.DeviceID='{sysDrive}'}} WHERE AssocClass = Win32_LogicalDiskToPartition"
Using partSearcher As New ManagementObjectSearcher(q1)
For Each part As ManagementObject In partSearcher.Get()
' 2) 分区 -> 物理磁盘
Dim partId As String = TryCast(part("DeviceID"), String) ' 形如 "Disk #0, Partition #1"
If String.IsNullOrWhiteSpace(partId) Then Continue For
Dim q2 As String = $"ASSOCIATORS OF {{Win32_DiskPartition.DeviceID='{partId}'}} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
Using diskSearcher As New ManagementObjectSearcher(q2)
For Each disk As ManagementObject In diskSearcher.Get()
' 物理磁盘，如 \\.\PHYSICALDRIVE0
Dim iface = TryCast(disk("InterfaceType"), String) ' SATA/NVMe/USB...
' 系统盘通常不会是 USB，但为了稳妥，若是 USB 则跳过
If Not String.IsNullOrEmpty(iface) AndAlso iface.Trim().ToUpperInvariant() = "USB" Then Continue For
' 优先取 Win32_DiskDrive.SerialNumber
Dim serial As String = CleanSerial(TryCast(disk("SerialNumber"), String))
If serial <> "" Then Return serial
' 取不到再从 Win32_PhysicalMedia 按 Tag 映射（Tag 通常等于 \\.\PHYSICALDRIVE#）
Dim devId As String = TryCast(disk("DeviceID"), String)
If Not String.IsNullOrWhiteSpace(devId) Then
Try
Dim q3 As String = $"SELECT SerialNumber, Tag FROM Win32_PhysicalMedia WHERE Tag='{devId.Replace("\", "\\")}'"
Using pmSearcher As New ManagementObjectSearcher(q3)
For Each pm As ManagementObject In pmSearcher.Get()
Dim s2 As String = CleanSerial(TryCast(pm("SerialNumber"), String))
If s2 <> "" Then Return s2
Next
End Using
Catch
End Try
End If
Next
End Using
Next
End Using
Catch
End Try
' 如果上面都失败，最后兜底：取系统卷的 VolumeSerialNumber（会随格式化变）
Try
Dim qVol As String = $"SELECT VolumeSerialNumber FROM Win32_LogicalDisk WHERE DeviceID='{sysDrive}'"
Using volSearcher As New ManagementObjectSearcher(qVol)
For Each d As ManagementObject In volSearcher.Get()
Dim volSn As String = CleanSerial(TryCast(d("VolumeSerialNumber"), String))
If volSn <> "" Then Return volSn
Next
End Using
Catch
End Try
Return ""
End Function
Function MD5Hash(input As String) As String
Using md5 As MD5 = MD5.Create()
Dim inputBytes As Byte() = Encoding.UTF8.GetBytes(input)
Dim hashBytes As Byte() = md5.ComputeHash(inputBytes)
Dim sb As New StringBuilder()
For Each b As Byte In hashBytes
sb.Append(b.ToString("x2"))
Next
Return sb.ToString()
End Using
End Function
Function UnixTimeStampToDateTime(unixTimeStamp As Long) As DateTime
Dim dateTime As DateTime = New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
Return dateTime.AddSeconds(unixTimeStamp).ToLocalTime()
End Function
End Module
