|
VB 字符串自定义密匙加密及解密：
Option Explicit
Dim key() As Byte
Sub TheKey() '密匙
ReDim key(9) '定义九位密匙
key(0) = 12
key(1) = 43
key(2) = 53
key(3) = 67
key(4) = 78
key(5) = 82
key(6) = 91
key(7) = 245
key(8) = 218
key(9) = 190
End Sub
Function PassEncode(ByVal s As String) As String '加密
On Error GoTo over
Dim Buff() As Byte, i As Long, j As Long, k As Long, mstr As String, outstr As String, temps As String
TheKey '读取密匙
Buff = StrConv(s, vbFromUnicode)
k = UBound(key) + 1
For i = 0 To UBound(Buff)
j = i Mod k
Buff(i) = Buff(i) Xor key(j)
Next
mstr = "abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" '定义字符集
For i = 0 To UBound(Buff)
k = Buff(i) \ Len(mstr)
j = Buff(i) Mod Len(mstr)
temps = Mid(mstr, j + 1, 1) + Mid(mstr, k + 1, 1)
outstr = outstr + temps
Next
PassEncode = outstr
Exit Function
over:
PassEncode = ""
End Function
Function PassUnCode(ByVal s As String) As String '解密
On Error GoTo over
Dim i As Long, j As Long, k As Long, n As Long, mstr As String, outstr As String, temps As String, t1 As String, t2 As String, Buff() As Byte, m As Long
TheKey '读取密匙
mstr = "abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" '定义字符集
If Len(s) Mod 2 = 1 Then
PassUnCode = ""
Exit Function
End If
m = 0
For i = 1 To Len(s) Step 2
t1 = Mid(s, i, 1)
t2 = Mid(s, i + 1, 1)
j = InStr(1, mstr, t1)
k = InStr(1, mstr, t2)
n = j - 1 + (k - 1) * Len(mstr)
ReDim Preserve Buff(m)
Buff(m) = n
m = m + 1
Next
k = UBound(key) + 1
For i = 0 To UBound(Buff)
j = i Mod k
Buff(i) = Buff(i) Xor key(j)
Next
PassUnCode = StrConv(Buff, vbUnicode)
Exit Function
over:
PassUnCode = ""
End Function |