软件加密方法 - VB / 数据库(包

常用几种加密算法
Base64    
MD5          
RC4          
DES          

搜索一下,以前许多贴子都有的

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

精华推荐：内存溢出处理方法 给些建议

• 
• lihonggen0
• (李洪根，MS MVP，标准答案)
• 等　级：

• 6

  更多勋章

#2楼 得分：0回复于：2003-05-15 18:29:02 经典加密算法在VB中的实现（3）-   RC4          

public   sub   main()  
dim   key   as   string  
for   i   =   1   to   16  
        randomize  
        key   =   key   &   chr(rnd   *   255)  
next   i  
msgbox   rc4(rc4( "welcome   to   plindge   studio! ",   key),   key)  
end   sub  
public   function   rc4(inp   as   string,   key   as   string)   as   string  
dim   s(0   to   255)   as   byte,   k(0   to   255)   as   byte,   i   as   long  
dim   j   as   long,   temp   as   byte,   y   as   byte,   t   as   long,   x   as   long  
dim   outp   as   string  

for   i   =   0   to   255  
        s(i)   =   i  
next  

j   =   1  
for   i   =   0   to   255  
        if   j   >   len(key)   then   j   =   1  
        k(i)   =   asc(mid(key,   j,   1))  
        j   =   j   +   1  
next   i  

j   =   0  
for   i   =   0   to   255  
        j   =   (j   +   s(i)   +   k(i))   mod   256  
        temp   =   s(i)  
        s(i)   =   s(j)  
        s(j)   =   temp  
next   i  

i   =   0  
j   =   0  
for   x   =   1   to   len(inp)  
        i   =   (i   +   1)   mod   256  
        j   =   (j   +   s(i))   mod   256  
        temp   =   s(i)  
        s(i)   =   s(j)  
        s(j)   =   temp  
        t   =   (s(i)   +   (s(j)   mod   256))   mod   256  
        y   =   s(t)  
         
        outp   =   outp   &   chr(asc(mid(inp,   x,   1))   xor   y)  
next  
rc4   =   outp  
end   function  

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

精华推荐：【热烈祝贺】陈锐、杨永刚2008年10月当选微软MVP

• 
• lihonggen0
• (李洪根，MS MVP，标准答案)
• 等　级：

• 6

  更多勋章

#3楼 得分：0回复于：2003-05-15 18:29:29 一个简单实用的   vb   加密/解密算法    

Function   UserCode(password   As   String)   As   String
'用户口令加密
        Dim   il_bit,   il_x,   il_y,   il_z,   il_len,   i   As   Long
        Dim   is_out   As   String
        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len
                il_bit   =   AscW(Mid(password,   i,   1))         'W系列支持unicode
               
                il_y   =   (il_bit   *   13   Mod   256)   +   il_x
                is_out   =   is_out   &   ChrW(Fix(il_y))     '取整   int和fix区别:   fix修正负数
                il_x   =   il_bit   *   13   /   256
        Next
        is_out   =   is_out   &   ChrW(Fix(il_x))
       
        password   =   is_out
        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len
                il_bit   =   AscW(Mid(password,   i,   1))
                '取前4位值
                il_y   =   il_bit   /   16   +   64
                is_out   =   is_out   &   ChrW(Fix(il_y))
                '取后4位值
                il_y   =   (il_bit   Mod   16)   +   64
                is_out   =   is_out   &   ChrW(Fix(il_y))
        Next
        UserCode   =   is_out
End   Function
Function   UserDeCode(password   As   String)   As   String
'口令解密
        Dim   is_out   As   String
        Dim   il_x,   il_y,   il_len,   i,   il_bit   As   Long

        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len   Step   2
                il_bit   =   AscW(Mid(password,   i,   1))
                '取前4位值
                il_y   =   (il_bit   -   64)   *   16
                '取后4位值
                'dd   =   AscW(Mid(password,   i   +   1,   1))   -   64
                il_y   =   il_y   +   AscW(Mid(password,   i   +   1,   1))   -   64
                is_out   =   is_out   &   ChrW(il_y)
        Next

        il_x   =   0
        il_y   =   0
        password   =   is_out
        is_out   =   " "

        il_len   =   Len(password)
        il_x   =   AscW(Mid(password,   il_len,   1))      

        For   i   =   (il_len   -   1)   To   1   Step   -1
                il_y   =   il_x   *   256   +   AscW(Mid(password,   i,   1))
                il_x   =   il_y   Mod   13
                is_out   =   ChrW(Fix(il_y   /   13))   &   is_out
        Next
        UserDeCode   =   is_out
End   Function

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

精华推荐：我的类该怎样安排（续）——请ahao也进来

• 
• yeyongji
• 等　级：

#4楼 得分：0回复于：2003-05-16 10:15:59 感谢lihonggen0,   不过我不是要机密算法,我是要防止软件被非法使用的方法.

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

精华推荐：写在冬日的第一天--一个女程序员第四年工作总结

• 
• lqlin
• 等　级：

#5楼 得分：0回复于：2003-05-16 12:42:19 你可以用一个函数来处理：
可将用记输入的密码按照一定的规则转化后存储到数据库，要取出密码时，用相反的过程即可，这样别人即使知道你数据库，但仍无法找到正确的密码，从而防止了非法用户！

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

精华推荐：关于JPG图片旋转问题,急急急!!!

• 
• lihonggen0
• (李洪根，MS MVP，标准答案)
• 等　级：

• 6

  更多勋章

#6楼 得分：0回复于：2003-05-16 13:16:20 防止软件被非法使用的方法

http://tech.sina.com.cn/s/1336.html  

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

• 对我有用[0]
• 丢个板砖[0]
• 引用
• 举报
• 管理
• TOP

• 
• since1990
• (level)
• 等　级：

#7楼 得分：0回复于：2003-07-25 18:47:35
利用磁盘的序列号进行软件加密

--------------------------------------------------------------------------------
http://tech.sina.com.cn   2001/03/12     天极网   徐江
　　用过共享软件的人都知道，一般的共享软件(特别是国外的)在使用一段时间后都会提出一些“苛刻”的要求，如让您输入注册号等等。如果您想在软件中实现该“功能”的话，方法有很多。在这里我介绍一种我认为安全性比较高的一种，仅供参考。

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


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


经典加密算法在VB中的实现（3）-   RC4          

public   sub   main()  
dim   key   as   string  
for   i   =   1   to   16  
        randomize  
        key   =   key   &   chr(rnd   *   255)  
next   i  
msgbox   rc4(rc4( "welcome   to   plindge   studio! ",   key),   key)  
end   sub  
public   function   rc4(inp   as   string,   key   as   string)   as   string  
dim   s(0   to   255)   as   byte,   k(0   to   255)   as   byte,   i   as   long  
dim   j   as   long,   temp   as   byte,   y   as   byte,   t   as   long,   x   as   long  
dim   outp   as   string  

for   i   =   0   to   255  
        s(i)   =   i  
next  

j   =   1  
for   i   =   0   to   255  
        if   j   >   len(key)   then   j   =   1  
        k(i)   =   asc(mid(key,   j,   1))  
        j   =   j   +   1  
next   i  

j   =   0  
for   i   =   0   to   255  
        j   =   (j   +   s(i)   +   k(i))   mod   256  
        temp   =   s(i)  
        s(i)   =   s(j)  
        s(j)   =   temp  
next   i  

i   =   0  
j   =   0  
for   x   =   1   to   len(inp)  
        i   =   (i   +   1)   mod   256  
        j   =   (j   +   s(i))   mod   256  
        temp   =   s(i)  
        s(i)   =   s(j)  
        s(j)   =   temp  
        t   =   (s(i)   +   (s(j)   mod   256))   mod   256  
        y   =   s(t)  
         
        outp   =   outp   &   chr(asc(mid(inp,   x,   1))   xor   y)  
next  
rc4   =   outp  
end   function  


一个简单实用的   vb   加密/解密算法    

Function   UserCode(password   As   String)   As   String
'用户口令加密
        Dim   il_bit,   il_x,   il_y,   il_z,   il_len,   i   As   Long
        Dim   is_out   As   String
        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len
                il_bit   =   AscW(Mid(password,   i,   1))         'W系列支持unicode
               
                il_y   =   (il_bit   *   13   Mod   256)   +   il_x
                is_out   =   is_out   &   ChrW(Fix(il_y))     '取整   int和fix区别:   fix修正负数
                il_x   =   il_bit   *   13   /   256
        Next
        is_out   =   is_out   &   ChrW(Fix(il_x))
       
        password   =   is_out
        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len
                il_bit   =   AscW(Mid(password,   i,   1))
                '取前4位值
                il_y   =   il_bit   /   16   +   64
                is_out   =   is_out   &   ChrW(Fix(il_y))
                '取后4位值
                il_y   =   (il_bit   Mod   16)   +   64
                is_out   =   is_out   &   ChrW(Fix(il_y))
        Next
        UserCode   =   is_out
End   Function
Function   UserDeCode(password   As   String)   As   String
'口令解密
        Dim   is_out   As   String
        Dim   il_x,   il_y,   il_len,   i,   il_bit   As   Long

        il_len   =   Len(password)
        il_x   =   0
        il_y   =   0
        is_out   =   " "
        For   i   =   1   To   il_len   Step   2
                il_bit   =   AscW(Mid(password,   i,   1))
                '取前4位值
                il_y   =   (il_bit   -   64)   *   16
                '取后4位值
                'dd   =   AscW(Mid(password,   i   +   1,   1))   -   64
                il_y   =   il_y   +   AscW(Mid(password,   i   +   1,   1))   -   64
                is_out   =   is_out   &   ChrW(il_y)
        Next

        il_x   =   0
        il_y   =   0
        password   =   is_out
        is_out   =   " "

        il_len   =   Len(password)
        il_x   =   AscW(Mid(password,   il_len,   1))      

        For   i   =   (il_len   -   1)   To   1   Step   -1
                il_y   =   il_x   *   256   +   AscW(Mid(password,   i,   1))
                il_x   =   il_y   Mod   13
                is_out   =   ChrW(Fix(il_y   /   13))   &   is_out
        Next
        UserDeCode   =   is_out
End   Function