05-25日<一个简单实用的 vb 加密/解密算法>之改进

vb 专栏收录该内容
1 篇文章 0 订阅

在看了网友 everjoe评论后,俺改进了一下该程序,其实也就是把W系列的函数用B系列去替代,然后就支持中文加密了

修改后的全部代码入下:

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 = LenB(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscB(MidB(password, i, 1))    'b系列支持中文
       
        il_y = (il_bit * 13 Mod 256) + il_x
        is_out = is_out & ChrB(Fix(il_y))  '取整 int和fix区别: fix修正负
        il_x = il_bit * 13 / 256
    Next
    is_out = is_out & ChrB(Fix(il_x))
   
    password = is_out
    il_len = LenB(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscB(MidB(password, i, 1))
        '取前4位值
        il_y = il_bit / 16 + 64
        is_out = is_out & ChrB(Fix(il_y))
        '取后4位值
        il_y = (il_bit Mod 16) + 64
        is_out = is_out & ChrB(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 = LenB(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len Step 2
        il_bit = AscB(MidB(password, i, 1))
        '取前4位值
        il_y = (il_bit - 64) * 16
        '取后4位值
        'dd = AscW(Mid(password, i + 1, 1)) - 64
        il_y = il_y + AscB(MidB(password, i + 1, 1)) - 64
        is_out = is_out & ChrB(il_y)
    Next

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

    il_len = LenB(password)
    il_x = AscB(MidB(password, il_len, 1))
    For i = (il_len - 1) To 1 Step -1
        il_y = il_x * 256 + AscB(MidB(password, i, 1))
        il_x = il_y Mod 13
        is_out = ChrB(Fix(il_y / 13)) & is_out
    Next
    UserDeCode = is_out
End Function

 

 

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

相关推荐
加密解密函数(另附加密解密函数可逆测试程序) Public Function UserCode(Optional ByVal password As String) As String '用户口令加密-非汉字 Dim il_bit, il_x, il_y, il_z, il_len, i As Long Dim is_out As String If password = "" Then Exit Function '注意此修改 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 Public Function UserDeCode(Optional ByVal password As String) As String '口令解密 Dim is_out As String Dim il_x, il_y, il_len, i, il_bit As Long If password = "" Then Exit Function '注意此修改 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
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值