Function.asp <% Rem ================================================================= Rem = 函数文件:Function.asp Rem = 测试文件:TestEncrypt.asp,Encryptpass.asp Rem = 说明:Encrypt_PRO加密函数,Decrypt_PRO解密函数 Rem = Revision:1.01 Beta Rem = 作者:熊氏英雄(cexo255),小奎 Rem = Date:2005/04/20 03:41:10 Rem = QQ:30133499,38377160 Rem = MySite:Http://www.Relaxlife.net Rem = QQ群:4341998 Rem = 适用:对数据的加密,或对代码的加密,可加密中文/英文等。完全解密,不会出现解密出现乱码。 Rem = 下版本预计改进:代码算法需要重写,可能知道的人多了就不太安全了。 Rem =================================================================
Public Const sDefaultWHEEL1 = "ABCDEFGHIJKLMNOPQRSTVUWXYZ_1234567890qwertyuiopasd!@#$%^&*(),. ~`-=\?/’""fghjklzxcvbnm<>;" Public Const sDefaultWHEEL2 = "IWEHJKTLZVOPFG_1234567890qwerBNMQRYUASDXCfghjklzxc ~`-=\?/’""!@#$%^&*(),.vbnm<>;tyuiopasd"
Function Encrypt_PRO(sINPUT , sPASSWORD ) Dim sWHEEL1, sWHEEL2 Dim k, c, i Dim sRESULT sWHEEL1 = sDefaultWHEEL1: sWHEEL2 = sDefaultWHEEL2 ScrambleWheels sWHEEL1, sWHEEL2, sPASSWORD sRESULT = "" For i = 1 To Len(sINPUT) c = Mid(sINPUT, i, 1) k = InStr(1, sWHEEL1, c) If k > 0 Then sRESULT = sRESULT & Mid(sWHEEL2, k, 1) Else sRESULT = sRESULT & Addpass(c,sPASSWORD) End If sWHEEL1 = LeftShift(sWHEEL1): sWHEEL2 = RightShift(sWHEEL2) Next Encrypt_PRO = sRESULT End Function
Function Decrypt_PRO(sINPUT , sPASSWORD ) Dim sWHEEL1, sWHEEL2 Dim k, i, c Dim sRESULT sWHEEL1 = sDefaultWHEEL1: sWHEEL2 = sDefaultWHEEL2 ScrambleWheels sWHEEL1, sWHEEL2, sPASSWORD sRESULT = "" For i = 1 To Len(sINPUT) c = Mid(sINPUT, i, 1) k = InStr(1, sWHEEL2, c, vbBinaryCompare) If k > 0 Then sRESULT = sRESULT & Mid(sWHEEL1, k, 1) Else sRESULT = sRESULT & Addpass(c,sPASSWORD) End If sWHEEL1 = LeftShift(sWHEEL1): sWHEEL2 = RightShift(sWHEEL2) Next Decrypt_PRO = sRESULT End Function
Function LeftShift(s ) If Len(s) > 0 Then LeftShift = Mid(s, 2, Len(s) - 1) & Mid(s, 1, 1) End Function
Function RightShift(s ) If Len(s) > 0 Then RightShift = Mid(s, Len(s), 1) & Mid(s, 1, Len(s) - 1) End Function
Sub ScrambleWheels(ByRef sW1 , ByRef sW2 , sPASSWORD ) Dim i ,k For i = 1 To Len(sPASSWORD) For k = 1 To Asc(Mid(sPASSWORD, i, 1)) * i sW1 = LeftShift(sW1): sW2 = RightShift(sW2) Next Next End Sub
Function Addpass(tStr,tPass) Select Case tStr Case Chr(13) Addpass = tStr Case Chr(10) Addpass = tStr Case Chr(13)+Chr(10) Addpass = tStr Case Chr(9) Addpass = tStr Case Else &nb