利用磁盤的序列號進行軟件加密

發表于:2007-07-14來源:作者:點擊數: 標簽:
用過共享軟件的人都知道,一般的共享軟件(特別是國外的)在使用一段時間后都會提出一些“苛刻”的要求,如讓您輸入注冊號等等。如果您想在軟件中實現該“功能”的話,方法有很多。在這里我介紹一種我認為 安全 性比較高的一種,僅供參考。 大家都知道,當您在
用過共享軟件的人都知道,一般的共享軟件(特別是國外的)在使用一段時間后都會提出一些“苛刻”的要求,如讓您輸入注冊號等等。如果您想在軟件中實現該“功能”的話,方法有很多。在這里我介紹一種我認為安全性比較高的一種,僅供參考。

  大家都知道,當您在命令行中鍵入“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

最后,我們就可以利用這些子程序進行加密了。 

原文轉自:http://www.anti-gravitydesign.com

国产97人人超碰caoprom_尤物国产在线一区手机播放_精品国产一区二区三_色天使久久综合给合久久97