发信人: williamlong(蓝色月光) 
整理人: williamlong(2002-07-10 20:01:57), 站内信件
 | 
 
 
 neil(原作)  
   
 关键字     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 = 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
 
 
 
  ----
  
           | 
 
 
 |