利用磁碟的序列號進行軟體加密 (轉)[@more@]

 

利用的序列號進行

用過共享軟體的人都知道，一般的共享軟體(特別是國外的)在使用一段時間後都會提出一些“苛刻”的要求，如讓您輸入註冊號等等。如果您想在軟體中實現該“功能”的話，方法有很多。在這裡我介紹一種我認為性比較高的一種，僅供參考。

　　大家都知道，當您在命令列中鍵入“dir”指令後，都會讀出一個稱作Serial Number的十六進位制數字。這個數字理論上有上億種可能，而且很難同時找到兩個序列號一樣的。這就是我這種註冊方法的理論依據，透過判斷指定磁碟的序列號決定該機器的註冊號。

　　要實現該功能，如何獲得指定磁碟的序列號是最關鍵的。在中，有一個GetVolumeInformation的，我們利用這個函式就可以實現。

　　下面是實現該功能所需要的程式碼：

　　Private Declare Function GetVolumeInformation& Lib "kernel32" _

　　Alias "GetVolumeInformationA" (ByVal lpPathName 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

　　如果我們需要某個磁碟的序列號的話，只要Serial(該磁碟的磁碟機代號)即可。如DriverASerialNumber=DriverSerial("A")。

　　下面，我們就可以利用返回的磁碟序列號進行加密，需要用到一些數學知識。在這裡我用了俄羅斯密碼錶的加密演算法對進行了數學變換的序列號進行加密。下面是註冊碼驗證部分的程式碼：

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

　　Dim String 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 Mid 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

　　由於程式碼較長，還有一些部分的程式碼在此省略，您可以去我的網站()源研究一下。

　　最後，我們就可以利用這些子程式進行加密了。