[问题求助] [已解决]VBS加密解密字符串的问题

328612167

这是我在网上找的一段加密解密字符串的代码，但有些问题搞不定
问题1：会出错
问题2：终端代码的解密原理是什么

s="1862332/*-+."’这是要加密的字符串
s=ChgStr(s,1):msgbox s,,"加密后" 
s=ChgStr(s,0):msgbox s,,"解密后" 
 
Function ChgStr(str,flag)'flag:1为加密，非1为解密
    s1="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/*-+.~!@#$%^&*()_{}|:"<>?=[];',.\"
    s2="SGk7B4arX8UFecwJ9O6y2ihWMNKDp1ZE0gsmlTAQ5HYLjVIzqfuobvCxtPR3nd"
    If Not flag=1 Then t=s1:s1=s2:s2=t
    For i=1 To Len(str)
        before=Mid(str,i,1)
        For j=1 To 62
        after=Replace(before,Mid(s1,j,1),Mid(s2,j,1))
        If Not before=after Then ChgStr=ChgStr&after:Exit For
        Next
    Next
End FunctionCOPY

CrLf

这加密算法只是简单地单表置换，而且实现得很不好，最奇葩的是 s2 和 s1 居然还无法一一对应，所以会出错
至于解密，把 s1 和 s2 对换进行逆运算就行了

328612167

回复 2# CrLf


    我的目的是想加密一段字符串（这个字符串包含所有字符），在运行时又解密，不知怎样做才好

yu2n

回复 3# 328612167

QWERTY密码：加密与解密
http://demon.tw/programming/qwerty-abcdef.html

'Author: Demon
'Website: http://demon.tw
'Date: 2012/2/9
 
Function FromQwerty(str)
    Dim d, s, t, i, c, r
    s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    t = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 52
        d(Mid(t, i, 1)) = Mid(s, i, 1)
    Next
    For i = 1 To Len(str)
        c = Mid(str, i, 1)
        If d.Exists(c) Then
            r = r & d(c)
        Else
            r = r & c
        End If
    Next
    FromQwerty = r
End Function
 
WScript.Echo FromQwerty("OLSQFR")
 
'Author: Demon
'Website: http://demon.tw
'Date: 2012/2/9
 
Function ToQwerty(str)
    Dim d, s, t, i, c, r
    s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    t = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 52
        d(Mid(s, i, 1)) = Mid(t, i, 1)
    Next
    For i = 1 To Len(str)
        c = Mid(str, i, 1)
        If d.Exists(c) Then
            r = r & d(c)
        Else
            r = r & c
        End If
    Next
    ToQwerty = r
End Function
 
WScript.Echo ToQwerty("I LOVE YOU")COPY

yu2n

重复造个轮子……

'加密
Msgbox Qwerty("ABCDEF", 0)
 
'解密
Msgbox Qwerty("O SGCT NGX", 1)
 
'Qwerty() 如果 QWERTY 对应 ABCDEF 的话，那么其他字母的对应关系就是分别按照键盘顺序和字母顺序排列……
Function Qwerty(ByVal str, ByVal mode)
  Dim sSrc, sDes, sTmp, arrSrc(), arrDes(), arrTmp(), a, b
  sSrc = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
  If mode<>0 Then sTmp=sSrc : sSrc=sDes : sDes=sTmp
  ReDim arrSrc(Len(sSrc)) : ReDim arrDes(Len(sSrc)) : ReDim arrTmp(Len(str))
  For a=0 To Len(sSrc)-1
    arrSrc(a)=Mid(sSrc, a+1, 1) : arrDes(a)=Mid(sDes, a+1, 1)
  Next
  For b=0 To Len(str)-1
    arrTmp(b)=Mid(str, b+1, 1)
    For a=0 To Len(sSrc)-1
      If arrTmp(b)=arrSrc(a) Then arrTmp(b)=arrDes(a) : Exit For
    Next
  Next
  Qwerty=Join(arrTmp,"")
End FunctionCOPY

328612167

回复 5# yu2n

特殊字符不能处理

0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/*-+.~!@#$%^&*()_{}|:"<>?=[];',.\COPY

yu2n

回复 6# 328612167

Qwerty() 函数本身就没打算支持数字和特殊字符。支持了还叫 Qwerty() ?

当然，稍作修改，即可加入数字、特殊字符支持。

示例：加入1234567890的支持：
将

  sSrc = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"COPY

改为

  sSrc = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm0123456789"COPY

328612167

回复 2# CrLf


我的目的是想加密一段字符串（这个字符串可能包含以下所有字符）

0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/*-+.~!@#$%^&*()_{}|:"<>?=[];',.\COPY

不知有没有别的加密方式，还得解密

yu2n

回复 8# 328612167

a-Z,0-9 都教给你了，加几个特殊字符应该不难？

只需要 sSrc、sDes 保证唯一对应关系即可，随机打乱顺序……

纯英文、纯数字、特殊字符、汉字……原理都是一样的。

下面是英文、纯数字、特殊字符的对应。

将纯英文
  sSrc = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
改为英文、纯数字、特殊字符
  sSrc = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/*-+.~!@#$%^&*()_{}|:""<>?=[];',.\"
  sDes = "/*-+.~!@#$%^&*()_{}|:""<>?=[];',.\0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"COPY

不罗嗦，下面贴代码：

Option Explicit
 
'加密
Msgbox "Hello Word 加密后：" & MyEncryption("Hello Word", 0)
 
'解密
Msgbox "{7EEH \HK6 解密后：" & MyEncryption("{7EEH \HK6", 1)
 
Function MyEncryption(ByVal str, ByVal mode)
  Dim sSrc, sDes, sTmp, arrSrc(), arrDes(), arrTmp(), a, b
  sSrc = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/*-+.~!@#$%^&*()_{}|:""<>?=[];',.\"
  sDes = "/*-+.~!@#$%^&*()_{}|:""<>?=[];',.\0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
  If mode<>0 Then sTmp=sSrc : sSrc=sDes : sDes=sTmp
  ReDim arrSrc(Len(sSrc)) : ReDim arrDes(Len(sSrc)) : ReDim arrTmp(Len(str))
  For a=0 To Len(sSrc)-1
    arrSrc(a)=Mid(sSrc, a+1, 1) : arrDes(a)=Mid(sDes, a+1, 1)
  Next
  For b=0 To Len(str)-1
    arrTmp(b)=Mid(str, b+1, 1)
    For a=0 To Len(sSrc)-1
      If arrTmp(b)=arrSrc(a) Then arrTmp(b)=arrDes(a) : Exit For
    Next
  Next
  MyEncryption=Join(arrTmp,"")
End FunctionCOPY

结果：

Microsoft (R) Windows Script Host Version 5.7
版权所有(C) Microsoft Corporation 1996-2001。保留所有权利。
 
Hello Word 加密后：{7EEH \HK6
{7EEH \HK6 解密后：Hello WordCOPY

I wrote a new program? No. 我只是在纯英文字符对应关系里面加了数字、特殊字符而已。Well, say no more you don't understand ...

328612167

回复 9# yu2n


    你这个很完善。我之前是在我的那个代码上改的，所以出错了。多谢大神指点