07/03/29 10:21:53 0YQsGh540.net
Function encode(ptxt, Optional ekey = 0)
Dim ptbl, ctbl, ctxt, key1, key2, l, tmp, i, p, c, ii, iii, key, chk
On Error GoTo lh
ptbl = "??adgjmpsvy??0369????behknqtwz-@147????cfilorux??.?258????"
ctbl = "??dLu/DnW5gOxY7QzaI??.CmV4fNw_FpPyHq+??U3eMv@EoX?6hGZ8iR??"
l = Len(ptxt)
key1 = Int((ekey Mod 10) / 3)
key2 = ekey Mod 3
ctxt = ""
chk = 0
For i = 1 To l
ii = (i - 1) Mod 3
iii = Int((i - 1) / 3) Mod 2
If iii = 0 Then
key = key1
Else
key = key2
End If
c = Mid(ptxt, i, 1)
chk = chk + Asc(c)
tmp = InStr(ptbl, c)
If tmp >= 1 Then
tmp = tmp + ((key + ii) Mod 3)
ctxt = ctxt & Mid(ctbl, tmp, 1)
Else
ctxt = ctxt & "*"
End If
Next
ctxt = ctxt & Right(Str(chk + 5 + (ekey Mod 10)), 2)
ctxt = ctxt & Right("0" & ekey, 2)
encode = ctxt
Exit Function
lh:
encode = "ERROR"
End Function