利用磁盤的序列號進行軟件加密
用過共享軟件的人都知道，一般的共享軟件（特別是國外的）在使用一段時間后都會提出一些“苛刻”的要求，如讓您輸入注冊號等等。如果您想在軟件中實現該“功能”的話，方法有很多。在這里我介紹一種我認為安全性比較高的一種，僅供參考。
大家都知道，當您在命令行中鍵入“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 = 256Public 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 = RetValEnd 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 = TrueEnd Function
由于代碼較長，還有一些部分的代碼在此省略，您可以去我的網站(http://vbtechnology.yeah.net)下載源程序研究一下。
最后，我們就可以利用這些子程序進行加密了。