我是一只超级菜鸟，学习VB程序也不过才一个星期左右，现在我提供一下这个注册机的源代码，大家不要笑话，也许是绕了很多弯，但是我的水平只有这么高了，呵，共同研究一下吧
Private Const MAX_IDE_DRIVES As Long = 4 ' Max number of drives assuming primary/secondary, master/slave topology
Private Const IDENTIFY_BUFFER_SIZE As Long = 512
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088
Private Type GETVERSIONOUTPARAMS
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(3) As Long ' For future use.
End Type
Private Type IDEREGS
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.
End Type
Private Type SENDCMDINPARAMS
cBufferSize As Long ' Buffer size in bytes
irDriveRegs As IDEREGS ' Structure with drive register values.
bDriveNumber As Byte ' Physical drive number to send
bReserved(2) As Byte ' Reserved for future expansion.
dwReserved(3) As Long ' For future use.
bBuffer(0) As Byte ' Input buffer.
End Type
Private Const IDE_ATAPI_ID As Long = &HA1 ' Returns ID sector for ATAPI.
Private Const IDE_ID_FUNCTION As Long = &HEC ' Returns ID sector for ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0 ' Performs SMART cmd.
Private Type DRIVERSTATUS
bReserved(1) As Byte ' Reserved for future expansion.
dwReserved(1) As Long ' Reserved for future expansion.
End Type
Private Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
drvStatus As DRIVERSTATUS ' Driver status structure.
bBuffer(0) As Byte ' Buffer of arbitrary length in which to store the data read from the ' drive.
End Type
Private Type ATTRTHRESHOLD
bAttrID As Byte ' Identifies which attribute
bWarrantyThreshold As Byte ' Triggering value
bReserved(9) As Byte ' ...
End Type
Private Type IDSECTOR
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
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
End Type
Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
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 Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private 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 Long
Private 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, ByVal lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private m_DiskInfo As IDSECTOR
Private Function OpenSMART(ByVal nDrive As Byte) As Long
Dim hSMARTIOCTL As Long
Dim hd As String
Dim VersionInfo As OSVERSIONINFO
VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx VersionInfo
Select Case VersionInfo.dwPlatformId
Case VER_PLATFORM_WIN32s
OpenSMART = hSMARTIOCTL
Case VER_PLATFORM_WIN32_WINDOWS
hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
Case VER_PLATFORM_WIN32_NT
If nDrive < MAX_IDE_DRIVES Then
hd = "\\.\PhysicalDrive" & nDrive
hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
End If
End Select
OpenSMART = hSMARTIOCTL
End Function
Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
'
pSCIP.irDriveRegs.bCommandReg = bIDCmd
pSCIP.bDriveNumber = bDriveNum
DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _
pSCIP, 32, _
pSCOP(0), 528, _
lpcbBytesReturned, 0))
End Function
Public Function GetDiskInfo(ByVal nDrive As Byte) As Long
Dim hSMARTIOCTL As Long
Dim cbBytesReturned As Long
Dim VersionParams As GETVERSIONOUTPARAMS
Dim scip As SENDCMDINPARAMS
Dim scop() As Byte
Dim OutCmd As SENDCMDOUTPARAMS
Dim bDfpDriveMap As Byte
Dim bIDCmd As Byte ' IDE or ATAPI IDENTIFY cmd
Dim uDisk As IDSECTOR
m_DiskInfo = uDisk
hSMARTIOCTL = OpenSMART(nDrive)
If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then
Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0)
bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION)
ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
CloseHandle hSMARTIOCTL
GetDiskInfo = 1
Exit Function '>---> Bottom
End If
CloseHandle hSMARTIOCTL
GetDiskInfo = 0
End If
End Function
Private Sub Command2_Click()
MsgBox "»¶Ó­¹âÁÙÆ®ÔƸó", 64, "¹ØÓÚ"
End Sub
Private Sub Form_Load()
If GetDiskInfo(0) = 1 Then
pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
End If
sn = Mid(pSerialNumber, 1, 8)
If Len(sn) < 8 Or Len(snr) > 8 Then
MsgBox "»ñÈ¡Ó²ÅÌÐòÁкÅʧ°Ü£¡", 64, "´íÎó"
End
Else
a = Mid(sn, 1, 2)
b = Mid(sn, 3, 2)
c = Mid(sn, 5, 2)
d = Mid(sn, 7, 2)
For i = 1 To 2
v = Mid(a, i, 1) & v
Next
For j = 1 To 2
x = Mid(b, j, 1) & x
Next
For k = 1 To 2
y = Mid(c, k, 1) & y
Next
For l = 1 To 2
z = Mid(d, l, 1) & z
Next
snOK = v & x & y & z
Text2.Text = snOK
End If
End Sub
Private Sub Command1_Click()
If Text1.Text = "" Then
MsgBox "ÇëÊäÈëÓû§Ãû£¡", 64, "´íÎó"
Else
Dim i, stringcd, sum, j As Integer
Dim code1, code2, code3, t1, t2, t3 As Long
stringchang = Text1.Text & Text2.Text
stringcd = Len(stringchang)
sum = 0
i = 1
For i = 1 To stringcd
sum = sum + Asc(Mid(stringchang, i, 1))
Next
t1 = CLng(stringcd) * 345
code1 = CLng(sum) * 73 + t1
t2 = CLng(sum) * 345
code2 = t2 * 21
t3 = CLng(stringcd) * CLng(sum)
code3 = t3 * 115 + 345
Text3.Text = code1 & "-" & code2 & "-" & code3
End If
End Sub
刚刚在网上找到的获取机器码的源代码，所以就写了一下注册机
[ 本帖最后由 nieufo 于 2007-1-9 13:44 编辑 ]
都下来学习一下，感谢分享
好文章，我得认真学习一下算法了，老是学不会，郁闷中
收下,学习中:handshake