1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
|
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'COPYRIGHT NOTICE: This script and all material at Winhelponline.com are registered with...
'"The UK Copyright Service". No part of the Website or script can be distributed or ...
'republished without the author's written permission.
'Copyright © 2008 by Ramesh Srinivasan. All rights reserved.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'SendtoQL.vbs - Adds "Quick Launch (create shortcut)" option to the "Send To" menu.
'Sends a file (as shortcut) to the Quick Launch folder.
'For Windows XP and Windows Vista systems.
'Homepage: http://www.winhelponline.com/blog/
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'Version History:
'(ver 1.0) June 16, 2008
'(ver 1.1) July 20, 2008 (Add support for directories)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strQLFolder = "D:\0Bin\En cours"
strSendTo = WshShell.SpecialFolders("SendTo") & "\"
strShortcutFileName = strSendTo & "\" & "Quick Launch (create shortcut)" & ".lnk"
strMsg = "Completed!" & Chr(10) & Chr(10) & "SendToQuickLaunch.vbs - © 2008 Ramesh Srinivasan" & Chr(10) & "Visit us at http://www.winhelponline.com/blog/"
Set objArgs = WScript.Arguments
If WScript.Arguments.Count > 0 Then
For I = 0 to objArgs.Count - 1
If objFSO.FileExists(objArgs(I)) then
Set objFile = objFSO.GetFile(objArgs(I))
strFileName = objFSO.GetAbsolutePathName(objArgs(I))
strBaseName = objFSO.GetBaseName(objArgs(I))
strFileext = lcase(objFSO.GetExtensionName(objArgs(I)))
SendtoQL strFileName,strFileext,strBaseName
End If
If objFSO.FolderExists(objArgs(I)) Then
strFolderName = objFSO.GetAbsolutePathName(objArgs(I))
strBaseName = objFSO.GetBaseName(objArgs(I))
strFileext = "directory"
SendtoQL strFolderName,strFileext,strBaseName
End If
Next
Else
rtn= Trim(UCase(InputBox ("Type INSTALL to add the QUICK LAUNCH (SHORTCUT) to the Send To menu, or type UNINSTALL if you wish to remove the QUICK LAUNCH (SHORTCUT) option.", "Configuring SendToQuickLaunch.vbs...", "INSTALL")))
If rtn = "INSTALL" Then RunInstall
If rtn = "UNINSTALL" Then RunUninstall
End If
Sub SendtoQL(fname,fextn,basename)
Select Case fextn
Case "lnk"
objFSO.CopyFile fname, strQLFolder
Case "url"
objFSO.CopyFile fname, strQLFolder
Case Else
Set oShellLink = WshShell.CreateShortcut(strQLFolder & "\" & basename & ".lnk")
oShellLink.TargetPath = fname
oShellLink.Save
End Select
End Sub
Sub RunInstall
Set oShellLink = WshShell.CreateShortcut(strShortcutFileName)
oShellLink.TargetPath = WScript.ScriptFullName
oShellLink.IconLocation = "shell32.dll,39"
oShellLink.Save
MsgBox strMsg, vbokonly,"Installed"
End Sub
Sub RunUninstall
if objFSO.fileexists(strShortcutFileName) then objFSO.deletefile(strShortcutFileName)
MsgBox strMsg, vbokonly,"Uninstalled"
End Sub |
Partager