'Option Explicit

Dim blnAllUsers, blnDelete, blnDesktop, blnDelTree
Dim intValidArgs
Dim objFSO, objShortcut, wshShell
Dim strArgs, strDesktop, strIcon, strName, strPath, strPrograms, strShortcut, strWorkingDir

blnAllUsers   = False
blnDelete     = False
blnDelTree    = False
blnDesktop    = False
strArgs       = ""
strIcon       = ""
strWorkingDir = ""

Set objFSO = CreateObject( "Scripting.FileSystemObject" )

' Options
With WScript.Arguments.Named
	intValidArgs = 0
	If .Exists( "ARGS" ) And strArgs = "" Then
		strArgs      = Trim( .Item( "ARGS" ) )
		intValidArgs = intValidArgs + 1
		If strArgs = "" Then Syntax
	End If
	If .Exists( "DIR" ) And strWorkingDir = "" Then
		strWorkingDir = .Item( "DIR" )
		intValidArgs  = intValidArgs + 1
		If strWorkingDir = "" Then Syntax
		If Not objFSO.FolderExists( strWorkingDir ) Then Syntax
	End If
	If .Exists( "ICON" ) And strIcon = "" Then
		strIcon      = .Item( "ICON" )
		intValidArgs = intValidArgs + 1
		If strIcon = "" Then Syntax
	End If
	If .Exists( "ALL" ) And blnAllUsers = False Then
		blnAllUsers  = True
		intValidArgs = intValidArgs + 1
	End If
	If .Exists( "DEL" ) And blnDelete = False Then
		blnDelete    = True
		intValidArgs = intValidArgs + 1
	End If
	If .Exists( "DESK" ) And blnDesktop = False Then
		blnDesktop   = True
		intValidArgs = intValidArgs + 1
	End If
	If .Exists( "TREE" ) And blnDelTree = False Then
		blnDelTree   = True
		intValidArgs = intValidArgs + 1
	End If
	If intValidArgs <> .Count Then Syntax
	If blnDelTree And Not blnDelete Then Syntax
End With

' Name and target
With WScript.Arguments.Unnamed
	If .Count < 1 Or .Count> 2 Then Syntax
	strName = .Item(0)
	If .Count = 1 Then
		If Not blnDelete Then Syntax
	Else
		strPath = .Item(1)
		If Not objFSO.FileExists( strPath ) And Not objFSO.FolderExists( strPath ) Then Syntax
	End If
End With

Set wshShell = CreateObject( "Wscript.Shell" )

' All Users vs. current user
If blnAllUsers Then
	strDesktop  = wshShell.SpecialFolders( "AllUsersDesktop"  )
	strPrograms = wshShell.SpecialFolders( "AllUsersPrograms" )
Else
	strDesktop  = wshShell.SpecialFolders( "Desktop"  )
	strPrograms = wshShell.SpecialFolders( "Programs" )
End If

If blnDesktop Then
	strShortcut = objFSO.BuildPath( strDesktop,  strName & ".lnk" )
Else
	strShortcut = objFSO.BuildPath( strPrograms, strName & ".lnk" )
End If

If blnDelete Then
	With objFSO
		If .FileExists( strShortcut ) Then .DeleteFile strShortcut, True
		If blnDesktop Then
			If blnDelTree Then RmDir strDesktop,  Mid( .GetParentFolderName( strShortcut ), Len( strDesktop  ) + 2 )
		Else
			If blnDelTree Then RmDir strPrograms, Mid( .GetParentFolderName( strShortcut ), Len( strPrograms ) + 2 )
		End If
	End With
Else
	If blnDesktop Then
		MkDir strDesktop, strName
	Else
		MkDir strPrograms, strName
	End If
	Set objShortcut = wshShell.CreateShortcut( strShortcut )
	objShortcut.TargetPath   = strPath
	objShortcut.Arguments    = strArgs
	objShortcut.WindowStyle  = 1
	objShortcut.IconLocation = strIcon
	objShortcut.WorkingDirectory = strWorkingDir
	objShortcut.Save
End If

Set objShortcut = Nothing
Set wshShell    = Nothing
Set objFSO      = Nothing


