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 Function
复制代码

'加密
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 Function
复制代码

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

  sSrc = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
复制代码

  sSrc = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  sDes = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm0123456789"
复制代码

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

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

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 Function
复制代码

Microsoft (R) Windows Script Host Version 5.7
版权所有(C) Microsoft Corporation 1996-2001。保留所有权利。

Hello Word 加密后：{7EEH \HK6
{7EEH \HK6 解密后：Hello Word
复制代码