你可以在软件中想办法保存第一次运行时得到的 CPU 或者硬盘序列号，例如把它加到 EXE 文件的末尾去，等下次运行时检测序列号与保存的是否对应，不对应就没用这样可以防止D版
有的，我这儿有个朋友给我的程序，在win2K，赛扬1.7G下测试通过。 我希望你也帮我测试一下，别人给我时只是写在form1里的一段程序，我把它小小地改成了函数以方便使用。 希望你能帮在不同的CPU，不同的系统下试试，如果好用，别忘了说一声！ 请新建一个模块把以下代码放在模块中(模块名可用“CPUInfo”)，然后可以在你的程序的任何窗中引用函数CPUInof_ME()。 程序代码如下： '得到CPU序列号。********函数引用方法：AA = CPUInof_ME() (其中AA应为String类型)******** 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 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 TypePublic Function CPUInfo_ME() As String Dim len5 As Long, aa As Long Dim cmprName As String Dim osver As OSVERSIONINFO '取得Computer Name cmprName = String(255, 0) len5 = 256 aa = GetComputerName(cmprName, len5) cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1) computer = cmprName '取得CPU端口号 Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2").ExecQuery("select * from Win32_Processor") For Each mycpu In CPUs CPUInfo_ME = mycpu.ProcessorId Next End Function至于加密，只是一个算法问题，呵，就不用我教啦……
GetComputerName 得到的不是CPU序列号． 看 MSDN 的注解：GetComputerName The GetComputerName function retrieves the NetBIOS name of the local computer. This name is established at system startup, when the system reads it from the registry. If the local computer is a node in a cluster, GetComputerName returns the name of the node. Windows 2000: GetComputerName retrieves only the NetBIOS name of the local computer. To retrieve the DNS host name, DNS domain name, or the fully qualified DNS name, call the GetComputerNameEx function.Windows 2000: Additional information is provided by the IADsADSystemInfo interface. ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ GetObject Function
Returns a reference to an object provided by an ActiveX component.我这里用 VC 得到的 CPU 序列号为 0-F12-7A-7040-0-0 用楼上的代码得到的是 3FEBFBFF00000F12怎么看都不像是序列号暂时还没有看懂是什么东西
没找到cpu的，找到了网卡和硬盘的，下面的是获得硬盘号码的 、How can I retrieve a disks serial number? Whenever a disk is formatted, the operating system writes a serial number onto it. This number is not guaranteed to be unique, but as it is a 32 bit integer it is unlikely to find a duplicate! The number is often used as part of a copy protection system. This tip shows you how to retrieve the number.Declarations Copy this code into the declarations section of the project.Private Declare Function GetVolumeInformation Lib _ "kernel32.dll" Alias "GetVolumeInformationA" (ByVal _ lpRootPathName As String, ByVal lpVolumeNameBuffer As _ String, ByVal nVolumeNameSize As Integer, _ lpVolumeSerialNumber As Long, lpMaximumComponentLength _ As Long, lpFileSystemFlags As Long, ByVal _ lpFileSystemNameBuffer As String, ByVal _ nFileSystemNameSize As Long) As Long Code Function GetSerialNumber(strDrive As String) As Long Dim SerialNum As Long Dim Res As Long Dim Temp1 As String Dim Temp2 As String Temp1 = String$(255, Chr$(0)) Temp2 = String$(255, Chr$(0)) Res = GetVolumeInformation(strDrive, Temp1, _ Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2)) GetSerialNumber = SerialNum End Function Use An example of using the above function:Call MsgBox GetSerialNumber("C:\") This will bring up a message box with the serial number of the C drive.
'取得CPU序列号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 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 Private Sub Command1_Click() Dim len5 As Long, aa As Long Dim cmprName As String Dim osver As OSVERSIONINFO '取得Computer Name cmprName = String(255, 0) len5 = 256 aa = GetComputerName(cmprName, len5) cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1) Computer = cmprName '取得CPU端口号 Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_Processor") For Each mycpu In CPUs Text1.Text = mycpu.ProcessorId Next End Sub
在好几个有关 CPU ID 的帖子里都发现了 superdullwolf(超级大笨狼) 贴的这段代码我搞不懂为什么就没有人相信我的话？这段代码根本就不是取 CPU 的ID 绝对是要靠汇编才能得到 CPU 的ID GetComputerName得到的是电脑的NetBIOS name ,真搞不懂为什么会有人把它和 CPU ID 联系起来
硬盘物理序号的得到。 把它作为一个模块，可以直接运行，不用form。 具体的运用方法，自个分析了，呵，这是别人的程序，我原来分析出来过，但是后来自个分析出的东东掉了：）。有了这东西稍懂一些的朋友就能从里面把对自个有用的东西提出来的。 Option Explicit Option Base 0 Private Const DFP_GET_VERSION = &H74080 Private Const DFP_SEND_DRIVE_COMMAND = &H7C084 Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088 Private Type TGETVERSIONOUTPARAMS '{ bVersion As Byte 'Binary driver version. bRevision As Byte 'Binary driver revision. bReserved As Byte 'Not used. bIDEDeviceMap As Byte 'Bit map of IDE devices. fCapabilities As Long 'Bit mask of driver capabilities. dwReserved(4) As Long 'For future use. End TypePrivate Type TIDEREGS bFeaturesReg As Byte 'Used for specifying SMART "commands". bSectorCountReg As Byte 'IDE sector count register bSectorNumberReg As Byte 'IDE sector number register bCylLowReg As Byte 'IDE low order cylinder value bCylHighReg As Byte 'IDE high order cylinder value bDriveHeadReg As Byte 'IDE drive/head register bCommandReg As Byte 'Actual IDE command. bReserved As Byte 'reserved for future use. Must be zero. End TypePrivate Type TSENDCMDINPARAMS cBufferSize As Long 'Buffer size in bytes irDriveRegs As TIDEREGS 'Structure with drive register values. bDriveNumber As Byte 'Physical drive number to send 'command to (0,1,2,3). bReserved(2) As Byte 'Reserved for future expansion. dwReserved(3) As Long 'For future use. ''BYTE bBuffer(1) 'Input buffer. End TypePrivate Type TDRIVERSTATUS bDriverError As Byte 'Error code from driver, 'or 0 if no error. bIDEStatus As Byte 'Contents of IDE Error register. 'Only valid when bDriverError 'is SMART_IDE_ERROR. bReserved(1) As Byte 'Reserved for future expansion. dwReserved(1) As Long 'Reserved for future expansion. End TypePrivate Type TSENDCMDOUTPARAMS cBufferSize As Long 'Size of bBuffer in bytes DRIVERSTATUS As TDRIVERSTATUS 'Driver status structure. bBuffer(511) As Byte 'Buffer of arbitrary length 'in which to store the data read from the drive. End TypePrivate Type TIDSECTOR wGenConfig As Integer wNumCyls As Integer wReserved As Integer wNumHeads As Integer wBytesPerTrack As Integer wBytesPerSector As Integer wSectorsPerTrack As Integer wVendorUnique(2) As Integer sSerialNumber(19) As Byte wBufferType As Integer wBufferSize As Integer wECCSize As Integer sFirmwareRev(7) As Byte sModelNumber(39) As Byte wMoreVendorUnique As Integer wDoubleWordIO As Integer wCapabilities As Integer wReserved1 As Integer wPIOTiming As Integer wDMATiming As Integer wBS As Integer wNumCurrentCyls As Integer wNumCurrentHeads As Integer wNumCurrentSectorsPerTrack As Integer ulCurrentSectorCapacity(3) As Byte wMultSectorStuff As Integer ulTotalAddressableSectors(3) As Byte wSingleWordDMA As Integer wMultiWordDMA As Integer bReserved(127) As Byte End Type
Private vers As TGETVERSIONOUTPARAMS Private in_data As TSENDCMDINPARAMS Private out_data As TSENDCMDOUTPARAMS Private h As Long Private i As Long Private j As BytePrivate Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End TypePrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _ (LpVersionInformation As OSVERSIONINFO) As LongPrivate Const VER_PLATFORM_WIN32S = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _ As LongPrivate Const CREATE_NEW = 1 Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End TypePrivate Declare Function DeviceIoControl Lib "kernel32" _ (ByVal hDevice As Long, ByVal dwIoControlCode As Long, _ lpInBuffer As Any, ByVal nInBufferSize As Long, _ lpOutBuffer As Any, ByVal nOutBufferSize As Long, _ lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Sub CopyRight()Dim StrMsg As String StrMsg = StrMsg & "直接从RING3调用API DeviceIoControl()来获取硬盘信息的VB程序 " StrMsg = StrMsg & vbCrLf & "板权信息如下：" StrMsg = StrMsg & vbCrLf & "***********************************************************" StrMsg = StrMsg & vbCrLf & "硬盘物理序号测试 v1.0 for WIN95/98/Me/NT/2000. 抄袭 by 哎呀……" StrMsg = StrMsg & vbCrLf & "想知道更多的信息？不告诉你，呵。" StrMsg = StrMsg & vbCrLf & "2003.05.03" StrMsg = StrMsg & vbCrLf & "***********************************************************" StrMsg = StrMsg & vbCrLf & "VB程序抄袭：哎呀……" StrMsg = StrMsg & vbCrLf & "网站：没有" StrMsg = StrMsg & vbCrLf & "邮件：忘了" StrMsg = StrMsg & vbCrLf & "2003.05.03" MsgBox StrMsg End SubSub ChangeByteOrder(szString() As Byte, uscStrSize As Long) Dim i As Long Dim temp As String For i = 0 To uscStrSize - 1 Step 2 temp = szString(i) szString(i) = szString(i + 1) szString(i + 1) = temp Next i End SubPrivate Function hdid9x() As String 'We start in 95/98/Me h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0) If h = 0 Then hdid9x = "open smartvsd.vxd failed" Exit Function End If
Dim olp As OVERLAPPED Dim lRet As Long lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olp) If lRet = 0 Then hdid9x = "DeviceIoControl failed:DFP_GET_VERSION" CloseHandle (h) Exit Function End If
'If IDE identify command not supported, fails If (vers.fCapabilities And 1) <> 1 Then hdid9x = "Error: IDE identify command not supported." CloseHandle (h) Exit Function End If
'Display IDE drive number detected Dim sPreOutStr As String sPreOutStr = DetectIDE(vers.bIDEDeviceMap) hdid9x = sPreOutStr
'Identify the IDE drives For j = 0 To 3 Dim phdinfo As TIDSECTOR Dim s(40) As Byte
If (j And 1) = 1 Then in_data.irDriveRegs.bDriveHeadReg = &HB0 Else in_data.irDriveRegs.bDriveHeadReg = &HA0 End If If (vers.fCapabilities And (16 \ (2 ^ j))) = (16 \ (2 ^ j)) Then 'We don't detect a ATAPI device. hdid9x = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it" Else in_data.irDriveRegs.bCommandReg = &HEC in_data.bDriveNumber = j in_data.irDriveRegs.bSectorCountReg = 1 in_data.irDriveRegs.bSectorNumberReg = 1 in_data.cBufferSize = 512
s(5) = 0 Dim dblStrOut As Double dblStrOut = ByteArrToLong(s) hdid9x = hdid9x & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M" End If Next j 'Close handle before quit CloseHandle (h) CopyRightEnd FunctionPrivate Function hdidnt() As String Dim hd As String * 80 Dim phdinfo As TIDSECTOR Dim s(40) As Byte Dim StrOut As String
hdidnt = "" 'We start in NT/Win2000
For j = 0 To 3 '这里取四个硬盘的信息，因为正常PC不超过四个硬盘 hd = "\\.\PhysicalDrive" & CStr(j) hdidnt = hdidnt & vbCrLf & hd h = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
Dim olpv As OVERLAPPED
Dim lRet As Long lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olpv)
If lRet = 0 Then CloseHandle (h) Else 'If IDE identify command not supported, fails If (vers.fCapabilities And 1) <> 1 Then hdidnt = "Error: IDE identify command not supported." CloseHandle (h) Exit Function End If 'Identify the IDE drives If (j And 1) = 1 Then in_data.irDriveRegs.bDriveHeadReg = &HB0 Else in_data.irDriveRegs.bDriveHeadReg = &HA0 End If If (vers.fCapabilities And (16 \ (2 ^ j))) <> 0 Then 'We don't detect a ATAPI device. hdidnt = hdidnt & vbCrLf & "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it" Else
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4 s(5) = 0 Dim dblStrOut As Double dblStrOut = ByteArrToLong(s)
hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M" CloseHandle (h) End If End If End If Next j CopyRight End Function
Sub Main() Dim verinfo As OSVERSIONINFO Dim Ret As Long verinfo.dwOSVersionInfoSize = Len(verinfo) Ret = GetVersionEx(verinfo) Dim OutStr As String Select Case verinfo.dwPlatformId Case VER_PLATFORM_WIN32S MsgBox "Win32s is not supported by this programm." End Case VER_PLATFORM_WIN32_WINDOWS OutStr = hdid9x MsgBox OutStr End Case VER_PLATFORM_WIN32_NT OutStr = hdidnt MsgBox OutStr End End SelectEnd Sub Private Function DetectIDE(bIDEDeviceMap As Byte) As String If (bIDEDeviceMap And 1) Then If (bIDEDeviceMap And 16) Then DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 0." Else DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 0." End If End If If (bIDEDeviceMap And 2) Then If (bIDEDeviceMap And 32) Then DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 1." Else DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 1." End If End If If (bIDEDeviceMap And 4) Then If (bIDEDeviceMap And 64) Then DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 0." Else DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 0." End If End If If (bIDEDeviceMap And 8) Then If (bIDEDeviceMap And 128) Then DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 1." Else DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 1." End If End If End Function Private Function ByteArrToString(inByte() As Byte, ByVal strlen As Integer) As String Dim i As Integer For i = 0 To strlen If inByte(i) = 0 Then Exit For End If ByteArrToString = ByteArrToString & Chr(inByte(i)) Next i End FunctionPrivate Function ByteArrToLong(inByte() As Byte) As Double Dim i As Integer For i = 0 To 3 ByteArrToLong = ByteArrToLong + CDbl(inByte(i)) * (256 ^ i) Next i
End Function
注意，对老一些的硬盘，对SISC硬盘无效。
Windows 想了那么多种方法不还是给咱们破了天天在用？Photoshop 一份不比你的软件便宜吧，有多少人不是拿了盗版一样用？没见人人都 Ghost 嘛。所以，不要浪费心思在防盗版上，意思意思就行了。再说，防不胜防。
我希望你也帮我测试一下，别人给我时只是写在form1里的一段程序，我把它小小地改成了函数以方便使用。
希望你能帮在不同的CPU，不同的系统下试试，如果好用，别忘了说一声！
请新建一个模块把以下代码放在模块中(模块名可用“CPUInfo”)，然后可以在你的程序的任何窗中引用函数CPUInof_ME()。
程序代码如下：
'得到CPU序列号。********函数引用方法：AA = CPUInof_ME() (其中AA应为String类型)********
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
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 TypePublic Function CPUInfo_ME() As String
Dim len5 As Long, aa As Long
Dim cmprName As String
Dim osver As OSVERSIONINFO
'取得Computer Name
cmprName = String(255, 0)
len5 = 256
aa = GetComputerName(cmprName, len5)
cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1)
computer = cmprName '取得CPU端口号
Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2").ExecQuery("select * from Win32_Processor")
For Each mycpu In CPUs
CPUInfo_ME = mycpu.ProcessorId
Next
End Function至于加密，只是一个算法问题，呵，就不用我教啦……
很多硬盘是有出厂序号的(近几年的IDE硬盘基本都有），并不因格式化等改变，是物理的硬序号，也可以用来对程序加密。
但是也有一部分是没有的，特别是SISC硬盘，我还不知怎么去得到它的物理序号。
看 MSDN 的注解：GetComputerName
The GetComputerName function retrieves the NetBIOS name of the local computer. This name is established at system startup, when the system reads it from the registry. If the local computer is a node in a cluster, GetComputerName returns the name of the node. Windows 2000: GetComputerName retrieves only the NetBIOS name of the local computer. To retrieve the DNS host name, DNS domain name, or the fully qualified DNS name, call the GetComputerNameEx function.Windows 2000: Additional information is provided by the IADsADSystemInfo interface. ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
GetObject Function
Returns a reference to an object provided by an ActiveX component.我这里用 VC 得到的 CPU 序列号为 0-F12-7A-7040-0-0
用楼上的代码得到的是 3FEBFBFF00000F12怎么看都不像是序列号暂时还没有看懂是什么东西
说过了请大家帮我测试一下看啊：）。
GetComputerName得到的是电脑的NetBIOS name，也就是你的电脑的在网络上名称，这点我看懂了。
也许通过这个来得到CPU序号的，是不是别问我，我真的也不怎么懂的。
有条件的朋友把CPU下下来，和程序一起放别的电脑上试试吧。
还有，然也，你家伙再帮我一把啊！我这回要的是删，不是加……
、How can I retrieve a disks serial number?
Whenever a disk is formatted,
the operating system writes a serial
number onto it. This number is not
guaranteed to be unique, but as it is
a 32 bit integer it is unlikely to find
a duplicate! The number is often used
as part of a copy protection system.
This tip shows you how to retrieve the number.Declarations
Copy this code into the declarations section of the project.Private Declare Function GetVolumeInformation Lib _
"kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long
Code
Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
GetSerialNumber = SerialNum
End Function
Use
An example of using the above function:Call MsgBox GetSerialNumber("C:\")
This will bring up a message box with the serial number of the C drive.
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
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
Private Sub Command1_Click()
Dim len5 As Long, aa As Long
Dim cmprName As String
Dim osver As OSVERSIONINFO
'取得Computer Name
cmprName = String(255, 0)
len5 = 256
aa = GetComputerName(cmprName, len5)
cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1)
Computer = cmprName '取得CPU端口号
Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_Processor")
For Each mycpu In CPUs
Text1.Text = mycpu.ProcessorId
Next
End Sub
窗体上放一个按钮一个text就可以，大家收藏吧，这个程序对保护自己知识产权很有用的！
Dim Computer As String
Dim CPUs As Object, MyCpu As Object
和wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮) 取出的相同,我在IBM R31笔记本(PIII1.2)上得到的是 0383F9FF000006B1
在ASUS M2400笔记本(PIII1.1)上得到的是 0383F9FF000006B1不可能序列号有相同的吧,这样得到是不是CPU的型号之类的东东哦?在查查看.
如果你的软件（他nnd我的软件一套 1万呢 ），怎么不买只狗？
为什么我们不反过来想一想，到底CPU那东西有没有ID！！！！！！！！
其实，我们真的太笨了，忘了当年PIII的ID号的风波了吗？
其实除了PIII，别的CPU就根本没有所谓的CPU ID！！
不信，你去http://download.5iyt.com/SoftView_1752.htm下一个关于CPU的软件试试吧，你会明白了：）。
CPU ID，呵，真是让我钻了一个多星期的一个梦，哪有那东西啊！
我现在想想加密的事就头疼，还不如直接给人光盘得了。楼主1万多的用加密狗可以，那样就不用担心ghost。
把它作为一个模块，可以直接运行，不用form。
具体的运用方法，自个分析了，呵，这是别人的程序，我原来分析出来过，但是后来自个分析出的东东掉了：）。有了这东西稍懂一些的朋友就能从里面把对自个有用的东西提出来的。
Option Explicit
Option Base 0
Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
Private Type TGETVERSIONOUTPARAMS '{
bVersion As Byte 'Binary driver version.
bRevision As Byte 'Binary driver revision.
bReserved As Byte 'Not used.
bIDEDeviceMap As Byte 'Bit map of IDE devices.
fCapabilities As Long 'Bit mask of driver capabilities.
dwReserved(4) As Long 'For future use.
End TypePrivate Type TIDEREGS
bFeaturesReg As Byte 'Used for specifying SMART "commands".
bSectorCountReg As Byte 'IDE sector count register
bSectorNumberReg As Byte 'IDE sector number register
bCylLowReg As Byte 'IDE low order cylinder value
bCylHighReg As Byte 'IDE high order cylinder value
bDriveHeadReg As Byte 'IDE drive/head register
bCommandReg As Byte 'Actual IDE command.
bReserved As Byte 'reserved for future use. Must be zero.
End TypePrivate Type TSENDCMDINPARAMS
cBufferSize As Long 'Buffer size in bytes
irDriveRegs As TIDEREGS 'Structure with drive register values.
bDriveNumber As Byte 'Physical drive number to send 'command to (0,1,2,3).
bReserved(2) As Byte 'Reserved for future expansion.
dwReserved(3) As Long 'For future use.
''BYTE bBuffer(1) 'Input buffer.
End TypePrivate Type TDRIVERSTATUS
bDriverError As Byte 'Error code from driver, 'or 0 if no error.
bIDEStatus As Byte 'Contents of IDE Error register.
'Only valid when bDriverError 'is SMART_IDE_ERROR.
bReserved(1) As Byte 'Reserved for future expansion.
dwReserved(1) As Long 'Reserved for future expansion.
End TypePrivate Type TSENDCMDOUTPARAMS
cBufferSize As Long 'Size of bBuffer in bytes
DRIVERSTATUS As TDRIVERSTATUS 'Driver status structure.
bBuffer(511) As Byte 'Buffer of arbitrary length
'in which to store the data read from the drive.
End TypePrivate Type TIDSECTOR
wGenConfig As Integer
wNumCyls As Integer
wReserved As Integer
wNumHeads As Integer
wBytesPerTrack As Integer
wBytesPerSector As Integer
wSectorsPerTrack As Integer
wVendorUnique(2) As Integer
sSerialNumber(19) As Byte
wBufferType As Integer
wBufferSize As Integer
wECCSize As Integer
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
wMoreVendorUnique As Integer
wDoubleWordIO As Integer
wCapabilities As Integer
wReserved1 As Integer
wPIOTiming As Integer
wDMATiming As Integer
wBS As Integer
wNumCurrentCyls As Integer
wNumCurrentHeads As Integer
wNumCurrentSectorsPerTrack As Integer
ulCurrentSectorCapacity(3) As Byte
wMultSectorStuff As Integer
ulTotalAddressableSectors(3) As Byte
wSingleWordDMA As Integer
wMultiWordDMA As Integer
bReserved(127) As Byte
End Type
Private in_data As TSENDCMDINPARAMS
Private out_data As TSENDCMDOUTPARAMS
Private h As Long
Private i As Long
Private j As BytePrivate Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End TypePrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As LongPrivate Const VER_PLATFORM_WIN32S = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
As LongPrivate Const CREATE_NEW = 1
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End TypePrivate Declare Function DeviceIoControl Lib "kernel32" _
(ByVal hDevice As Long, ByVal dwIoControlCode As Long, _
lpInBuffer As Any, ByVal nInBufferSize As Long, _
lpOutBuffer As Any, ByVal nOutBufferSize As Long, _
lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Sub CopyRight()Dim StrMsg As String
StrMsg = StrMsg & "直接从RING3调用API DeviceIoControl()来获取硬盘信息的VB程序 "
StrMsg = StrMsg & vbCrLf & "板权信息如下："
StrMsg = StrMsg & vbCrLf & "***********************************************************"
StrMsg = StrMsg & vbCrLf & "硬盘物理序号测试 v1.0 for WIN95/98/Me/NT/2000. 抄袭 by 哎呀……"
StrMsg = StrMsg & vbCrLf & "想知道更多的信息？不告诉你，呵。"
StrMsg = StrMsg & vbCrLf & "2003.05.03"
StrMsg = StrMsg & vbCrLf & "***********************************************************"
StrMsg = StrMsg & vbCrLf & "VB程序抄袭：哎呀……"
StrMsg = StrMsg & vbCrLf & "网站：没有"
StrMsg = StrMsg & vbCrLf & "邮件：忘了"
StrMsg = StrMsg & vbCrLf & "2003.05.03"
MsgBox StrMsg
End SubSub ChangeByteOrder(szString() As Byte, uscStrSize As Long)
Dim i As Long
Dim temp As String
For i = 0 To uscStrSize - 1 Step 2
temp = szString(i)
szString(i) = szString(i + 1)
szString(i + 1) = temp
Next i
End SubPrivate Function hdid9x() As String 'We start in 95/98/Me
h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
If h = 0 Then
hdid9x = "open smartvsd.vxd failed"
Exit Function
End If
Dim olp As OVERLAPPED
Dim lRet As Long
lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olp)
If lRet = 0 Then
hdid9x = "DeviceIoControl failed:DFP_GET_VERSION"
CloseHandle (h)
Exit Function
End If
'If IDE identify command not supported, fails
If (vers.fCapabilities And 1) <> 1 Then
hdid9x = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Function
End If
'Display IDE drive number detected
Dim sPreOutStr As String
sPreOutStr = DetectIDE(vers.bIDEDeviceMap)
hdid9x = sPreOutStr
For j = 0 To 3
Dim phdinfo As TIDSECTOR
Dim s(40) As Byte
If (j And 1) = 1 Then
in_data.irDriveRegs.bDriveHeadReg = &HB0
Else
in_data.irDriveRegs.bDriveHeadReg = &HA0
End If
If (vers.fCapabilities And (16 \ (2 ^ j))) = (16 \ (2 ^ j)) Then
'We don't detect a ATAPI device.
hdid9x = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
Else
in_data.irDriveRegs.bCommandReg = &HEC
in_data.bDriveNumber = j
in_data.irDriveRegs.bSectorCountReg = 1
in_data.irDriveRegs.bSectorNumberReg = 1
in_data.cBufferSize = 512
lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olp)
If lRet = 0 Then
hdid9x = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (h)
Exit Function
End If
Dim StrOut As String
CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)
CopyMemory s(0), phdinfo.sModelNumber(0), 40
s(40) = 0
ChangeByteOrder s, 40
StrOut = ByteArrToString(s, 40)
hdid9x = hdid9x & vbCrLf & "Module Number:" & StrOut
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
StrOut = ByteArrToString(s, 8)
hdid9x = hdid9x & vbCrLf & "Firmware rev:" & StrOut
CopyMemory s(0), phdinfo.sSerialNumber(0), 20
s(20) = 0
ChangeByteOrder s, 20
StrOut = ByteArrToString(s, 20)
hdid9x = hdid9x & vbCrLf & "Serial Number:" & StrOut
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Dim dblStrOut As Double
dblStrOut = ByteArrToLong(s)
hdid9x = hdid9x & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
End If
Next j 'Close handle before quit
CloseHandle (h)
CopyRightEnd FunctionPrivate Function hdidnt() As String
Dim hd As String * 80
Dim phdinfo As TIDSECTOR
Dim s(40) As Byte
Dim StrOut As String
hdidnt = ""
'We start in NT/Win2000
For j = 0 To 3 '这里取四个硬盘的信息，因为正常PC不超过四个硬盘
hd = "\\.\PhysicalDrive" & CStr(j)
hdidnt = hdidnt & vbCrLf & hd
h = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
Dim olpv As OVERLAPPED
Dim lRet As Long
lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olpv)
If lRet = 0 Then
CloseHandle (h)
Else
'If IDE identify command not supported, fails
If (vers.fCapabilities And 1) <> 1 Then
hdidnt = "Error: IDE identify command not supported."
CloseHandle (h)
Exit Function
End If
'Identify the IDE drives
If (j And 1) = 1 Then
in_data.irDriveRegs.bDriveHeadReg = &HB0
Else
in_data.irDriveRegs.bDriveHeadReg = &HA0
End If
If (vers.fCapabilities And (16 \ (2 ^ j))) <> 0 Then
'We don't detect a ATAPI device.
hdidnt = hdidnt & vbCrLf & "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
Else
in_data.irDriveRegs.bCommandReg = &HEC
in_data.bDriveNumber = j
in_data.irDriveRegs.bSectorCountReg = 1
in_data.irDriveRegs.bSectorNumberReg = 1
in_data.cBufferSize = 512
Dim olpr As OVERLAPPED
lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olpr)
If lRet <= 0 Then
hdidnt = hdidnt & vbCrLf & "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
CloseHandle (h)
Else
CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)
CopyMemory s(0), phdinfo.sModelNumber(0), 40
s(40) = 0
ChangeByteOrder s, 40
StrOut = ByteArrToString(s, 40)
hdidnt = hdidnt & vbCrLf & "Module Number:" & StrOut
CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
s(8) = 0
ChangeByteOrder s, 8
StrOut = ByteArrToString(s, 8)
hdidnt = hdidnt & vbCrLf & "Firmware rev:" & StrOut
CopyMemory s(0), phdinfo.sSerialNumber(0), 20
s(20) = 0
ChangeByteOrder s, 20
StrOut = ByteArrToString(s, 20)
hdidnt = hdidnt & vbCrLf & "Serial Number:" & StrOut
CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
s(5) = 0
Dim dblStrOut As Double
dblStrOut = ByteArrToLong(s)
hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
CloseHandle (h)
End If
End If
End If
Next j
CopyRight
End Function
Dim Ret As Long
verinfo.dwOSVersionInfoSize = Len(verinfo)
Ret = GetVersionEx(verinfo)
Dim OutStr As String
Select Case verinfo.dwPlatformId
Case VER_PLATFORM_WIN32S
MsgBox "Win32s is not supported by this programm."
End
Case VER_PLATFORM_WIN32_WINDOWS
OutStr = hdid9x
MsgBox OutStr
End
Case VER_PLATFORM_WIN32_NT
OutStr = hdidnt
MsgBox OutStr
End
End SelectEnd Sub
Private Function DetectIDE(bIDEDeviceMap As Byte) As String
If (bIDEDeviceMap And 1) Then
If (bIDEDeviceMap And 16) Then
DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 0."
Else
DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 0."
End If
End If
If (bIDEDeviceMap And 2) Then
If (bIDEDeviceMap And 32) Then
DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 1."
Else
DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 1."
End If
End If
If (bIDEDeviceMap And 4) Then
If (bIDEDeviceMap And 64) Then
DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 0."
Else
DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 0."
End If
End If
If (bIDEDeviceMap And 8) Then
If (bIDEDeviceMap And 128) Then
DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 1."
Else
DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 1."
End If
End If
End Function
Private Function ByteArrToString(inByte() As Byte, ByVal strlen As Integer) As String
Dim i As Integer
For i = 0 To strlen
If inByte(i) = 0 Then
Exit For
End If
ByteArrToString = ByteArrToString & Chr(inByte(i))
Next i
End FunctionPrivate Function ByteArrToLong(inByte() As Byte) As Double
Dim i As Integer
For i = 0 To 3
ByteArrToLong = ByteArrToLong + CDbl(inByte(i)) * (256 ^ i)
Next i
End Function