發信人: beny (刺客 ), 信區: Software
標 題: 利用磁碟的序列號進行軟體加密
發信站: 紫金飛鴻 (2001年03月16日19:03:42 星期五), 站內信件
用過共享軟體的人都知道，一般的共享軟體(特別是國外的)在使用一段時間後都會
提出一些“苛刻”的要求，如讓您輸入註冊號等等。如果您想在軟體中實現該“功能”
的話，方法有很多。在這裡我介紹一種我認為安全性比較高的一種，僅供參考。
大家都知道，當您在命令列中鍵入“dir”指令後，系統都會讀出一個稱作Serial
Number的十六進位制數字。這個數字理論上有上億種可能，而且很難同時找到兩個序列號
一樣的硬碟。這就是我這種註冊方法的理論依據，透過判斷指定磁碟的序列號決定該機
器的註冊號。
要實現該功能，如何獲得指定磁碟的序列號是最關鍵的。在Windows中，有一個Get
VolumeInformation的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
由於程式碼較長，還有一些部分的程式碼在此省略，您可以去我的網站(http://vbtech
nology.yeah.net)下載源程式研究一下。
最後，我們就可以利用這些子程式進行加密了。