快捷方式用Win+R命令實現快速啟動

本文轉載自查看原文 2021-11-20 20:34 831 快速啟動/ 快捷方式用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