arnehormann/shortcut-generator.hta

## shortcut-generator.hta
<html style="padding: 0; margin: 0; width: 690; height: 480;"><head>
<hta:application id="oShortcutter" applicationname="Shortcutter" border="thin" caption="yes" contextmenu="no" scroll="no" showintaskbar="yes" singleinstance="yes" />
<title>Shortcut Generator</title>
<script language="VBScript">
'<![CDATA[
Option Explicit
On Error Resume Next

Sub SelectFolder
  ' For next value see http://msdn.microsoft.com/en-us/library/bb773205(VS.85).aspx
  Const ulFlags = &H251
  Dim objApp : Set objApp = CreateObject("Shell.Application")
  Dim folder : Set folder = objApp.BrowseForFolder(0, "Select a folder:", ulFlags, 0)
  If (Not folder Is Nothing) Then
    Document.GetElementById("targetdir").Value = folder.Self.Path
    Set folder = Nothing
  End If
  Set objApp = Nothing
End Sub

Sub AddShortcut(shell, target, shortcutfile, shortcutdesc, shortcutargs)
  Dim shortcut : Set shortcut = shell.CreateShortcut(shortcutfile)
  shortcut.TargetPath = target
  shortcut.Description = shortcutdesc
  shortcut.Arguments = shortcutargs
  shortcut.WindowStyle = 18
  shortcut.Save
  Set shortcut = Nothing
End Sub

Sub CreateShortcuts
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  Dim v_target : v_target = Document.GetElementById("target").Value
  Dim v_targetdir : v_targetdir = Document.GetElementById("targetdir").Value & "\\"
  Dim targetlines : targetlines = Split(Document.GetElementById("args").Value, vbCrLf)
  Dim i : Dim values : Dim shortcutdesc : Dim shortcutfile : Dim shortcutargs
  ' Validate existence of target folder / program
  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
  If objFSO.FileExists(v_target) And objFSO.FolderExists(v_targetdir) Then
    ' Create the shortcuts...
    For i = 0 To UBound(targetlines)
      values = Split(targetlines(i), "=", 2)
      If (UBound(values) = 1) Then
        shortcutdesc = trim(values(0))
        shortcutfile = v_targetdir & shortcutdesc & ".lnk"
        shortcutargs = trim(values(1))
        ' MsgBox "shortcut to: " & v_target & vbCrLf & "in dir:      " & v_targetdir & vbCrLf & "named:       " & shortcutdesc & vbCrLf & _
        ' "as file:     " & shortcutfile & vbCrLf & "with args:   " & shortcutargs
        AddShortcut objShell, v_target, v_targetdir & trim(values(0)) & ".lnk", trim(values(0)), trim(values(1))
      End If
    Next
  Else
    MsgBox "program '" & v_target & "'" & vbCrLf & " or " & vbCrLf & "folder '" & v_targetdir & "'" & vbCrLf & "are invalid."
  End If
  Set objFSO = Nothing
  Set objShell = Nothing
End Sub

