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

用过共享软件的人都知道，一般的共享软件(特别是国外的)在使用一段时间后都会

提出一些“苛刻”的要求，如让您输入注册号等等。如果您想在软件中实现该“功能”

的话，方法有很多。在这里我介绍一种我认为安全性比较高的一种，仅供参考。

大家都知道，当您在命令行中键入“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)下载源程序研究一下。

最后，我们就可以利用这些子程序进行加密了。

相关资讯：

相关软件：

→ 特别推荐

→ 热点TOP10

我为人人《《==》》人人为我

关于我们 |

帮助(？)|

广告服务 |

版权声明 |

商业合作 |

发展历程 |

加盟我们 |

联系我们

Copyright (C) 1998-2004 winzheng.com All Rights Reserved.

特别感谢 蓝芒科技 提供下载站及论坛服务器