利用磁盘的序列号进行软件加密

用过共享软件的人都知道，一般的共享软件（特别是国外的）在使用一段时间后都会提出一些“苛刻”的要求，如让您输入注册号等等。如果您想在软件中实现该“功能”的话，方法有很多。在这里我介绍一种我认为安全性比较高的一种，仅供参考。
    大家都知道，当您在命令行中键入“dir”指令后，系统都会读出一个称作Serial Number的十六进制数字。这个数字理论上有上亿种可能，而且很难同时找到两个序列号一样的硬盘。这就是我这种注册方法的理论依据，通过判断指定磁盘的序列号决定该机器的注册号。
    要实现该功能，如何获得指定磁盘的序列号是最关键的。在Windows中，有一个GetVolumeInformation的API函数，我们利用这个函数就可以实现。
    下面是实现该功能所需要的代码： 

Private Declare Function GetVolumeInformation& Lib "kernel32" _
  Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
  ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
  lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
  ByVal nFileSystemNameSize As Long)

Private Const MAX_FILENAME_LEN = 256

Public Function DriveSerial(ByVal sDrv As String) As Long
'Usage:
'Dim ds As Long
'ds = DriveSerial("C")
     Dim RetVal As Long
     Dim str As String * MAX_FILENAME_LEN
     Dim str2 As String * MAX_FILENAME_LEN
     Dim a As Long
     Dim b As Long
     GetVolumeInformation sDrv & ":\", str, MAX_FILENAME_LEN, RetVal, _
                          a, b, str2, MAX_FILENAME_LEN
     DriveSerial = RetVal
End Function

    如果我们需要某个磁盘的序列号的话，只要DriverSerial(该磁盘的盘符)即可。如 DriverASerialNumber=DriverSerial("A")。
    下面，我们就可以利用返回的磁盘序列号进行加密，需要用到一些数学知识。在这里我用了俄罗斯密码表的加密算法对进行了数学变换的序列号进行加密。下面是注册码验证部分的代码： 

Public Function IsValidate(ByVal SRC As Long, ByVal Value As String) As Boolean
    Dim SourceString As String
    Dim NewSRC As Long

    For i = 0 To 30
        If (SRC And 2 ^ i) = 2 ^ i Then
            SourceString = SourceString + "1"
        Else
            SourceString = SourceString + "0"
        End If
    Next i
    If SRC < 0 Then
SourceString = SourceString + "1"
Else
SourceString = SourceString + "0"
End If


Dim Table As String
Dim TableIndex As Integer

'================================================================================
'这是密码表，根据你的要求换成别的，不过长度要一致
'================================================================================
'注意：这里的密码表变动后，对应的注册号生成器的密码表也要完全一致才能生成正确的注册号
Table = "JSDJFKLUWRUOISDH;KSADJKLWQ;ABCDEFHIHL;KLADSHKJAGFWIHERQOWRLQH"
'================================================================================

Dim Result As String
Dim MidWord As String
Dim MidWordValue As Byte
Dim ResultValue As Byte

For t = 1 To 1
For i = 1 To Len(SourceString)
MidWord = Mid(SourceString, i, 1)
MidWordValue = Asc(MidWord)
TableIndex = TableIndex + 1
If TableIndex > Len(Table) Then TableIndex = 1
            ResultValue = Asc(Mid(Table, TableIndex, 1)) Mod MidWordValue
            Result = Result + Hex(ResultValue)
        Next i
        SourceString = Result
    Next t
    Dim BitTORool As Integer

    For t = 1 To Len(CStr(SRC))
        BitTORool = SRC And 2 ^ t
        For i = 1 To BitTORool
            SourceString = Right(SourceString, 1) _
   + Left(SourceString, Len(SourceString) - 1)
        Next i
    Next t
    If SourceString = Value Then IsValidate = True
End Function

    还有一些部分的代码在此省略，您可以下载源程序研究一下。
    最后，我们就可以利用这些子程序进行加密了。


    附：源代码中DLL的使用方法
    首先将该DLL加进“参考”中，然后在适当的地方加入下列代码：
　

Dim IsReg As New Regist
'IsRegistered(注册文件的文件名,注册依据的磁盘盘符)
If IsReg.IsRegistered("Reg.dat", "C") Then
    '这里您可以使用自己的注册成功的代码
    MsgBox "您已经注册了。谢谢！", vbInformation
Else
    '您可以使用自己的注册不成功的代码
    MsgBox "快注册！否则，嘿嘿...", vbCritical
End If

　

     下载源代码(27KB)