'= Name: modpassword
'= Description: this function for string encrypt
'= Author: super.wang
'= Date: 2004/11/01
'==================================================
'= Please do not remove these Comment Lines!
Public Function Sumpssword (Byval Strsource As String) AS STRING
IF len (strsource) = 0 THEN EXIT FUNCTION
DIM buff () AS BYTE
Buff = strconv (strsource, vbfromunicore)
DIM I as long
DIM J AS BYTE
Dim k as byte, m as byte
DIM MSTR AS STRING
MSTR = "Abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz"
DIM OUTS AS STRING
i = ubound (buff) 1
OUTS = Space (2 * i)
DIM TEMPS AS STRING
For i = 0 to Ubound (buff)
Randomize Time
J = Cbyte (5 * (Math.rnd ()) 0) 'The maximum random number can only be 5, can not be big, then bigger, it is necessary to use one byte
BUFF (I) = BUFF (i) xor j
K = BUFF (i) MOD LEN (MSTR)
M = Buff (i) / len (MSTR)
m = m * 2 ^ 3 J
Temps = MID (MSTR, K 1, 1) MID (MSTR, M 1, 1)
MID (OUTS, 2 * i 1, 2) = Temps
NEXT
'Reverse password strings
DIM INTTEMP, INTFOR AS INTEGER
DIM STRTEMP, STROUT AS STRING
INTTEMP = LEN (OUTS)
For intFor = 0 to intTemp - 1
Strtemp = MID (Outs, IntTemp - Intfor, 1)
Strout = strout strtemp
NEXT
Sumpassword = strout
END FUNCTION
'Restore password, Super 04/11/1 change.
Public Function ReturnPassword (strpassword as string) AS STRING
ON Error Goto ERR
'Reverse password strings
DIM INTTEMP, INTFOR AS INTEGER
DIM STRTEMP, STROUT AS STRING
INTTEMP = LEN (STRPASSWORD) for intFor = 0 To intTemp - 1
Strtemp = MID (Strpassword, IntTemp - Intfor, 1)
Strout = strout strtemp
NEXT
strpassword = strout
'Decrypt start
DIM I as long
DIM J AS BYTE
Dim k as byte
DIM M as Byte
DIM MSTR AS STRING
MSTR = "Abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz"
DIM T1 AS STRING, T2 AS STRING
DIM buff () AS BYTE
DIM N As Long
N = 0
For i = 1 to Len (strpassword) Step 2
T1 = MID (Strpassword, I, 1)
T2 = MID (Strpassword, i 1, 1)
K = INSTR (1, MSTR, T1) - 1
M = INSTR (1, MSTR, T2) - 1
J = m / 2 ^ 3
M = M - J * 2 ^ 3
Redim Preserve Buff (n)
BUFF (N) = j * len (mstr) K
BUFF (N) = BUFF (N) xor M
n = n 1
NEXT
ReturnPassword = StrConv (buff, vbunicode)
EXIT FUNCTION
Err:
Returnpassword = ""
END FUNCTION
