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

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

yu2n

回复 6# 328612167

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

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

示例：加入1234567890的支持：
将

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

改为

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

yu2n

回复 8# 328612167

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

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

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

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

将纯英文
  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
复制代码

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