写个设置命令的VBS脚本工具
首页 > 技术交流   作者:孟关伦  2015年5月23日 21:53 星期六  热度:1526°  字号:   评论:0 条
时间:2015-5-23 21:53   热度:1526°  评论:0 条 

'将以下代码复制并保存为"系统命令.VBS",并运行安装。
'安装成功后,可通过在程序、文件或文件夹上点右键->发送到->系统命令来设置一个命令,然后在运行中就可以输入该命令打开文件了。
'脚本运行一次后在右键菜单中增加从这里运行CMD的快捷方式,还增加查找目标文件快捷方式

'On Error Resume Next
If (lcase(right(wscript.fullname,11))<>"wscript.exe") then
set objShell=createObject("wscript.shell")
objShell.Run("Wscript //nologo "&chr(34)&wscript.scriptfullname&chr(34))
Wscript.Quit
end if

Set pCmd=CreateObject("WScript.Shell")
Set pFso=CreateObject("Scripting.FileSystemObject")
Set pShell = CreateObject("Shell.Application")
Set pSysEnv = CreateObject("WScript.Shell").Environment("system")
strComputer = "."  
Set pWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 

Function LGetPath(pFile)
    iLastSepPos = InstrRev(pFile, "\", -1, 1)
    If iLastSepPos <= 0 Then
        LGetPath=""
        Exit Function
    Else
        LGetPath = Left(pFile, iLastSepPos-1)
    End If
End Function

Function GetLnkTarget(linkPath)
    linkPath=Replace(linkPath, "\", "\\") 
    Set pFiles = pWMIService.ExecQuery("Select * From Win32_ShortcutFile WHERE Name = " & "'" & linkPath & "'")   
    For Each pFile in pFiles
        GetLnkTarget=pFile.Target
        Exit For
    Next
End Function

Function ListSysCmd(pFileName)
    SysCmdPath=pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd")
    Set pFolder = pFso.GetFolder(SysCmdPath)
    Set pFile = pFso.OpenTextFile(pFileName, 2, True)

    For Each file in pFolder.Files
        linkPath=SysCmdPath & "\" & file.name
        IF UCASE(Right(file.name, 4))=".LNK" Then
            Set lnkFiles = pWMIService.ExecQuery("Select * From Win32_ShortcutFile WHERE Name = " & "'" & Replace(linkPath, "\", "\\")  & "'")   
            For Each lnkFile in lnkFiles
                pFile.WriteLine(linkPath & "                " & lnkFile.Target)
            Next
        Else
            pFile.WriteLine linkPath   
        End IF
    Next
End Function

Function GetConfigPath
    Set pFolder = pShell.BrowseForFolder(0, "请选择一个目录:", 0, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")
    If pFolder Is Nothing Then
        Wscript.Quit
    End If
    Set pFolderItem = pFolder.Self
    GetConfigPath = pFolderItem.Path
End Function

Sub SetEnv(pPath, pValue)
    If pValue="" Then
        pSysEnv.Remove(pPath)
    Else
        pSysEnv(pPath) = pValue
    End IF
End Sub

Function GetEnv(pPath)
    GetEnv = pSysEnv(pPath)
End Function

'判断一个字符串是否匹配一个正则表达式
'   ^\w+[@]\w+[.]\w+$       E-Mail地址
'   ^[0-9-]+$               数字
Function IsMatch(Str, Patrn)
  Set r = new RegExp
  r.Pattern = Patrn
  IsMatch = r.test(Str)
End Function

Sub AddNewCmd(pShortCutName, pTargetPath, pCmdLocation)
IF pShortCutName<>"" Then
  LinkDir = pCmdLocation
  Set pCmdLink = pCmd.CreateShortcut(LinkDir & "\" & pShortCutName & ".lnk")
  pCmdLink.TargetPath = pTargetPath
  pCmdLink.WindowStyle = 1
  pCmdLink.Hotkey = ""
  pCmdLink.IconLocation = "%systemroot%\system32\shell32.dll,146"
  pCmdLink.Description = "Shortcut Created At " & Date() & " " & Time()
  pCmdLink.WorkingDirectory = LGetPath(pTargetPath)
  pCmdLink.Save
End IF
End Sub

Set pArgs=Wscript.Arguments
If pArgs.Count = 0 Then  '无参运行,复制自身到SendTo文件夹。

MsgBox    "注意无参运行即执行安装过程!" & VBCRLF & _
                "安装过程包括以下操作:" & VBCRLF & VBCRLF & _
                 "1、在发送到目录中建立该脚本的快捷方式;" & VBCRLF & _
                 "2、完成安装后可通过发送到建立快捷方式;" & VBCRLF & _
                 "3、所有快捷命令可通过运行(WIN+R)执行。" & VBCRLF 
SysCmdPath = GetConfigPath
If SysCmdPath = "" Then WScript.Quit()

pCmd.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd", SysCmdPath, "REG_SZ"
'Path = pCmd.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Session Manager\Environment\Path")
Path = GetEnv("Path")

If Right(SysCmdPath, 1)="\" Then  SysCmdPath = Left(SysCmdPath, Len(SysCmdPath)-1)
SysCmdPathPattern ="(;)?(" & Replace(SysCmdPath, "\", "\\") & ")(\\)?(;|$)"
If Not IsMatch(Path, SysCmdPathPattern) Then
      Path = Path & ";" & SysCmdPath
      SetEnv "Path", Path
End If

thisFile = WScript.ScriptFullName
IF thisFile<>SysCmdPath & "\" & WScript.ScriptName Then
     pFso.CopyFile thisFile, SysCmdPath & "\"
     thisFile = SysCmdPath & "\" & WScript.ScriptName
End IF

AddNewCmd "N系统命令", thisFile, pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SendTo")
'在右键菜单中增加创建当前文件或文件夹的系统快捷命令的菜单项
pCmd.RegWrite "HKEY_CLASSES_ROOT\*\shell\G创建系统命令\command\", "WScript.exe " & thisFile & " ""%1""", "REG_SZ"
pCmd.RegWrite "HKEY_CLASSES_ROOT\Directory\shell\G创建系统命令\command\", "WScript.exe " & thisFile & " ""%1""", "REG_SZ"
'在右键菜单中增加在当前路径打开CMD窗口命令的菜单项
pCmd.RegWrite "HKEY_CLASSES_ROOT\*\shell\Q在此打开CMD\command\", "CMD /K PUSHD ""%1\\..""", "REG_SZ"
pCmd.RegWrite "HKEY_CLASSES_ROOT\Directory\shell\Q在此打开CMD\command\", "CMD /K PUSHD ""%1""", "REG_SZ"

'在右键菜单中增加在查找快捷方式位置的菜单项
pCmd.RegWrite "HKEY_CLASSES_ROOT\*\shell\W查找目标位置\command\", "WScript.exe " & thisFile & " S ""%1""", "REG_SZ"
pCmd.RegWrite "HKEY_CLASSES_ROOT\Directory\shell\W查找目标位置\command\", "WScript.exe " & thisFile & " S ""%1""", "REG_SZ"

AddNewCmd "Q", pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd"), pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd")
AddNewCmd "QC", thisFile, pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd")
MsgBox "安装成功!"
ElseIf pArgs.Count = 1 Then
    IF UCase(pArgs(0))="EDIT" Then         '只有一个参数且为Edit时, 打开此脚本进行编辑。
        pCmd.Run("Notepad.exe " & WScript.ScriptFullName)
        WScript.Quit()
    ElseIF UCase(pArgs(0))="LIST" Then    '只有一个参数且为List时, 列出所有已经建立的快捷方式和其对应的目标文件。
        ResultFile=pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd") & "\ListSysCmd.txt"
        ListSysCmd ResultFile
        pCmd.Run("Notepad.exe " & ResultFile)
        WScript.Quit()
    Else                                '只有一个参数时, 默认处理方式是建立传入的文件路径的快捷方式。
        pShortCutName=InputBox("请输入该快捷方式的名字:", "创建快捷命令...", "")
        IF pShortCutName="" Then WScript.Quit()
        AddNewCmd pShortCutName, pArgs(0), pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd")
    End IF
ElseIf pArgs.Count = 2 Then
    IF UCase(pArgs(0))="S" Then            '查找快捷方式目标文件位置
        '判断是否包括\,从右键菜单执行会直接传递目标地址,从快捷方式中需要组合快捷方式的地址。
        IF Instr(pArgs(1), "\") > 0 And Instr(pArgs(1), ".lnk") = 0 Then    '从右键菜单执行
            pCmd.Run("Explorer.exe /select, " & pArgs(1))
        Else                            '从命令行执行
            IF Instr(pArgs(1), "\") > 0 Then  '全路径.lnk路径
                linkPath=pArgs(1)
            Else
                linkPath=pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd") & "\" & pArgs(1) & ".lnk"
            End IF
            linkPath=Replace(linkPath, "\", "\\") 
            Set pFiles = pWMIService.ExecQuery("Select * From Win32_ShortcutFile WHERE Name = " & "'" & linkPath & "'")   
            For Each pFile in pFiles     
                pCmd.Run("Explorer.exe /n, /select, " & pFile.Target) 
            Next
        End IF
    Else
        'FileLocation, ShortCutName
        pShortCutName=pArgs(1)     
        AddNewCmd pShortCutName, pArgs(0), pCmd.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SysCmd")
    End IF
End If

 您阅读这篇文章共花了: 
二维码加载中...
本文作者:孟关伦      文章标题: 写个设置命令的VBS脚本工具
本文地址:http://www.mengguanlun99.com/post-113.html
版权声明:若无注明,本文皆为“孟关伦博客”原创,转载请保留文章出处。