快捷方式用Win+R命令实现快速启动
- 在 C盘的文档里新建文件夹 名字为 QuickOpen 用于储存快捷方式
- 新建一个文本文件,在里面粘贴一下代码
' 脚本说明 https://blog.csdn.net/milaoshu1020/article/details/80711574
' 脚本版本 v1.3
' [更新历史]
' 2020.02.06 v1.3 重构了脚本代码,增加设置安装目录的功能;
' 2019.06.03 v1.2 增加了安装时自动提权的代码;
' 2018.12.29 v1.1 新增加了对系统变量PATHEXT的注册,效果是自定义命令可以在命令行中使用(不用加扩展名".LNK");
' 2018.06.18 v1.0 初始版本,实现了基本功能
Option Explicit
Dim fso
set fso = createobject("scripting.filesystemobject")
Dim shell
set shell = createobject("wscript.shell")
Dim winr_mgr
Set winr_mgr = New winr_manager
winr_mgr.run
Class WinR_Manager
Public InstallPath
Public Property Get DefaultInstallPath()
defaultinstallpath = "C:\Users\账户名\Documents\QuickOpen\lsq\快捷启动Win+R命令.vbs"
End Property
Public Property Get InstallDir()
installdir = fso.getparentfoldername(installpath)
End Property
Public Property Get InstallDirName()
installdirname = fso.getfolder(installdir).name
End Property
Public Property Get InstallBase()
installbase = fso.getbasename(installpath)
End Property
Public Sub Run()
If wscript.arguments.count = 0 Then
Dim sh
Set sh = createobject("shell.application")
sh.shellexecute wscript.fullname,"""" & wscript.scriptfullname & """ -install",,"runas"
Else
If wscript.arguments(0) = "-install" Then
installpath = defaultinstallpath
Dim strInput
strinput = inputbox("请输入安装路径:",installbase,installdir)
If strinput = "" Then
wscript.quit
Else
installpath = fso.buildpath(strinput,fso.getfilename(defaultinstallpath))
End If
copyscriptfile
addtosystemenvironment
createinstdirlnk
createsendtolnk
msgbox "'" & installpath & "'安装完成,你现在可以:" & vbcrlf & _
"* 使用右键菜单中的'发送到'快捷启动Win+R命令." & vbcrlf & _
"* Win+R,输入'" & installdirname & "'以打开命令(快捷方式)列表目录." & vbcrlf & _
"* Win+R,输入'命令(快捷方式名称)'以打开相应的程序或者目录."
Else
prompttoaddlnk
End If
End If
End Sub
Sub PromptToAddLnk()
Dim i
For i = 0 To wscript.arguments.count - 1
Dim targetpath
targetpath = wscript.arguments(i)
Dim lnkname
lnkname = fso.getbasename(targetpath)
Dim lnkpath
do
lnkname = inputbox("请输入'" & fso.getfilename(targetpath) & "'的快捷方式名称(用于运行命令):",,lnkname)
lnkpath = fso.buildpath(fso.getparentfoldername(wscript.scriptfullname),lnkname & ".lnk")
If Not fso.fileexists(lnkpath) Or lnkname = "" Then
Exit Do
End If
Select Case msgbox("'" & lnkpath & "'文件已存在,是否覆盖?",vbexclamation Or vbyesnocancel)
Case vbyes
Exit Do
Case vbcancel
lnkname = ""
Exit Do
End Select
Loop While True
If lnkname <> "" Then
Dim shortcut
Set shortcut = shell.createshortcut(lnkpath)
shortcut.targetpath = targetpath
shortcut.save
msgbox "正在创建'" & lnkpath & "' ... 完成!"
End If
Next
End Sub
Sub CopyScriptFile()
If StrComp(installpath,wscript.scriptfullname,1) = 0 Then
Exit Sub
End If
If Not fso.folderexists(installdir) Then
fso.createfolder(installdir)
End If
fso.copyfile wscript.scriptfullname,installpath,true
End Sub
Sub AddToSystemEnvironment()
Dim pathname
pathname = installdir & ";"
Dim sysenv
Set sysenv = shell.environment("System")
If InStr(1,sysenv("PATH"),pathname,1) = 0 Then
sysenv("PATH") = pathname & sysenv("PATH")
End If
Dim extname
extname = ";.LNK"
If InStr(1,sysenv("PATHEXT"),extname,1) = 0 Then
sysenv("PATHEXT") = sysenv("PATHEXT") & extname
End If
End Sub
Sub CreateSendToLnk()
Dim sendtodir
sendtodir = shell.specialfolders("SendTo")
Dim lnkpath
lnkpath = fso.buildpath(sendtodir,installbase & ".lnk")
Dim shortcut
Set shortcut = shell.createshortcut(lnkpath)
shortcut.targetpath = installpath
shortcut.save
End Sub
Sub CreateInstDirLnk()
Dim lnkpath
lnkpath = fso.buildpath(installdir,installdirname & ".lnk")
If Not fso.fileexists(lnkpath) Then
Dim shortcut
Set shortcut = shell.createshortcut(lnkpath)
shortcut.targetpath = installdir
shortcut.save
End If
End Sub
End Class
注意修改安装的路径
- 另存为ANSI的编码格式,并将后缀改为 .vbs 格式
- 双击运行,路径默认即可
添加快捷启动:右键发送到 快捷启动Win+R命令
- 怎样快速启动
按 Win+R键,在输入框里填写添加快捷启动的指令,例如 qq
- 怎么查看有哪些快捷启动的命令
按 Win+R键,在输入框里填写添加快捷启动的指令 lsq
参考链接:https://so.csdn.net/so/search?q=快捷&t=blog&u=milaoshu1020