Question

VB获取电脑机器码

程序运行流程
运行程序----获取电脑机器码(唯一物理信息）-------复制获取的机器码到剪切板--------写入序列数据到xu.txt-----结束（整个运行过程没有界面显示）

重点获取电脑机器码：
最好是硬盘物理序列+CPU序列组合
总之目的就是为了不重复。之前使用过cpu序列，发现很多相同的。
可以掉用一些dll来实现。
或者有跟好的办法也可以。
获取的是物理硬件信息，不会受到重装系统和硬盘格式化 影响
源码打包发送到 achao07@qq.com 谢谢

Answer 1

很难达到你的要求的,VB好像是获取不到硬盘的物理序列号的,只能获取到某一个分区的序列号.不过可以调用其它的程序写的获取硬盘物理序列号的dll来获取,CPU的序列号我用的是wmi.VB本来对底层方面就不是很好

引用api获得硬盘序列号
Private Declare Function MymachineC Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Sub Form_Load()
Dim AA, 硬盘序列号, Maxlen, Sysflag As Long: Dim VolName, FsysName As String
AA = MymachineC("c:\", VolName, 256, 硬盘序列号, Maxlen, Sysflag, FsysName, 256)
msgbox "C硬盘序列号-机器码啦-(16制): " & Hex(硬盘序列号)
End Sub

Answer 2

Private Declare Function icePub_machineGetInfo Lib "icePubDll.dll" (ByVal typeFlag As Integer, ByVal strInfo As String) As Integer

Dim a2 As Integer
Dim str1 As String

str1 = Space(1024 * 10)

a2 = icePub_machineGetInfo(1, str1)
MsgBox "mac:" + str1
a2 = icePub_machineGetInfo(2, str1)
MsgBox "cpu:" + str1
a2 = icePub_machineGetInfo(3, str1)
MsgBox "hard:" + str1
a2 = icePub_machineGetInfo(4, str1)
MsgBox "memery:" + str1
a2 = icePub_machineGetInfo(5, str1)
MsgBox "boarddate:" + str1

download:
http://dl.icese.net/dev.php?f=icePubDll.rar

Answer 3

rivate Declare Function icePub_machineGetInfo Lib "icePubDll.dll" (ByVal typeFlag As Integer, ByVal strInfo As String) As Integer

Dim a2 As Integer
Dim str1 As String

str1 = Space(1024 * 10)

a2 = icePub_machineGetInfo(1, str1)
MsgBox "mac:" + str1
a2 = icePub_machineGetInfo(2, str1)
MsgBox "cpu:" + str1
a2 = icePub_machineGetInfo(3, str1)
MsgBox "hard:" + str1
a2 = icePub_machineGetInfo(4, str1)
MsgBox "memery:" + str1
a2 = icePub_machineGetInfo(5, str1)
MsgBox "boarddate:" + str1

Answer 4

a2 = icePub_machineGetInfo(4, str1)

Answer 5

Private Declare Function GetVolumeInformation _
Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal lpszVolumeNameBuffer As String, _
ByVal lVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpszFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0
Dim CPUstr As String
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Public Function GetVolumeSerialNumber(ByVal RootPath As String) As String
Dim lpszVolumeNameBuffer As String
Dim lpszFileSystemNameBuffer As String
Dim lVolumeNameSize As Long
Dim lpVolumeSerialNumber As Long
Dim lpMaximumComponentLength As Long
Dim lpFileSystemFlags As Long
Dim nFileSystemNameSize As Long
Dim lRetVal As Long
lpVolumeSerialNumber = 0
lpMaximumComponentLength = 0
lpFileSystemFlags = 0
lpszVolumeNameBuffer = Space$(255)
lpszFileSystemNameBuffer = Space(255)
lVolumeNameSize = Len(lpszVolumeNameBuffer)
nFileSystemNameSize = Len(lpszFileSystemNameBuffer)
lRetVal = GetVolumeInformation(RootPath, _
lpszVolumeNameBuffer, _
lVolumeNameSize, _
lpVolumeSerialNumber, _
lpMaximumComponentLength, _
lpFileSystemFlags, _
lpszFileSystemNameBuffer, _
nFileSystemNameSize)

GetVolumeSerialNumber = Hex$(lpVolumeSerialNumber)

End Function

Private Function GetProcessorID() As String
Dim a As SWbemServices
Dim b As SWbemObjectSet
Dim c As SWbemObject
Dim d As SWbemPropertySet
Dim e As SWbemProperty
Dim f As String
Set a = GetObject("winmgmts:")
Set b = a.InstancesOf("Win32_Processor")
For Each c In b
With c
If .Properties_.Count > 0 Then
Set d = .Properties_

For Each e In d
f = f & e.Name & ": " & e.Value & vbCrLf
Next
End If
End With
Next
GetProcessorID = f
End Function

Private Sub Form_Load()
Dim sRetVal As String, sCpu As String
sRetVal = GetVolumeSerialNumber("C:\")
sCpu = GetProcessorID

Clipboard.Clear
Clipboard.SetText sRetVal & vbCrLf & sCpu

Open "D:\xu.txt" For Output As #1
Print #1, Clipboard.GetText
Close #1
End
End Sub