『第 6 楼』:
使用 LLM 解释/回答一下
1.安装.vbs
On Error Resume Next
strCurrentPath = CreateObject("Scripting.FileSystemObject") _
.GetFile(WScript.ScriptFullName).ParentFolder
Set objShell = CreateObject("WScript.Shell")
strPath = objShell.SpecialFolders("SendTo")
'安装快捷方式部分
strPathQuick = strPath & "\快捷方式"
CreateDir strPathQuick
strPrefix = "填加到 "
strSourceFile = strCurrentPath & "\快捷方式.vbs"
CreateLink strPathQuick,strPrefix,strSourceFile,"快速启动",165
CreateLink strPathQuick,strPrefix,strSourceFile,"开始菜单",39
CreateLink strPathQuick,strPrefix,strSourceFile,"收藏夹",43
CreateLink strPathQuick,strPrefix,strSourceFile,"其他文件夹",4
'安装打开文件夹部分
strPathOpen = strPath & "\打开目录"
CreateDir strPathOpen
strPrefix = "打开 "
strSourceFile = strCurrentPath & "\打开文件夹.vbs"
CreateLink strPathOpen,strPrefix,strSourceFile,"控制面板",21
CreateLink strPathOpen,strPrefix,strSourceFile,"我的文档",126
CreateLink strPathOpen,strPrefix,strSourceFile,"收藏夹",43
CreateLink strPathOpen,strPrefix,strSourceFile,"启动",130
CreateLink strPathOpen,strPrefix,strSourceFile,"最近打开的文档",20
CreateLink strPathOpen,strPrefix,strSourceFile,"发送到",137
CreateLink strPathOpen,strPrefix,strSourceFile,"网上邻居",17
CreateLink strPathOpen,strPrefix,strSourceFile,"Windows",38
CreateLink strPathOpen,strPrefix,strSourceFile,"System32",27
CreateLink strPathOpen,strPrefix,strSourceFile,"程序",36
CreateLink strPathOpen,strPrefix,strSourceFile,"当前用户根目录",170
CreateLink strPathOpen,"",strSourceFile,"添加当前目录",4
CreateLink strPathOpen,"",strSourceFile,"移除当前目录",4
Function CreateDir(strPath)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(strPath)
CreateDir = f.Path
End Function
Sub CreateLink(strPath,strPrefix,strSourceFile,strArg,intIconNumber)
strFullName = strPath & "\" & strPrefix & strArg & ".lnk"
strArg = Chr(34) & strSourceFile & Chr(34) & Space(1) & strArg
With CreateObject("WScript.Shell").CreateShortcut(strFullName) '快捷方式完整路径
.TargetPath = WScript.FullName '源文件,这里应该是wscript.exe
.Arguments = strArg '参数
' .WindowStyle = 1 '运行方式
' .Hotkey = "" '快捷键
.IconLocation = "shell32.dll," & intIconNumber '图标
' .Description = "" '备注
' .WorkingDirectory = "" '起始目录
.Save
End With
End Sub
2.打开文件夹.vbs
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
arrArgs = Array("IE","所有程序","控制面板","打印机和传真", _
"我的文档","收藏夹","启动","最近打开的文档","发送到", _
"回收站","开始菜单","暂缺","我的音乐","我的视频", _
"暂缺","桌面","我的电脑","网上邻居","NetHood", _
"字体","Templates","AllUser开始菜单","AllUser所有程序",_
"AllUser启动","AllUser桌面","MY_AppData","PrintHood", _
"MY_AppData2","暂缺","暂缺","AllUser收藏夹","IE缓存", _
"Cookies","历史记录","AllUserAppData","Windows","System32", _
"程序","我的图片","当前用户根目录","公共组件","暂缺",_
"暂缺","暂缺","AllUserTemplates","共享文档", _
"AllUserManagement","管理工具","网络连接","暂缺","暂缺", _
"暂缺","AllUserMusic","AllUserPictures","AllUserVideos", _
"桌面主题","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(objArgs(0)) Then
intNumber = i + 1
End If
Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
If Err.Number <> 0 Then
If UCase(objArgs(0)) = UCase("添加当前目录") Then
AddCurrentFolder(objArgs(1))
ElseIf UCase(objArgs(0)) = UCase("移除当前目录") Then
DelCurrentFolder(objArgs(1))
Else
objShell.Open objArgs(0)
'WScript.Quit
End If
End If
objShell.Open objFolderItem.Path
Sub AddCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
strName = objDir.Name
Else
strPath = objFile.ParentFolder.Path
strName = objFile.ParentFolder.Name
End If
strFullName = strSendTo & "\打开目录\打开 " & strName & ".lnk"
With CreateObject("WScript.Shell").CreateShortcut(strFullName)
.TargetPath = WScript.FullName
.Arguments = Chr(34) & WScript.ScriptFullName & Chr(34) & _
Space(1) & Chr(34) & strPath & Chr(34)
.IconLocation = "shell32.dll,4"
.Save
End With
End Sub
Sub DelCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
Else
strPath = objFile.ParentFolder.Path
End If
Set objFolder = fso.GetFolder(strSendTo & "\打开目录")
For Each i In objFolder.Files
Set objLink = objShell.CreateShortcut(i)
If objLink.Arguments = Chr(34) & WScript.ScriptFullName & _
Chr(34) & Space(1) & Chr(34) & strPath & Chr(34) Then
fso.DeleteFile i
End If
Next
End Sub
3.快捷方式.vbs
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
intBeganArg = 1
strPath = GetSystemFolder(objArgs(0))
If Len(Trim(strPath)) = 0 Then
If objArgs(0) = "快速启动" Then
strPath = GetQuickLaunch()
Else
intBeganArg = 0
strPath = GetDirectory()
End If
End If
For i = intBeganArg To objArgs.Count - 1
CreateLink strPath,objArgs(i)
Next
'************************************************************************************
'创建快捷方式
'************************************************************************************
Sub CreateLink(strPath,strFile)
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strFile)
If Err.Number <> 0 Then
Set f = fso.GetFile(strFile)
strLinkName = Mid(f.Name,1,InStrRev(f.Name,".")-1)
Else
strLinkName = f.Name
End If
If Len(Trim(strLinkName)) = 0 Or Len(Trim(strFile)) = 0 Then Exit Sub
Set objShell = CreateObject("WScript.Shell")
With objShell.CreateShortcut(strPath &"\" & strLinkName & ".lnk") '存放目录及文件名
.TargetPath = strFile '指向的可执行文件
' .WindowStyle = 1 '运行方式
' .Hotkey = "" '快捷键
' .IconLocation = "c:\xxx\xxx, 0" '图标
' .Description = "" '备注
' .WorkingDirectory = "" '起始目录
.Save
End With
End Sub
'************************************************************************************
'弹出窗口选择目录
'************************************************************************************
Function GetDirectory()
Const MY_COMPUTER = &H10
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(0, "选择文件夹:", 0, strPath)
If objFolder Is Nothing Then
WScript.Quit
End If
Set objFolderItem = objFolder.Self
GetDirectory = objFolderItem.Path
End Function
'************************************************************************************
'获得快速启动的路径
'************************************************************************************
Function GetQuickLaunch()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(40)
Set objFolderItem = objFolder.Self
GetQuickLaunch = objFolderItem.Path
GetQuickLaunch = GetQuickLaunch & _
"\Application Data\Microsoft\Internet Explorer\Quick Launch"
' Set objNetwork = CreateObject("Wscript.Network")
' strUserName = objNetwork.UserName
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set f = fso.GetFolder(objShell.SpecialFolders(Favorites))
' GetQuickLaunch = f.ParentFolder.ParentFolder & "\" &strUserName & _
' "\Application Data\Microsoft\Internet Explorer\Quick Launch"
End Function
'************************************************************************************
'获得系统文件夹
'************************************************************************************
Function GetSystemFolder(str)
arrArgs = Array("IE","所有程序","控制面板","打印机和传真", _
"我的文档","收藏夹","启动","最近打开的文档","发送到", _
"回收站","开始菜单","暂缺","我的音乐","我的视频", _
"暂缺","桌面","我的电脑","网上邻居","NetHood", _
"字体","Templates","AllUser开始菜单","AllUser所有程序",_
"AllUser启动","AllUser桌面","MY_AppData","PrintHood", _
"MY_AppData2","暂缺","暂缺","AllUser收藏夹","IE缓存", _
"Cookies","历史记录","AllUserAppData","Windows","System32", _
"程序","我的图片","当前用户根目录","公共组件","暂缺",_
"暂缺","暂缺","AllUserTemplates","共享文档", _
"AllUserManagement","管理工具","网络连接","暂缺","暂缺", _
"暂缺","AllUserMusic","AllUserPictures","AllUserVideos", _
"桌面主题","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(str) Then
intNumber = i + 1
End If
Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
GetSystemFolder = objFolderItem.Path
End Function
注意:脚本中有小bug,不过不影响使用。等到有了好的创意后再重写代码。
### 1. Install.vbs
```code
On Error Resume Next
strCurrentPath = CreateObject("Scripting.FileSystemObject") _
.GetFile(WScript.ScriptFullName).ParentFolder
Set objShell = CreateObject("WScript.Shell")
strPath = objShell.SpecialFolders("SendTo")
'Part for installing shortcuts
strPathQuick = strPath & "\Shortcuts"
CreateDir strPathQuick
strPrefix = "Add to "
strSourceFile = strCurrentPath & "\Shortcut.vbs"
CreateLink strPathQuick,strPrefix,strSourceFile,"Quick Launch",165
CreateLink strPathQuick,strPrefix,strSourceFile,"Start Menu",39
CreateLink strPathQuick,strPrefix,strSourceFile,"Favorites",43
CreateLink strPathQuick,strPrefix,strSourceFile,"Other Folders",4
'Part for installing open folder
strPathOpen = strPath & "\Open Directory"
CreateDir strPathOpen
strPrefix = "Open "
strSourceFile = strCurrentPath & "\Open Folder.vbs"
CreateLink strPathOpen,strPrefix,strSourceFile,"Control Panel",21
CreateLink strPathOpen,strPrefix,strSourceFile,"My Documents",126
CreateLink strPathOpen,strPrefix,strSourceFile,"Favorites",43
CreateLink strPathOpen,strPrefix,strSourceFile,"Startup",130
CreateLink strPathOpen,strPrefix,strSourceFile,"Recently Opened Documents",20
CreateLink strPathOpen,strPrefix,strSourceFile,"Send To",137
CreateLink strPathOpen,strPrefix,strSourceFile,"Network Neighborhood",17
CreateLink strPathOpen,strPrefix,strSourceFile,"Windows",38
CreateLink strPathOpen,strPrefix,strSourceFile,"System32",27
CreateLink strPathOpen,strPrefix,strSourceFile,"Programs",36
CreateLink strPathOpen,strPrefix,strSourceFile,"Current User Root Directory",170
CreateLink strPathOpen,"",strSourceFile,"Add Current Directory",4
CreateLink strPathOpen,"",strSourceFile,"Remove Current Directory",4
Function CreateDir(strPath)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(strPath)
CreateDir = f.Path
End Function
Sub CreateLink(strPath,strPrefix,strSourceFile,strArg,intIconNumber)
strFullName = strPath & "\" & strPrefix & strArg & ".lnk"
strArg = Chr(34) & strSourceFile & Chr(34) & Space(1) & strArg
With CreateObject("WScript.Shell").CreateShortcut(strFullName) 'Full path of the shortcut
.TargetPath = WScript.FullName 'Source file, here should be wscript.exe
.Arguments = strArg 'Arguments
' .WindowStyle = 1 'Run style
' .Hotkey = "" 'Hotkey
.IconLocation = "shell32.dll," & intIconNumber 'Icon
' .Description = "" 'Remark
' .WorkingDirectory = "" 'Start directory
.Save
End With
End Sub
```
### 2. Open Folder.vbs
```code
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
arrArgs = Array("IE","All Programs","Control Panel","Printers and Faxes", _
"My Documents","Favorites","Startup","Recently Opened Documents","Send To", _
"Recycle Bin","Start Menu","Temporarily Missing","My Music","My Videos", _
"Temporarily Missing","Desktop","My Computer","Network Neighborhood","NetHood", _
"Fonts","Templates","All User Start Menu","All User All Programs",_
"All User Startup","All User Desktop","MY_AppData","PrintHood", _
"MY_AppData2","Temporarily Missing","Temporarily Missing","All User Favorites","IE Cache", _
"Cookies","History","All User AppData","Windows","System32", _
"Programs","My Pictures","Current User Root Directory","Common Components","Temporarily Missing",_
"Temporarily Missing","Temporarily Missing","All User Templates","Shared Documents", _
"All User Management","Administrative Tools","Network Connections","Temporarily Missing","Temporarily Missing", _
"Temporarily Missing","All User Music","All User Pictures","All User Videos", _
"Desktop Themes","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(objArgs(0)) Then
intNumber = i + 1
End If
Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
If Err.Number <> 0 Then
If UCase(objArgs(0)) = UCase("Add Current Directory") Then
AddCurrentFolder(objArgs(1))
ElseIf UCase(objArgs(0)) = UCase("Remove Current Directory") Then
DelCurrentFolder(objArgs(1))
Else
objShell.Open objArgs(0)
'WScript.Quit
End If
End If
objShell.Open objFolderItem.Path
Sub AddCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
strName = objDir.Name
Else
strPath = objFile.ParentFolder.Path
strName = objFile.ParentFolder.Name
End If
strFullName = strSendTo & "\Open Directory\Open " & strName & ".lnk"
With CreateObject("WScript.Shell").CreateShortcut(strFullName)
.TargetPath = WScript.FullName
.Arguments = Chr(34) & WScript.ScriptFullName & Chr(34) & _
Space(1) & Chr(34) & strPath & Chr(34)
.IconLocation = "shell32.dll,4"
.Save
End With
End Sub
Sub DelCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
Else
strPath = objFile.ParentFolder.Path
End If
Set objFolder = fso.GetFolder(strSendTo & "\Open Directory")
For Each i In objFolder.Files
Set objLink = objShell.CreateShortcut(i)
If objLink.Arguments = Chr(34) & WScript.ScriptFullName & _
Chr(34) & Space(1) & Chr(34) & strPath & Chr(34) Then
fso.DeleteFile i
End If
Next
End Sub
```
### 3. Shortcut.vbs
```code
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
intBeganArg = 1
strPath = GetSystemFolder(objArgs(0))
If Len(Trim(strPath)) = 0 Then
If objArgs(0) = "Quick Launch" Then
strPath = GetQuickLaunch()
Else
intBeganArg = 0
strPath = GetDirectory()
End If
End If
For i = intBeganArg To objArgs.Count - 1
CreateLink strPath,objArgs(i)
Next
'************************************************************************************
'Create shortcut
'************************************************************************************
Sub CreateLink(strPath,strFile)
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strFile)
If Err.Number <> 0 Then
Set f = fso.GetFile(strFile)
strLinkName = Mid(f.Name,1,InStrRev(f.Name,".")-1)
Else
strLinkName = f.Name
End If
If Len(Trim(strLinkName)) = 0 Or Len(Trim(strFile)) = 0 Then Exit Sub
Set objShell = CreateObject("WScript.Shell")
With objShell.CreateShortcut(strPath &"\" & strLinkName & ".lnk") 'Storage directory and file name
.TargetPath = strFile 'Executable file pointed to
' .WindowStyle = 1 'Run style
' .Hotkey = "" 'Hotkey
' .IconLocation = "c:\xxx\xxx, 0" 'Icon
' .Description = "" 'Remark
' .WorkingDirectory = "" 'Start directory
.Save
End With
End Sub
'************************************************************************************
'Pop up window to select directory
'************************************************************************************
Function GetDirectory()
Const MY_COMPUTER = &H10
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(0, "Select Folder:", 0, strPath)
If objFolder Is Nothing Then
WScript.Quit
End If
Set objFolderItem = objFolder.Self
GetDirectory = objFolderItem.Path
End Function
'************************************************************************************
'Get the path of quick launch
'************************************************************************************
Function GetQuickLaunch()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(40)
Set objFolderItem = objFolder.Self
GetQuickLaunch = objFolderItem.Path
GetQuickLaunch = GetQuickLaunch & _
"\Application Data\Microsoft\Internet Explorer\Quick Launch"
' Set objNetwork = CreateObject("Wscript.Network")
' strUserName = objNetwork.UserName
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set f = fso.GetFolder(objShell.SpecialFolders(Favorites))
' GetQuickLaunch = f.ParentFolder.ParentFolder & "\" &strUserName & _
' "\Application Data\Microsoft\Internet Explorer\Quick Launch"
End Function
'************************************************************************************
'Get system folder
'************************************************************************************
Function GetSystemFolder(str)
arrArgs = Array("IE","All Programs","Control Panel","Printers and Faxes", _
"My Documents","Favorites","Startup","Recently Opened Documents","Send To", _
"Recycle Bin","Start Menu","Temporarily Missing","My Music","My Videos", _
"Temporarily Missing","Desktop","My Computer","Network Neighborhood","NetHood", _
"Fonts","Templates","All User Start Menu","All User All Programs",_
"All User Startup","All User Desktop","MY_AppData","PrintHood", _
"MY_AppData2","Temporarily Missing","Temporarily Missing","All User Favorites","IE Cache", _
"Cookies","History","All User AppData","Windows","System32", _
"Programs","My Pictures","Current User Root Directory","Common Components","Temporarily Missing",_
"Temporarily Missing","Temporarily Missing","All User Templates","Shared Documents", _
"All User Management","Administrative Tools","Network Connections","Temporarily Missing","Temporarily Missing", _
"Temporarily Missing","All User Music","All User Pictures","All User Videos", _
"Desktop Themes","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(str) Then
intNumber = i + 1
End If
Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
GetSystemFolder = objFolderItem.Path
End Function
```
Note: There are minor bugs in the script, but they do not affect usage. The code will be rewritten when a good idea is available.
|