全部代码入下: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系列支持中文
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
'*************************************************** ' 此函数的作用为加密字符串 ' PassStr:欲加密的字符串 ' PassWord:密匙 '*************************************************** Public Function EncryptStr(mvarStr, mvarKey) As String '口令加密 Dim strChar As String * 1 Dim keyChar As String * 1 Dim encryptedChar As Integer Dim i As Integer If mvarStr = "" Then '输入口令为空 EncryptStr = mvarKey Else EncryptStr = "" For i = 1 To Len(mvarStr) strChar = Mid(mvarStr, i, 1) keyChar = Mid(mvarKey, (i Mod Len(mvarKey)) + 1) encryptedChar = Asc(strChar) Xor Asc(keyChar) EncryptStr = EncryptStr + Chr(encryptedChar) Next End If End FunctionPublic Function PassProc(PassStr As String, PassWord As String) As String '*************************************************** ' 此函数的作用为加密字符串 ' PassStr:欲加密的字符串 ' PassWord:密匙 '*************************************************** Dim PassStrLen As Long Dim PassWordLen As Long Dim i As Long Dim j As Long Dim TPassW As String Dim TPassS As String Dim Tstr As String Dim temp As Long If PassStr = "" Or PassWord = "" Then PassProc = "" Exit Function End If Tstr = "" PassStrLen = Len(PassStr) PassWordLen = Len(PassWord) i = 1 Do While i <= PassStrLen For j = 1 To PassWordLen If i > PassStrLen Then Exit For TPassS = Mid(PassStr, i, 1) TPassW = Mid(PassWord, j, 1) Tstr = Tstr + Chr(Asc(TPassS) Xor Asc(TPassW)) i = i + 1 Next j Loop PassProc = Tstr 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
用最简单的,随便找个字符与要加密的字符串挨个做异或。反之亦然
'用户口令加密
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
'***************************************************
' 此函数的作用为加密字符串
' PassStr:欲加密的字符串
' PassWord:密匙
'***************************************************
Public Function EncryptStr(mvarStr, mvarKey) As String '口令加密
Dim strChar As String * 1
Dim keyChar As String * 1
Dim encryptedChar As Integer
Dim i As Integer
If mvarStr = "" Then '输入口令为空
EncryptStr = mvarKey
Else
EncryptStr = ""
For i = 1 To Len(mvarStr)
strChar = Mid(mvarStr, i, 1)
keyChar = Mid(mvarKey, (i Mod Len(mvarKey)) + 1)
encryptedChar = Asc(strChar) Xor Asc(keyChar)
EncryptStr = EncryptStr + Chr(encryptedChar)
Next
End If
End FunctionPublic Function PassProc(PassStr As String, PassWord As String) As String
'***************************************************
' 此函数的作用为加密字符串
' PassStr:欲加密的字符串
' PassWord:密匙
'***************************************************
Dim PassStrLen As Long
Dim PassWordLen As Long
Dim i As Long
Dim j As Long
Dim TPassW As String
Dim TPassS As String
Dim Tstr As String
Dim temp As Long
If PassStr = "" Or PassWord = "" Then
PassProc = ""
Exit Function
End If
Tstr = ""
PassStrLen = Len(PassStr)
PassWordLen = Len(PassWord)
i = 1
Do While i <= PassStrLen
For j = 1 To PassWordLen
If i > PassStrLen Then Exit For
TPassS = Mid(PassStr, i, 1)
TPassW = Mid(PassWord, j, 1)
Tstr = Tstr + Chr(Asc(TPassS) Xor Asc(TPassW))
i = i + 1
Next j
Loop
PassProc = Tstr
End Function
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