[原创]键盘键值替换→VBS版 - DOS批处理 & 脚本技术（批处理室） - 中国DOS联盟论坛

一如我以往所发，原理是千篇一律的简单，此处更是简单只不过是导入了一个reg文件在HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout\Scancode Map 写完胡乱测试了一下，发现个别键不能做傀儡键如（Print），由于每次都要重启懒得继续测试了，希望有兴趣的朋友测试完善。

'***************************************************************************** ' FileName: KeyChange.VBS ' Author: baomaboy ' Abstract: 键盘键值替换程序 '***************************************************************************** Dim WshShell,FSO,Dic On Error Resume Next Set WshSHell = WScript.CreateObject("WScript.Shell") Set FSO = CreateObject("Scripting.FileSystemObject") Set Args = WScript.Arguments CloseTime = 5 FileName = WScript.ScriptName FileFullName = WScript.ScriptFullName FilePath = FSO.GetParentFolderName(FileFullName) InsPath = FSO.GetSpecialFolder(1) InsFullName = FSO.BuildPath(InsPath ,FileName) Copyright="玲珑科技" QQ="QQ:25926183" Email="Email:25926183@qq.com" InsTitle="键盘键值替换程序" InsAnswer="键盘键值替换程序" RegPath1="HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\KeyChange\" RegValue1="键值替换器" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\KeyChange\command\" RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) RegForm2="REG_SZ" IF FileFullName <> InsFullName then intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - by baomaboy") If intAnswer = vbYes Then WshSHell.RegWrite RegPath1,RegValue1,RegForm1 WshSHell.RegWrite RegPath2,RegValue2,RegForm2 WshSHell.RegDelete "HKEY_LOCAL_MACHINE\SOFTWARE\LLKJ\Temp\KeyChange\" FSO.GetFile(FileFullName).Copy(InsFullName) Call InsTall WshSHell.popup _ "添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _ "添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath2 +chr(34)+chr(10)+ _ chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "安装成功 - "+ InsTitle +" - by baomaboy", 0 + 64 end if If intAnswer = vbNo Then WshSHell.RegDelete RegPath2 WshSHell.RegDelete RegPath1 WshSHell.RegDelete "HKEY_LOCAL_MACHINE\SOFTWARE\LLKJ\Temp\KeyChange\" FSO.DeleteFile InsFullName WshSHell.popup _ "删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _ "删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath2 +chr(34)+chr(10)+ _ chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "卸载成功 - "+ InsTitle +" - by baomaboy", 0 + 64 end if If intAnswer = vbCancel Then end if Else Set Dic = createObject("Scripting.Dictionary") Dic.add "21E0" ," Calc" Dic.add "6CE0" ,"Mail" Dic.add "6DE0" ,"Media" Dic.add "11E0" ,"Web" Dic.add "6BE0" ,"Computer" Dic.add "20E0" ," ※ " Dic.add "10E0" ," |<< " Dic.add "22E00" ,"Play"'''因为和Pause重复了所以补0注意提取时去掉 Dic.add "19E0" ," >>| " Dic.add "24E0" ," ■ " Dic.add "30E0" ,"V↑" Dic.add "2EE0" ,"V↓" Dic.add "6AE0" ,"《 " Dic.add "69E0" ," 》" Dic.add "68E0" ," × " Dic.add "67E0" ," ∈ " Dic.add "32E0" ,"Home" Dic.add "65E0" ," S " Dic.add "66E0" ," F " Dic.add "0100" ," Esc " Dic.add "3B00" ," F1 " Dic.add "3C00" ," F2 " Dic.add "3D00" ," F3 " Dic.add "3E00" ," F4 " Dic.add "3F00" ," F5 " Dic.add "4000" ," F6 " Dic.add "4100" ," F7 " Dic.add "4200" ," F8 " Dic.add "4300" ," F9 " Dic.add "4400" ," F10" Dic.add "5700" ," F11" Dic.add "5800" ," F12" Dic.add "37E0" ,"PrtSc" Dic.add "4600" ,"Scroll" Dic.add "22E0" ,"Pause" Dic.add "53E0" ,"Delete" Dic.add "2900" ," ` " Dic.add "0200" ," 1 " Dic.add "0300" ," 2 " Dic.add "0400" ," 3 " Dic.add "0500" ," 4 " Dic.add "0600" ," 5 " Dic.add "0700" ," 6 " Dic.add "0800" ," 7 " Dic.add "0900" ," 8 " Dic.add "0A00" ," 9 " Dic.add "0B00" ," 0 " Dic.add "0C00" ," - " Dic.add "0D00" ," = " Dic.add "0E00" ," BackSpace" Dic.add "47E0" ," Home" Dic.add "4500" ,"Num" Dic.add "35E0" ," / " Dic.add "3700" ," * " Dic.add "4A00" ," - " Dic.add "0F00" ," Tab " Dic.add "1000" ," Q " Dic.add "1100" ," W " Dic.add "1200" ," E " Dic.add "1300" ," R " Dic.add "1400" ," T " Dic.add "1500" ," Y " Dic.add "1600" ," U " Dic.add "1700" ," I " Dic.add "1800" ," O " Dic.add "1900" ," P " Dic.add "1A00" ," [ " Dic.add "1B00" ," ] " Dic.add "2B00" ," \ " Dic.add "49E0" ,"PageU" Dic.add "4700" ," 7 " Dic.add "4800" ," 8 " Dic.add "4900" ," 9 " Dic.add "4E00" ," + " Dic.add "3A00" ,"CapsLock" Dic.add "1E00" ," A " Dic.add "1F00" ," S " Dic.add "2000" ," D " Dic.add "2100" ," F " Dic.add "2200" ," G " Dic.add "2300" ," H " Dic.add "2400" ," J " Dic.add "2500" ," K " Dic.add "2600" ," L " Dic.add "2700" ," ; " Dic.add "2800" ," ' " Dic.add "1C00" ," Enter " Dic.add "51E0" ,"PageD" Dic.add "4B00" ," 4 " Dic.add "4C00" ," 5 " Dic.add "4D00" ," 6 " Dic.add "2A00" ," Shift " Dic.add "2C00" ," Z " Dic.add "2D00" ," X " Dic.add "2E00" ," C " Dic.add "2F00" ," V " Dic.add "3000" ," B " Dic.add "3100" ," N " Dic.add "3200" ," M " Dic.add "3300" ," , " Dic.add "3400" ," . " Dic.add "3500" ," / " Dic.add "3600" ," Shift " Dic.add "4FE0" ," End " Dic.add "4F00" ," 1 " Dic.add "5000" ," 2 " Dic.add "5100" ," 3 " Dic.add "1CE0" ,"Enter" Dic.add "1D00" ," Ctrl" Dic.add "5BE0" ," Win " Dic.add "3800" ," Alt " Dic.add "3900" ," Space " Dic.add "38E0" ," Alt " Dic.add "58E0" ,"Print" Dic.add "1DE0" ," Ctrl" Dic.add "52E0" ,"Insert" Dic.add "48E0" ," ↑ " Dic.add "5200" ," 0 " Dic.add "5300" ," . " Dic.add "4BE0" ," ← " Dic.add "80E0" ," ↓ " Dic.add "4DE0" ," → " Ditems = Dic.Items Dkeys = Dic.Keys Dcount = Dic.Count WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1201",0,"REG_DWORD" WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\2201",3,"REG_DWORD" Set oIE = CreateObject("InternetExplorer.Application") With oIE .Navigate "about:blank" .ToolBar = 0 .MenuBar = 0 .Width = 980 .Height = 500 .Left = (.Document.ParentWindow.Screen.AvailWidth - .Width)/2 .Top = (.Document.ParentWindow.Screen.AvailHeight - .Height)/2 .Visible = 1 End With oIE.Document.Write _ "<html><STYLE type=text/css>INPUT {FONT-SIZE: 12px;FONT-FAMILY: ""Times New Roman"", ""Times"", ""serif""; HEIGHT: 25px}</STYLE><title>键盘按键替换 - By baomaboy - QQ:25926183</title></html>"&VbCr& _ "<table width=""0%"" BORDER=2 BORDERCOLOR=blue><tr><td colspan=""13"" align=""center""></td>"&VbCr For KeyW = 0 to 18 oIE.Document.Write "<td align=""center""><INPUT onclick=detect(name) name="""&Left(Dkeys(KeyW),4)&""" type=submit value="""&Ditems(KeyW)&""" ></td>"&VbCr if Ditems(KeyW) = "Computer" or Ditems(KeyW) = "V↓" then oIE.Document.Write "<td colspan=""10"" align=""center""></td>"&VbCr if Ditems(KeyW) = " F " then oIE.Document.Write "<td colspan=""14"" align=""center""></td></tr></table>"&VbCr Next oIE.Document.Write "<table width=""0%"" BORDER=3 BORDERCOLOR=blue><tr>"&VbCr For KeyW = 19 to Dic.count - 1 JH=1 JL=1 if Ditems(KeyW) = " ` " or Ditems(KeyW) = " BackSpace" or Ditems(KeyW) = " Tab " or Ditems(KeyW) = " \ " or Ditems(KeyW) = "CapsLock" or Ditems(KeyW) = " Win " or Ditems(KeyW) = " 0 " then JL = 2 end if if Ditems(KeyW) = " Enter " or Ditems(KeyW) = " Shift " or Ditems(KeyW) = " Shift " then JL = 3 end if if Ditems(KeyW) = " Space " then JL = 5 end if if Ditems(KeyW) = " + " or Ditems(KeyW) = "Enter" or Ditems(KeyW) = " Ctrl" or Ditems(KeyW) = " Win " or Ditems(KeyW) = " Alt " or Ditems(KeyW) = " | " or Ditems(KeyW) = " Space " or Ditems(KeyW) = " Alt " or Ditems(KeyW) = "Print" or Ditems(KeyW) = " Ctrl" or Ditems(KeyW) = "Insert" then JH = 2 end if if JL<> 1 or JH <> 1 then oIE.Document.Write "<td colspan="""&JL&""" rowspan="""&JH&""" align=""center""><INPUT onclick=detect(name) name="""&Dkeys(KeyW)&""" type=submit value="""&Ditems(KeyW)&"""></td>"&VbCr else oIE.Document.Write "<td align=""center""><INPUT onclick=detect(name) name="""&Dkeys(KeyW)&""" type=submit value="""&Ditems(KeyW)&"""></td>"&VbCr end if if Ditems(KeyW) = "Delete" then oIE.Document.Write "<td align=""center""> </td><td align=""center""> </td><td align=""center""> </td><td align=""center""> </td>"&VbCr&"</tr><tr>"&VbCr if Ditems(KeyW) = " - " or Ditems(KeyW) = " + " or Dkeys(KeyW) = "4D00" or Ditems(KeyW) = "Enter" or Dkeys(KeyW) = "5300" then oIE.Document.Write "</tr><tr>"&VbCr if Ditems(KeyW) = "Insert" or Ditems(KeyW) = " ↑ " then oIE.Document.Write "<td align=""center""> </td>"&VbCr if Dkeys(KeyW) = "3800" then oIE.Document.Write "<td colspan=""1"" rowspan=""2"" align=""center""><INPUT onclick=alert(""此键禁止替换……O(∩_∩)O~"") name="""" type=submit value="" | ""></td>"&VbCr Next oIE.Document.Write "</tr></table><br>"&VbCr oIE.Document.Write "<INPUT TYPE=button NAME=""textbox"" VALUE=""刚才按错了，全部重新开始吧!"" onclick=deltem(name)>"&VbCr oIE.Document.Write "<INPUT TYPE=button NAME=""textbox"" VALUE=""OK 了，点我提交替换请求!"" onclick=okkey(name)>"&VbCr oIE.Document.Write "<INPUT TYPE=button NAME=""textbox"" VALUE=""全部清空，删除所有按键替换!"" onclick=delkeymap(name)>"&VbCr oIE.Document.Write "<INPUT TYPE=button NAME=""textbox"" VALUE=""点我安全退出,不要点×号!"" onclick=exkey(name)>"&VbCr oIE.Document.Write "<br><br><br>"&VbCr&"<body><div style='font-family: Courier New;font-size:13px;overflow:auto;border-width:1px;border-style:solid;border-color:#8a8a8a;background-color:#eeeeee;margin:1px;padding:6px;'>" oIE.Document.Write "1.目的：你想用空格键作为媒体播放器的静音键，另外你的回车键坏了你想用Home键替换。<br>"&VbCr oIE.Document.Write "2.操作：正确的顺序是用鼠标依次点击“※”“空格”“Enter”“Home”（先功能键后傀儡键）。<br>"&VbCr oIE.Document.Write "3.警告：由于未使用HTA所以修改注册表提高权限，退出时切记点安全退出，修复此问题。<br>"&VbCr&"</div></body>" oIE.Document.Write "<SCRIPT>"&VbCr&"init();"&VbCr&"var SHL"&VbCr&"function init()"&VbCr&"{try { SHL = new ActiveXObject(""WScript.Shell""); return true; } catch(e) { alert(""创建对象失败，无法进行按键替换。""); return false;} }"&_ VbCr&"i = 0"&VbCr&"function detect(yname)//写入注册表临时数据,未预防KeyChange下提前有值存在应在vbs调用本程序之前予以删除KeyChange"&VbCr&"{"&VbCr&" try"&VbCr&" {"&VbCr&_ " i = i + 1"&VbCr&" var Num = ""Num""+i"&VbCr&" SHL.RegWrite(""HKEY_LOCAL_MACHINE\\SOFTWARE\\LLKJ\\Temp\\KeyChange\\""+Num,yname, ""REG_SZ"");"&VbCr&" }"&VbCr&" catch(e)"&VbCr&" {"&_ VbCr&" alert(""设置临时键值数据出错,请退出本程序。"");"&VbCr&" }"&VbCr&"}"&VbCr&"function deltem(yname)//全部重新开始，删除注册表临时数据"&VbCr&"{"&VbCr&" try"&VbCr&" {"&_ VbCr&" SHL.RegDelete(""HKEY_LOCAL_MACHINE\\SOFTWARE\\LLKJ\\Temp\\KeyChange\\"");"&VbCr&" document.location.reload()//刷新"&VbCr&" }"&VbCr&" catch(e)"&VbCr&" {"&VbCr&" alert(""临时数据已经被清空，可以重新开始设置。"");"&_ VbCr&" document.location.reload()//刷新"&VbCr&" }"&VbCr&"}"&VbCr&"function delkeymap(yname)//全部清空，删除所有按键替换!"&VbCr&"{"&VbCr&" try"&VbCr&" {"&_ VbCr&" SHL.RegWrite(""HKEY_LOCAL_MACHINE\\SOFTWARE\\LLKJ\\Temp\\KeyChange\\Num1"",""0000"", ""REG_SZ"");//预防此键值不存在而出错直接进入容错过程而不进行下一步操作"&_ VbCr&" //SHL.RegWrite(""HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\KeyBoard Layout\\Scancode Map"",""0000"", ""REG_SZ"");"&VbCr&" SHL.RegDelete(""HKEY_LOCAL_MACHINE\\SOFTWARE\\LLKJ\\Temp\\KeyChange\\"");"&_ VbCr&" SHL.RegDelete(""HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\KeyBoard Layout\\Scancode Map"");"&VbCr&" document.location.reload()//刷新"&VbCr&" }"&VbCr&" catch(e)"&VbCr&" {"&_ VbCr&" alert(""所有键盘替换数据已被清空，谢谢使用本程序。"");"&VbCr&" document.location.reload()//刷新"&VbCr&" }"&VbCr&"}"&VbCr&"function okkey(yname)//全部清空，删除所有按键替换!"&_ VbCr&"{"&VbCr&" try"&VbCr&" {"&VbCr&" oExec = SHL.Exec('wscript.exe """&Replace(InsPath&"\KeyCExe.vbs","\","\\")&""""&Chr(39)&");"&_ VbCr&" document.location.reload()//刷新"&VbCr&" }"&VbCr&" catch(e)"&VbCr&" {"&VbCr&" alert(""请求没有被完成，可能是对象没有创建或找不到需要的系统文件。"");"&VbCr&" document.location.reload()//刷新"&_ VbCr&" }"&VbCr&"}"&VbCr&"function exkey(yname)//修补漏洞，安全退出!"&VbCr&"{"&VbCr&" SHL.RegWrite(""HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings\\Zones\\3\\1201"",3,""REG_DWORD"");"&VbCr&" window.close();"&VbCr&"}"&"</SCRIPT>"&VbCr WScript.Sleep 300 If WshSHell.AppActivate("http:// - 键盘按键替换 - By baomaboy - QQ:25926183") = False Then WshSHell.AppActivate("http:// - 键盘按键替换 - By baomaboy - QQ:25926183") WshShell.SendKeys "% R" end if End If Set WshSHell = Nothing Set FSO = Nothing Set Dic = Nothing WScript.Quit(0) Sub InsTall() On Error Resume Next:Dim oStream,oXML:Set oStream = Createobject("Adodb.Stream"):Set oXML = Createobject("Microsoft.XMLDOM") B64str="JycnS2V5Q2hhbmdlIGJ5IGJhb21hYm95DQpEaW0gV3NoU0hlbGwsRlNPDQpPbiBFcnJvciBSZXN1bWUgTmV4dA0KU2V0IFdzaFNIZWxsID0gV1NjcmlwdC5DcmVhdGVPYmplY3QoIldTY3JpcHQuU2hlbGwiKQ0KU2V0IEZTTyA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkZpbGVTeXN0ZW1PYmplY3QiKQ0KQ29uc3QgSEtFWV9MT0NBTF9NQUNISU5FID0gJkg4MDAwMDAwMg0KQ29uc3QgUkVHX1NaID0gMQ0Kc3RyQ29tcHV0ZXIgPSAiLiINClNldCBXc2hTaGVsbCA9IFdTY3JpcHQuQ3JlYXRlT2JqZWN0KCJXU2NyaXB0LlNoZWxsIikNClNldCBvUmVnPUdldE9iamVjdCgid2lubWdtdHM6e2ltcGVyc29uYXRpb25MZXZlbD1pbXBlcnNvbmF0ZX0hXFwiICYgc3RyQ29tcHV0ZXIgJiAiXHJvb3RcZGVmYXVsdDpTdGRSZWdQcm92IikNCnN0cktleVJvb3QgPSBIS0VZX0xPQ0FMX01BQ0hJTkUNCnN0cktleVBhdGggPSAiU09GVFdBUkVcTExLSlxUZW1wXEtleUNoYW5nZSINCm9SZWcuRW51bVZhbHVlcyBzdHJLZXlSb290LCBzdHJLZXlQYXRoLCBhcnJWYWx1ZU5hbWVzLCBhcnJWYWx1ZVR5cGVzDQpYWlN0ciA9ICIiDQplcnIuQ2xlYXINCmlmIFVCb3VuZChhcnJWYWx1ZU5hbWVzKSBNb2QgMiA9IDAgdGhlbg0KTlVzID0gVUJvdW5kKGFyclZhbHVlTmFtZXMpIC0gMQ0KZWxzZQ0KTlVzID1VQm91bmQoYXJyVmFsdWVOYW1lcykNCmVuZCBpZg0KaWYgZXJyLm51bWJlciA8PiAwIHRoZW4NCldzaFNIZWxsLnBvcHVwIsTju7nDu9PQ1/bIzrrOvPzWtczmu7ujoSIsNSwitO3O87GouOYgLSCwtLz8zOa7uyAtIGJ5IGJhb21hYm95IiwwKzQ4DQplbHNlaWYgVUJvdW5kKGFyclZhbHVlTmFtZXMpID4gMSB0aGVuDQpXc2hTSGVsbC5wb3B1cCK8/MXMsLS8/Mzmu7vJ6NbDs8m5piyy6b+00Ke5+9Do0qrW2Mb0o6EiLDUsIrC0vPzM5ru7IC0gYnkgYmFvbWFib3kiLDArNjQNCmVuZCBpZg0KRm9yIGk9MCBUbyBOVXMNCklmIExlbihhcnJWYWx1ZU5hbWVzKGkpKSA+IDAgVGhlbg0Kb1JlZy5HZXRTdHJpbmdWYWx1ZSBzdHJLZXlSb290LHN0cktleVBhdGgsYXJyVmFsdWVOYW1lcyhpKSxzdHJWYWx1ZQ0KWFpTdHIgPSBYWlN0ciZMZWZ0KHN0clZhbHVlLDIpJiIsIiZSaWdodChzdHJWYWx1ZSwyKSYiLCINCmVuZCBpZg0KTmV4dA0KSFN0ciA9ICIiIlNjYW5jb2RlIE1hcCIiPWhleDowMCwwMCwwMCwwMCwwMCwwMCwwMCwwMCwiDQpaU3RyID0gUmlnaHQoIjAiJihOVXMgKyAxKS8yLDIpJiIsMDAsMDAsMDAsIg0KV1N0ciA9IFhaU3RyJiIwMCwwMCwwMCwwMCINClNTU3RyID1IU3RyJlpTdHImV1N0cg0KU2V0IE5ld0ZpbGUgPSBGU08uQ3JlYXRlVGV4dEZpbGUoRlNPLkdldFNwZWNpYWxGb2xkZXIoMikmIlxLZXlDVGVtLnJlZyIsIFRydWUpDQpOZXdGaWxlLldyaXRlTGluZSgiUkVHRURJVDQiKQ0KTmV3RmlsZS5Xcml0ZUxpbmUoIiIpDQpOZXdGaWxlLldyaXRlTGluZSgiW0hLRVlfTE9DQUxfTUFDSElORVxTWVNURU1cQ3VycmVudENvbnRyb2xTZXRcQ29udHJvbFxLZXlib2FyZCBMYXlvdXRdIikNCk5ld0ZpbGUuV3JpdGVMaW5lKFNTU3RyKQ0KTmV3RmlsZS5DbG9zZQ0KV3NoU0hlbGwuUnVuICgicmVnZWRpdC5leGUgL3MgIiZGU08uR2V0U3BlY2lhbEZvbGRlcigyKSYiXEtleUNUZW0ucmVnIiksIHZiSGlkZQ0KU2V0IFdzaFNIZWxsID0gTm90aGluZw0KU2V0IEZTTyA9IE5vdGhpbmcNCldTY3JpcHQuUXVpdA==" Set oElement = oXML.CreateElement("oTmpElement") oElement.DataType = "bin.Base64" oElement.NodeTypedValue = B64str With oStream .Type = 1 .Mode = 3 .Open .Write oElement.NodeTypedValue .SaveToFile InsPath&"\KeyCExe.vbs" End With oStream.Close Set oStream = Nothing Set oXML = Nothing Set oElement = Nothing End Sub