Sub MkDir( myStartpath, mySubDirTree )
	Dim arrTree, i, objFSO, strNewDir, strSubDirTree
	If InStr( mySubDirTree, "\" ) > 0 Then
		arrTree = Split( mySubDirTree, "\" )
		If Not IsArray( arrTree ) Then Exit Sub
		If UBound( arrTree ) = 0  Then Exit Sub
		Set objFSO = CreateObject( "Scripting.FileSystemObject" )
		With objFSO
			strSubDirTree = myStartPath
			For i = 0 To UBound( arrTree ) - 1
				strSubDirTree = .BuildPath( strSubDirTree, arrTree(i) )
				If Not .FolderExists( strSubDirTree ) Then .CreateFolder( strSubDirTree )
			Next
		End With
		Set objFSO = Nothing
	End If
End Sub


Sub RmDir( myStartpath, mySubDirTree )
	Dim arrTree, i, objFSO, objFolder, strFolder, strSubDirTree
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	With objFSO
		strSubDirTree = mySubDirTree
		strFolder     = .BuildPath( myStartPath, strSubDirTree )
		If .FolderExists( strFolder ) Then
			Set objFolder = .GetFolder( strFolder )
			If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then .DeleteFolder( .BuildPath( myStartpath, strSubDirTree ) )
			Do
				strSubDirTree = Left( strSubDirTree, InStrRev( strSubDirTree, "\" ) - 1 )
				strFolder     = .BuildPath( myStartPath, strSubDirTree )
				If .FolderExists( strFolder ) Then
					Set objFolder = .GetFolder( strFolder )
					If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
						.DeleteFolder( .BuildPath( myStartpath, strSubDirTree ) )
					Else
						Exit Do
					End If
				Else
					Exit Do
				End If
			Loop Until InStr( strSubDirTree, "\" ) < 1
		End If
	End With
	Set objFolder = Nothing
	Set objFSO    = Nothing
End Sub


Sub Syntax
	Dim strMsg
	strMsg = vbCrLf _
	       & "Shortcut.vbs,  Version 1.00" _
	       & vbCrLf _
	       & "Create, modify or delete shortcuts" _
	       & vbCrLf & vbCrLf _
	       & "Usage:   Shortcut.vbs  name  path  [ options ]" _
	       & vbCrLf & vbCrLf _
	       & "   or:   Shortcut.vbs  name  /DEL  [ /TREE ]" _
	       & vbCrLf & vbCrLf _
	       & "Where:   name                  name for the shortcut" _
	       & vbCrLf _
	       & "         path                  fully qualified path of the shortcut target" _
	       & vbCrLf _
	       & "         /DEL                  delete existing shortcut" _
	       & vbCrLf _
	       & "         /TREE                 also delete group(s) if empty" _
	       & vbCrLf _
	       & "Options: /ARGS:""arguments""     arguments for the shortcut target" _
	       & vbCrLf _
	       & "         /DIR:""path""           working directory" _
	       & vbCrLf _
	       & "         /ICON:""file[,index]""  icon file and optional index" _
	       & vbCrLf _
	       & "         /ALL                  for All Users (default: current user)" _
	       & vbCrLf _
	       & "         /DESK                 shortcut on Desktop (default Programs)" _
	       & vbCrLf & vbCrLf _
	       & "Note:    To use a shortcut in a Programs group, simply prefix the shortcut" _
	       & vbCrLf _
	       & "         name with the appropriate group name followed by a backslash." _
	       & vbCrLf & vbCrLf _
	       & "Example 1 (single command line, creates ""My shortcut.lnk"" in ""TestProg"" group):" _
	       & vbCrLf _
	       & "SHORTCUT.VBS ""TestProg\My shortcut"" C:\WINDOWS\system32\notepad.exe" _
	       & vbCrLf _
	       & "             /ARGS:""D:\Test.txt"" /ICON:""C:\WINDOWS\system32\shell32.dll,130""" _
	       & vbCrLf _
	       & "Example 2 (deletes the shortcut and group from the previous example again):" _
	       & vbCrLf _
	       & "SHORTCUT.VBS ""TestProg\My shortcut"" /DEL /TREE" _
	       & vbCrLf & vbCrLf _
	       & "Written by Rob van der Woude" _
	       & vbCrLf _
	       & "http://www.robvanderwoude.com"
	WScript.Echo strMsg
	WScript.Quit 1
End Sub