Updated 8th December 2008…
Today I was finalising the application deployment for a new XenApp farm. One of the final scripts to create was to place 9 shortcuts on the Desktop of the All Users profile. That’s quite a simple task, and for the most part some would probably just end up copying a bunch of previously created ones into place. But that would be too easy. I wanted to create them on the fly!
So whilst I was writing the script I was faced with three challenges:
- As per Microsoft KB article Q263324, when you create shortcuts and specify a long file name in the target path, the path is truncated if the hard disk (or drive mapping) for the target path does not exist.
For example, create a shortcut with the following target:
J:\Mydirectory\Myapplication.exe
If drive J does not exist, the path is truncated to:
J:\Mydirect\Mypplica.exe
This problem can occur because the shell cannot determine whether the hard disk supports long file names, so the path is truncated to be acceptable to all file systems. Amazing that this is still a problem in this day and age!
To work around this problem, you can use the subst command to point drive J to a local hard disk.
To subst a drive to make the mapping work…
ret = WshShell.Run (“cmd /c subst j: %SystemDrive%\”, 0, TRUE)
To remove the subst…
ret = WshShell.Run (“cmd /c subst j: /d”, 0, TRUE)
So to work around this problem I created a function called CreateSubstDrive that will create a virtual drive, and then delete it when finished.
- The IconLocation property that assigns an icon to a shortcut does not work for URL shortcuts. Only LNK shortcuts work with this property, so I had create a subroutine that opens the .URL file and appends the IconFile and IconIndex. However, if run after the deployment of IE7, the make up of the contents of the URL file is different. IE7 adds some more properties, including a GUID section. Since the origninal script was simply just appending the IconFile and IconIndex lines, and because IE6 only created URL shortcuts with one section called “[InternetShortcut]”, it was now being placed in the wrong “section”. So now we need to treat the URL file as an ini file. Therefore I have replaced the original AddURLIcon subroutine with a standard WriteINIString subroutine from Motobit Software.
- This script will error with a “Catastrophic failure” when creating any URL shortcuts if run after the deployment of IE7 and before a reboot. Even using “On Error Resume Next” to force the script to continue, fails to create the shortcuts correctly. Therefore, this script must either be run before the deployment of IE7, or after a reboot.
' This script will create the required Shortcuts ' ' Revision 1.1 released on 8th December 2008. ' Written by Jeremy@jhouseconsulting.com on 3rd December 2008. Option Explicit Dim objfso, objFolder, wshShell, oShellLink, strAUPrograms, strAUStartup, strAUDesktop Dim strProgramFiles, strTargetPath, strScriptPath, strSystemRoot, strSystemDrive Dim strProcessorArchitecture, blnActiveSubst, strIconFile, intIconIndex set WshShell = WScript.CreateObject("WScript.Shell") set objfso = CreateObject("Scripting.FileSystemObject") strSystemDrive = WshShell.ExpandEnvironmentStrings("%SystemDrive%") strSystemRoot = WshShell.ExpandEnvironmentStrings("%SystemRoot%") strProcessorArchitecture = WshShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") If strProcessorArchitecture = "x86" Then strProgramFiles = WshShell.ExpandEnvironmentStrings("%ProgramFiles%") Else strProgramFiles = WshShell.ExpandEnvironmentStrings("%ProgramFiles(86)%") End If strAUPrograms = WshShell.SpecialFolders("AllUsersPrograms") strAUStartup = WshShell.SpecialFolders("AllUsersStartup") strAUDesktop = WshShell.SpecialFolders("AllUsersDesktop") strScriptPath = GetCurrentPath ' ******************************************************************************** blnActiveSubst=False If CreateSubstDrive("i","create") Then blnActiveSubst=True Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\APM Springboard.lnk") oShellLink.TargetPath = "I:\springboard\index.html" oShellLink.WorkingDirectory = "I:\springboard" oShellLink.IconLocation = "%SystemRoot%\system32\SHELL32.dll" & ",93" oShellLink.Save If blnActiveSubst then Call CreateSubstDrive("i","delete") ' ******************************************************************************** blnActiveSubst=False If CreateSubstDrive("q","create") Then blnActiveSubst=True Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\Case Manager.lnk") oShellLink.TargetPath = chr(34) & "Q:\Case Manager\CaseManagerLoader.exe" & chr(34) oShellLink.Arguments = "/DB:ODBC;DSN=CaseManager /nosplash" oShellLink.WorkingDirectory = chr(34) & "Q:\CASEMA~1" & chr(34) oShellLink.IconLocation = "Q:\Case Manager\CaseMan.exe" & ",0" oShellLink.Save If blnActiveSubst then Call CreateSubstDrive("q","delete") ' ******************************************************************************** Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\ConnX.url") oShellLink.TargetPath = "http://apm-wp-db001/connx/" oShellLink.Save If objFSO.FileExists(strScriptPath & "connx.ico") Then If NOT objFSO.FolderExists(strSystemDrive & "\Connx") Then Set objFolder = objFSO.CreateFolder(strSystemDrive & "\Connx") End If objFSO.CopyFile strScriptPath & "connx.ico", strSystemDrive & "\Connx\", True strIconFile=strSystemDrive & "\Connx\connx.ico" intIconIndex=0 WriteINIString "InternetShortcut", "IconIndex", intIconIndex, strAUDesktop & "\\ConnX.url" WriteINIString "InternetShortcut", "IconFile", strIconFile, strAUDesktop & "\\ConnX.url" End If ' ******************************************************************************** Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\Crystal Reports Infoview.url") oShellLink.TargetPath = "http://apm-wp-crystal2/businessobjects/enterprise115/InfoView/logon.aspx" oShellLink.Save ' ******************************************************************************** blnActiveSubst=False If CreateSubstDrive("j","create") Then blnActiveSubst=True Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\Daily Update.lnk") oShellLink.TargetPath = "J:\DailyUpdate\dailyupdate.html" oShellLink.WorkingDirectory = "J:\DailyUpdate" oShellLink.IconLocation = "%SystemRoot%\system32\SHELL32.dll" & ",13" oShellLink.Save If blnActiveSubst then Call CreateSubstDrive("j","delete") ' ******************************************************************************** Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\Desktop eForms.lnk") oShellLink.TargetPath = chr(34) & strProgramFiles & "\Shana\Informed\Filler.exe" & chr(34) oShellLink.IconLocation = strProgramFiles & "\Shana\Informed\Filler.exe" & ",0" oShellLink.Save ' ******************************************************************************** Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\HelpDesk Portal.url") oShellLink.TargetPath = "http://helpdesk/Versacat" oShellLink.Save ' ******************************************************************************** blnActiveSubst=False If CreateSubstDrive("h","create") Then blnActiveSubst=True Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\JobReady+ v8.lnk") oShellLink.TargetPath = "H:\JobReady\JobReady_logon.fp7" oShellLink.WorkingDirectory = "H:\JobReady" oShellLink.IconLocation = "%ProgramFiles%\FileMaker\FileMaker Pro 8.5\FileMaker Pro.exe" & ",0" oShellLink.Save If blnActiveSubst then Call CreateSubstDrive("h","delete") ' ******************************************************************************** blnActiveSubst=False If CreateSubstDrive("i","create") Then blnActiveSubst=True Set oShellLink = WshShell.CreateShortcut(strAUDesktop & "\Resources.lnk") oShellLink.TargetPath = "I:\springboard\onlineresources.htm" oShellLink.WorkingDirectory = "I:\springboard" oShellLink.IconLocation = "%SystemRoot%\system32\SHELL32.dll" & ",98" oShellLink.Save If blnActiveSubst then Call CreateSubstDrive("i","delete") ' ******************************************************************************** Set WshShell = Nothing Set objfso = Nothing Set objFolder = Nothing WScript.Quit(0) Function GetCurrentPath ' Return path to the current script DIM path path = WScript.ScriptFullName GetCurrentPath = Left(path, InstrRev(path, "\")) End Function Sub AddURLIcon(strShortCutPath,strIconFile,intIconIndex) Dim objfile,ots,line,contents,blnIconNotSet set objfile=objfso.getfile(strShortCutPath) set ots=objfile.openastextstream(1) contents="" do while not ots.atEndofstream line=ots.readline if instr(1,line,"IconIndex",1)=0 and instr(1,line,"IconFile",1)=0 then contents=contents & line & vbcrlf end if loop ots.close contents=contents & "IconFile=" & strIconFile & vbcrlf contents=contents & "IconIndex=" & cstr(intIconIndex) set ots=objfile.openastextstream(2) ots.write contents ots.close set ots=nothing set objfile=nothing End Sub Function CreateSubstDrive(strLetter,strAction) Dim ret, WshShell, objfso set WshShell = WScript.CreateObject("WScript.Shell") set objfso = CreateObject("Scripting.FileSystemObject") If lcase(strAction)="create" Then If NOT objfso.FolderExists(strLetter & ":\") Then ret = WshShell.Run ("cmd /c subst " & strLetter & ": %SystemDrive%\", 0, TRUE) CreateSubstDrive = True Else CreateSubstDrive = False End If End If If lcase(strAction)="delete" Then ret = WshShell.Run ("cmd /c subst " & strLetter & ": /d", 0, TRUE) CreateSubstDrive = True End If set WshShell = Nothing set objfso = Nothing End Function Sub WriteINIString(Section, KeyName, Value, FileName) Dim INIContents, PosSection, PosEndSection ' Get contents of the INI file As a string INIContents = GetFile(FileName) ' Find section PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare) If PosSection>0 Then ' Section exists. Find end of section PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[") ' ?Is this last section? If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1 ' Separate section contents Dim OldsContents, NewsContents, Line Dim sKeyName, Found OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection) OldsContents = split(OldsContents, vbCrLf) ' Temp variable To find a Key sKeyName = LCase(KeyName & "=") ' Enumerate section lines For Each Line In OldsContents If LCase(Left(Line, Len(sKeyName))) = sKeyName Then Line = KeyName & "=" & Value Found = True End If NewsContents = NewsContents & Line & vbCrLf Next If isempty(Found) Then ' key Not found - add it at the end of section NewsContents = NewsContents & KeyName & "=" & Value Else ' remove last vbCrLf - the vbCrLf is at PosEndSection NewsContents = Left(NewsContents, Len(NewsContents) - 2) End If ' Combine pre-section, new section And post-section data. INIContents = Left(INIContents, PosSection-1) & _ NewsContents & Mid(INIContents, PosEndSection) else'if PosSection>0 Then ' Section Not found. Add section data at the end of file contents. If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then INIContents = INIContents & vbCrLf End If INIContents = INIContents & "[" & Section & "]" & vbCrLf & _ KeyName & "=" & Value end if'if PosSection>0 Then WriteFile FileName, INIContents End Sub Function GetFile(ByVal FileName) Dim FS: Set FS = CreateObject("Scripting.FileSystemObject") ' Go To windows folder If full path Not specified. If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then FileName = FS.GetSpecialFolder(0) & "\" & FileName End If On Error Resume Next GetFile = FS.OpenTextFile(FileName).ReadAll End Function Function WriteFile(ByVal FileName, ByVal Contents) Dim FS: Set FS = CreateObject("Scripting.FileSystemObject") ' On Error Resume Next ' Go To windows folder If full path Not specified. If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then FileName = FS.GetSpecialFolder(0) & "\" & FileName End If Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True) OutStream.Write Contents End Function
Enjoy!