Sub Window_OnLoad
  window.resizeTo 680, 600
  Dim CMDLine : CMDLine = oShortcutter.commandLine ' : CMDLine = replace(CMDLINE, "\"", "")
  Dim CMDLen : CMDLen = len(CMDLine)
  Dim pos : pos = instrRev(right(CMDLine, CMDLen - 1), "\")
  Dim path : path = left(right(CMDLine, CMDLen - 1), pos)
  Dim targetdir
  If (path <> "") Then
    Document.GetElementById("targetdir").Value = path
  End If
End Sub
']]>
</script><style type="text/css">
* { font-family: sans-serif; font-size: 100%; }
#body { padding: 0; margin: 5px; position: relative; }
code, #args { font-family: monospace; font-size: 90%; }
hr, #args { clear: both; }
label { display: inline; float: left; }
input { display: inline; font-size: 80%; }
#target, #folderbox, #filebox, #create { position: relative; float: right; }
</style></head><body id="body">
<p>
Batch-Creates shortcuts to a single program with different arguments.<br />
Choose the program and the folder the shortcuts should be written to and define names and arguments of the shortcuts.
When you are done, press <strong>Create Shortcuts</strong> and enjoy the magic...
</p>
<hr />
<label for="file">Target Program:</label> <input type="file" id="target" name="target" value="program" size="60" /><br />
<hr />
<label for="targetdir">Target Folder:</label> <span id="folderbox"><input type="text" id="targetdir" name="targetdir" value="shortcut folder" size="60" /> <input type="button" name="bftd" value="Select Folder" onclick="SelectFolder" /></span><br />
<hr />
<label for="create">Shortcut Names, Arguments ( <code>NAME=PROGRAM ARGUMENTS</code> ):</label><input type="submit" value="Create Shortcuts" onclick="CreateShortcuts" id="create" />
<textarea id="args" name="args" cols="80" rows="20" wrap="soft">
server=user@example.com
mail=user@mail.example.com
files=user@files.example.com
database=user@database.example.com</textarea>
</body></html>
	<html style="padding: 0; margin: 0; width: 690; height: 480;"><head>
	<hta:application id="oShortcutter" applicationname="Shortcutter" border="thin" caption="yes" contextmenu="no" scroll="no" showintaskbar="yes" singleinstance="yes" />
	<title>Shortcut Generator</title>
	<script language="VBScript">
	'<![CDATA[
	Option Explicit
	On Error Resume Next

	Sub SelectFolder
	' For next value see http://msdn.microsoft.com/en-us/library/bb773205(VS.85).aspx
	Const ulFlags = &H251
	Dim objApp : Set objApp = CreateObject("Shell.Application")
	Dim folder : Set folder = objApp.BrowseForFolder(0, "Select a folder:", ulFlags, 0)
	If (Not folder Is Nothing) Then
	Document.GetElementById("targetdir").Value = folder.Self.Path
	Set folder = Nothing
	End If
	Set objApp = Nothing
	End Sub

	Sub AddShortcut(shell, target, shortcutfile, shortcutdesc, shortcutargs)
	Dim shortcut : Set shortcut = shell.CreateShortcut(shortcutfile)
	shortcut.TargetPath = target
	shortcut.Description = shortcutdesc
	shortcut.Arguments = shortcutargs
	shortcut.WindowStyle = 18
	shortcut.Save
	Set shortcut = Nothing
	End Sub

	Sub CreateShortcuts
	Dim objShell : Set objShell = CreateObject("WScript.Shell")
	Dim v_target : v_target = Document.GetElementById("target").Value
	Dim v_targetdir : v_targetdir = Document.GetElementById("targetdir").Value & "\\"
	Dim targetlines : targetlines = Split(Document.GetElementById("args").Value, vbCrLf)
	Dim i : Dim values : Dim shortcutdesc : Dim shortcutfile : Dim shortcutargs
	' Validate existence of target folder / program
	Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
	If objFSO.FileExists(v_target) And objFSO.FolderExists(v_targetdir) Then
	' Create the shortcuts...
	For i = 0 To UBound(targetlines)
	values = Split(targetlines(i), "=", 2)
	If (UBound(values) = 1) Then
	shortcutdesc = trim(values(0))
	shortcutfile = v_targetdir & shortcutdesc & ".lnk"
	shortcutargs = trim(values(1))
	' MsgBox "shortcut to: " & v_target & vbCrLf & "in dir: " & v_targetdir & vbCrLf & "named: " & shortcutdesc & vbCrLf & _
	' "as file: " & shortcutfile & vbCrLf & "with args: " & shortcutargs
	AddShortcut objShell, v_target, v_targetdir & trim(values(0)) & ".lnk", trim(values(0)), trim(values(1))
	End If
	Next
	Else
	MsgBox "program '" & v_target & "'" & vbCrLf & " or " & vbCrLf & "folder '" & v_targetdir & "'" & vbCrLf & "are invalid."
	End If
	Set objFSO = Nothing
	Set objShell = Nothing
	End Sub

	Sub Window_OnLoad
	window.resizeTo 680, 600
	Dim CMDLine : CMDLine = oShortcutter.commandLine ' : CMDLine = replace(CMDLINE, "\"", "")
	Dim CMDLen : CMDLen = len(CMDLine)
	Dim pos : pos = instrRev(right(CMDLine, CMDLen - 1), "\")
	Dim path : path = left(right(CMDLine, CMDLen - 1), pos)
	Dim targetdir
	If (path <> "") Then
	Document.GetElementById("targetdir").Value = path
	End If
	End Sub
	']]>
	</script><style type="text/css">
	* { font-family: sans-serif; font-size: 100%; }
	#body { padding: 0; margin: 5px; position: relative; }
	code, #args { font-family: monospace; font-size: 90%; }
	hr, #args { clear: both; }
	label { display: inline; float: left; }
	input { display: inline; font-size: 80%; }
	#target, #folderbox, #filebox, #create { position: relative; float: right; }
	</style></head><body id="body">
	<p>
	Batch-Creates shortcuts to a single program with different arguments.<br />
	Choose the program and the folder the shortcuts should be written to and define names and arguments of the shortcuts.
	When you are done, press <strong>Create Shortcuts</strong> and enjoy the magic...
	</p>
	<hr />
	<label for="file">Target Program:</label> <input type="file" id="target" name="target" value="program" size="60" /><br />
	<hr />
	<label for="targetdir">Target Folder:</label> <span id="folderbox"><input type="text" id="targetdir" name="targetdir" value="shortcut folder" size="60" /> <input type="button" name="bftd" value="Select Folder" onclick="SelectFolder" /></span><br />
	<hr />
	<label for="create">Shortcut Names, Arguments ( <code>NAME=PROGRAM ARGUMENTS</code> ):</label><input type="submit" value="Create Shortcuts" onclick="CreateShortcuts" id="create" />
	<textarea id="args" name="args" cols="80" rows="20" wrap="soft">
	server=user@example.com
	mail=user@mail.example.com
	files=user@files.example.com
	database=user@database.example.com</textarea>
	</body></html>