程序代码:
Option Explicit
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
Public Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long, Res As Long, temp1 As String, 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
Public Function CheckSerial(Hash) As Boolean
CheckSerial = (GetSerial = Hash)
End Function
Public Function GetSerial(Optional DriveNumber As Long) As String
If IsMissing(DriveNumber) Then DriveNumber = GetSerialNumber(Left(App.Path, 1))
GetSerial = UCase(Left(Right(MD5(GetID & PrivateKey, 32), 18), 8))
End Function
Public Function GetID() As String
GetID = UCase(Left(Right(MD5(GetSerialNumber(Left(App.Path, 1)) & PrivateKey, 32), 18), 8))
End Function
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
Public Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long, Res As Long, temp1 As String, 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
Public Function CheckSerial(Hash) As Boolean
CheckSerial = (GetSerial = Hash)
End Function
Public Function GetSerial(Optional DriveNumber As Long) As String
If IsMissing(DriveNumber) Then DriveNumber = GetSerialNumber(Left(App.Path, 1))
GetSerial = UCase(Left(Right(MD5(GetID & PrivateKey, 32), 18), 8))
End Function
Public Function GetID() As String
GetID = UCase(Left(Right(MD5(GetSerialNumber(Left(App.Path, 1)) & PrivateKey, 32), 18), 8))
End Function





2008-9-15 18:35


