Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for shortcut.vbs

(view source code of shortcut.vbs as plain text)

  1. 'Option Explicit
  2.  
  3. Dim blnAllUsers, blnDelete, blnDesktop, blnDelTree
  4. Dim intValidArgs
  5. Dim objFSO, objShortcut, wshShell
  6. Dim strArgs, strDesktop, strIcon, strName, strPath, strPrograms, strShortcut, strWorkingDir
  7.  
  8. blnAllUsers   = False
  9. blnDelete     = False
  10. blnDelTree    = False
  11. blnDesktop    = False
  12. strArgs       = ""
  13. strIcon       = ""
  14. strWorkingDir = ""
  15.  
  16. Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  17.  
  18. ' Options
  19. With WScript.Arguments.Named
  20. 	intValidArgs = 0
  21. 	If .Exists( "ARGS" ) And strArgs = "" Then
  22. 		strArgs      = Trim( .Item( "ARGS" ) )
  23. 		intValidArgs = intValidArgs + 1
  24. 		If strArgs = "" Then Syntax
  25. 	End If
  26. 	If .Exists( "DIR" ) And strWorkingDir = "" Then
  27. 		strWorkingDir = .Item( "DIR" )
  28. 		intValidArgs  = intValidArgs + 1
  29. 		If strWorkingDir = "" Then Syntax
  30. 		If Not objFSO.FolderExists( strWorkingDir ) Then Syntax
  31. 	End If
  32. 	If .Exists( "ICON" ) And strIcon = "" Then
  33. 		strIcon      = .Item( "ICON" )
  34. 		intValidArgs = intValidArgs + 1
  35. 		If strIcon = "" Then Syntax
  36. 	End If
  37. 	If .Exists( "ALL" ) And blnAllUsers = False Then
  38. 		blnAllUsers  = True
  39. 		intValidArgs = intValidArgs + 1
  40. 	End If
  41. 	If .Exists( "DEL" ) And blnDelete = False Then
  42. 		blnDelete    = True
  43. 		intValidArgs = intValidArgs + 1
  44. 	End If
  45. 	If .Exists( "DESK" ) And blnDesktop = False Then
  46. 		blnDesktop   = True
  47. 		intValidArgs = intValidArgs + 1
  48. 	End If
  49. 	If .Exists( "TREE" ) And blnDelTree = False Then
  50. 		blnDelTree   = True
  51. 		intValidArgs = intValidArgs + 1
  52. 	End If
  53. 	If intValidArgs <> .Count Then Syntax
  54. 	If blnDelTree And Not blnDelete Then Syntax
  55. End With
  56.  
  57. ' Name and target
  58. With WScript.Arguments.Unnamed
  59. 	If .Count < 1 Or .Count> 2 Then Syntax
  60. 	strName = .Item(0)
  61. 	If .Count = 1 Then
  62. 		If Not blnDelete Then Syntax
  63. 	Else
  64. 		strPath = .Item(1)
  65. 		If Not objFSO.FileExists( strPath ) And Not objFSO.FolderExists( strPath ) Then Syntax
  66. 	End If
  67. End With
  68.  
  69. Set wshShell = CreateObject( "Wscript.Shell" )
  70.  
  71. ' All Users vs. current user
  72. If blnAllUsers Then
  73. 	strDesktop  = wshShell.SpecialFolders( "AllUsersDesktop"  )
  74. 	strPrograms = wshShell.SpecialFolders( "AllUsersPrograms" )
  75. Else
  76. 	strDesktop  = wshShell.SpecialFolders( "Desktop"  )
  77. 	strPrograms = wshShell.SpecialFolders( "Programs" )
  78. End If
  79.  
  80. If blnDesktop Then
  81. 	strShortcut = objFSO.BuildPath( strDesktop,  strName & ".lnk" )
  82. Else
  83. 	strShortcut = objFSO.BuildPath( strPrograms, strName & ".lnk" )
  84. End If
  85.  
  86. If blnDelete Then
  87. 	With objFSO
  88. 		If .FileExists( strShortcut ) Then .DeleteFile strShortcut, True
  89. 		If blnDesktop Then
  90. 			If blnDelTree Then RmDir strDesktop,  Mid( .GetParentFolderName( strShortcut ), Len( strDesktop  ) + 2 )
  91. 		Else
  92. 			If blnDelTree Then RmDir strPrograms, Mid( .GetParentFolderName( strShortcut ), Len( strPrograms ) + 2 )
  93. 		End If
  94. 	End With
  95. Else
  96. 	If blnDesktop Then
  97. 		MkDir strDesktop, strName
  98. 	Else
  99. 		MkDir strPrograms, strName
  100. 	End If
  101. 	Set objShortcut = wshShell.CreateShortcut( strShortcut )
  102. 	objShortcut.TargetPath   = strPath
  103. 	objShortcut.Arguments    = strArgs
  104. 	objShortcut.WindowStyle  = 1
  105. 	objShortcut.IconLocation = strIcon
  106. 	objShortcut.WorkingDirectory = strWorkingDir
  107. 	objShortcut.Save
  108. End If
  109.  
  110. Set objShortcut = Nothing
  111. Set wshShell    = Nothing
  112. Set objFSO      = Nothing
  113.  
  114.  
  115. Sub MkDir( myStartpath, mySubDirTree )
  116. 	Dim arrTree, i, objFSO, strNewDir, strSubDirTree
  117. 	If InStr( mySubDirTree, "\" ) > 0 Then
  118. 		arrTree = Split( mySubDirTree, "\" )
  119. 		If Not IsArray( arrTree ) Then Exit Sub
  120. 		If UBound( arrTree ) = 0  Then Exit Sub
  121. 		Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  122. 		With objFSO
  123. 			strSubDirTree = myStartPath
  124. 			For i = 0 To UBound( arrTree ) - 1
  125. 				strSubDirTree = .BuildPath( strSubDirTree, arrTree(i) )
  126. 				If Not .FolderExists( strSubDirTree ) Then .CreateFolder( strSubDirTree )
  127. 			Next
  128. 		End With
  129. 		Set objFSO = Nothing
  130. 	End If
  131. End Sub
  132.  
  133.  
  134. Sub RmDir( myStartpath, mySubDirTree )
  135. 	Dim arrTree, i, objFSO, objFolder, strFolder, strSubDirTree
  136. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  137. 	With objFSO
  138. 		strSubDirTree = mySubDirTree
  139. 		strFolder     = .BuildPath( myStartPath, strSubDirTree )
  140. 		If .FolderExists( strFolder ) Then
  141. 			Set objFolder = .GetFolder( strFolder )
  142. 			If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then .DeleteFolder( .BuildPath( myStartpath, strSubDirTree ) )
  143. 			Do
  144. 				strSubDirTree = Left( strSubDirTree, InStrRev( strSubDirTree, "\" ) - 1 )
  145. 				strFolder     = .BuildPath( myStartPath, strSubDirTree )
  146. 				If .FolderExists( strFolder ) Then
  147. 					Set objFolder = .GetFolder( strFolder )
  148. 					If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
  149. 						.DeleteFolder( .BuildPath( myStartpath, strSubDirTree ) )
  150. 					Else
  151. 						Exit Do
  152. 					End If
  153. 				Else
  154. 					Exit Do
  155. 				End If
  156. 			Loop Until InStr( strSubDirTree, "\" ) < 1
  157. 		End If
  158. 	End With
  159. 	Set objFolder = Nothing
  160. 	Set objFSO    = Nothing
  161. End Sub
  162.  
  163.  
  164. Sub Syntax
  165. 	Dim strMsg
  166. 	strMsg = vbCrLf _
  167. 	       & "Shortcut.vbs,  Version 1.00" _
  168. 	       & vbCrLf _
  169. 	       & "Create, modify or delete shortcuts" _
  170. 	       & vbCrLf & vbCrLf _
  171. 	       & "Usage:   Shortcut.vbs  name  path  [ options ]" _
  172. 	       & vbCrLf & vbCrLf _
  173. 	       & "   or:   Shortcut.vbs  name  /DEL  [ /TREE ]" _
  174. 	       & vbCrLf & vbCrLf _
  175. 	       & "Where:   name                  name for the shortcut" _
  176. 	       & vbCrLf _
  177. 	       & "         path                  fully qualified path of the shortcut target" _
  178. 	       & vbCrLf _
  179. 	       & "         /DEL                  delete existing shortcut" _
  180. 	       & vbCrLf _
  181. 	       & "         /TREE                 also delete group(s) if empty" _
  182. 	       & vbCrLf _
  183. 	       & "Options: /ARGS:""arguments""     arguments for the shortcut target" _
  184. 	       & vbCrLf _
  185. 	       & "         /DIR:""path""           working directory" _
  186. 	       & vbCrLf _
  187. 	       & "         /ICON:""file[,index]""  icon file and optional index" _
  188. 	       & vbCrLf _
  189. 	       & "         /ALL                  for All Users (default: current user)" _
  190. 	       & vbCrLf _
  191. 	       & "         /DESK                 shortcut on Desktop (default Programs)" _
  192. 	       & vbCrLf & vbCrLf _
  193. 	       & "Note:    To use a shortcut in a Programs group, simply prefix the shortcut" _
  194. 	       & vbCrLf _
  195. 	       & "         name with the appropriate group name followed by a backslash." _
  196. 	       & vbCrLf & vbCrLf _
  197. 	       & "Example 1 (single command line, creates ""My shortcut.lnk"" in ""TestProg"" group):" _
  198. 	       & vbCrLf _
  199. 	       & "SHORTCUT.VBS ""TestProg\My shortcut"" C:\WINDOWS\system32\notepad.exe" _
  200. 	       & vbCrLf _
  201. 	       & "             /ARGS:""D:\Test.txt"" /ICON:""C:\WINDOWS\system32\shell32.dll,130""" _
  202. 	       & vbCrLf _
  203. 	       & "Example 2 (deletes the shortcut and group from the previous example again):" _
  204. 	       & vbCrLf _
  205. 	       & "SHORTCUT.VBS ""TestProg\My shortcut"" /DEL /TREE" _
  206. 	       & vbCrLf & vbCrLf _
  207. 	       & "Written by Rob van der Woude" _
  208. 	       & vbCrLf _
  209. 	       & "http://www.robvanderwoude.com"
  210. 	WScript.Echo strMsg
  211. 	WScript.Quit 1
  212. End Sub
  213.  

page last uploaded: 2017-08-21, 14:26