利用磁盘的序列号进行软件加密(3千字),磁盘,其他平台 2008年06月23日 星期一 下午 11:23 用过共享软件的人都知道,一般的共享软件(特别是国外的)在使用一段时间后都会 提出一些“苛刻”的要求,如让您输入注册号等等。如果您想在软件中实现该“功能” 的话,方法有很多。在这里我介绍一种我认为安全性比较高的一种,仅供参考。 大家都知道,当您在命令行中键入“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)下载源程序研究一下。 最后,我们就可以利用这些子程序进行加密了. |
|小黑屋|最新主题|手机版|微赢网络技术论坛 ( 苏ICP备08020429号 )
GMT+8, 2024-9-29 11:35 , Processed in 0.205565 second(s), 12 queries , Gzip On, MemCache On.
Powered by Discuz! X3.5
© 2001-2023 Discuz! Team.