{"id":233,"date":"2008-12-03T22:28:59","date_gmt":"2008-12-03T14:28:59","guid":{"rendered":"http:\/\/www.jhouseconsulting.com\/?p=233"},"modified":"2014-03-12T22:53:58","modified_gmt":"2014-03-12T14:53:58","slug":"the-challenges-of-using-vbscript-to-create-shortcuts","status":"publish","type":"post","link":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/2008\/12\/03\/the-challenges-of-using-vbscript-to-create-shortcuts-233","title":{"rendered":"The Challenges of Using VBScript to Create Shortcuts"},"content":{"rendered":"

Updated 8th December 2008…<\/p>\n

Today I was finalising the application deployment for a new XenApp farm. One of the final scripts to create was to place 9\u00a0shortcuts 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!<\/p>\n

So whilst I was writing the script I was faced with three challenges:<\/p>\n

    \n
      \n
    1. 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.<\/li>\n<\/ol>\n<\/ol>\n

      For example, create a shortcut with the following target:<\/p>\n

      J:\\Mydirectory\\Myapplication.exe<\/p>\n

      If drive J does not exist, the path is truncated to:<\/p>\n

      J:\\Mydirect\\Mypplica.exe<\/p>\n

      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!<\/p>\n

      To work around this problem, you can use the subst command to point drive J to a local hard disk.<\/p>\n

      To subst a drive to make the mapping work…<\/p>\n

      ret = WshShell.Run (“cmd \/c subst j: %SystemDrive%\\”, 0, TRUE)<\/p>\n

      To remove the subst…<\/p>\n

      ret = WshShell.Run (“cmd \/c subst j: \/d”, 0, TRUE)<\/p>\n

      So to work around this problem I created a function called CreateSubstDrive that will create a virtual drive, and then delete it when finished.<\/p>\n

        \n
      1. 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<\/a>.<\/li>\n
      2. 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.<\/li>\n<\/ol>\n
        \r\n' This script will create the required Shortcuts\r\n'\r\n' Revision 1.1 released on 8th December 2008.\r\n' Written by Jeremy@jhouseconsulting.com on 3rd December 2008.\r\n\r\nOption Explicit\r\n\r\nDim objfso, objFolder, wshShell, oShellLink, strAUPrograms, strAUStartup, strAUDesktop\r\nDim strProgramFiles, strTargetPath, strScriptPath, strSystemRoot, strSystemDrive\r\nDim strProcessorArchitecture, blnActiveSubst, strIconFile, intIconIndex\r\n\r\nset WshShell = WScript.CreateObject("WScript.Shell")\r\nset objfso = CreateObject("Scripting.FileSystemObject")\r\n\r\nstrSystemDrive = WshShell.ExpandEnvironmentStrings("%SystemDrive%")\r\nstrSystemRoot = WshShell.ExpandEnvironmentStrings("%SystemRoot%")\r\nstrProcessorArchitecture = WshShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")\r\nIf strProcessorArchitecture = "x86" Then\r\n  strProgramFiles = WshShell.ExpandEnvironmentStrings("%ProgramFiles%")\r\nElse\r\n  strProgramFiles = WshShell.ExpandEnvironmentStrings("%ProgramFiles(86)%")\r\nEnd If\r\nstrAUPrograms = WshShell.SpecialFolders("AllUsersPrograms")\r\nstrAUStartup = WshShell.SpecialFolders("AllUsersStartup")\r\nstrAUDesktop = WshShell.SpecialFolders("AllUsersDesktop")\r\nstrScriptPath = GetCurrentPath\r\n\r\n' ********************************************************************************\r\n\r\nblnActiveSubst=False\r\nIf CreateSubstDrive("i","create") Then blnActiveSubst=True\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\APM Springboard.lnk")\r\noShellLink.TargetPath = "I:\\springboard\\index.html"\r\noShellLink.WorkingDirectory = "I:\\springboard"\r\noShellLink.IconLocation = "%SystemRoot%\\system32\\SHELL32.dll" & ",93"\r\noShellLink.Save\r\nIf blnActiveSubst then Call CreateSubstDrive("i","delete")\r\n\r\n' ********************************************************************************\r\n\r\nblnActiveSubst=False\r\nIf CreateSubstDrive("q","create") Then blnActiveSubst=True\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\Case Manager.lnk")\r\noShellLink.TargetPath = chr(34) & "Q:\\Case Manager\\CaseManagerLoader.exe" & chr(34)\r\noShellLink.Arguments = "\/DB:ODBC;DSN=CaseManager \/nosplash"\r\noShellLink.WorkingDirectory = chr(34) & "Q:\\CASEMA~1" & chr(34)\r\noShellLink.IconLocation = "Q:\\Case Manager\\CaseMan.exe" & ",0"\r\noShellLink.Save\r\nIf blnActiveSubst then Call CreateSubstDrive("q","delete")\r\n\r\n' ********************************************************************************\r\n\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\\\ConnX.url")\r\noShellLink.TargetPath = "http:\/\/apm-wp-db001\/connx\/"\r\noShellLink.Save\r\nIf objFSO.FileExists(strScriptPath & "connx.ico") Then\r\n  If NOT objFSO.FolderExists(strSystemDrive & "\\Connx") Then\r\n    Set objFolder = objFSO.CreateFolder(strSystemDrive & "\\Connx")\r\n  End If\r\n  objFSO.CopyFile strScriptPath & "connx.ico", strSystemDrive & "\\Connx\\", True\r\n  strIconFile=strSystemDrive & "\\Connx\\connx.ico"\r\n  intIconIndex=0\r\n  WriteINIString "InternetShortcut", "IconIndex", intIconIndex, strAUDesktop & "\\\\ConnX.url"\r\n  WriteINIString "InternetShortcut", "IconFile", strIconFile, strAUDesktop & "\\\\ConnX.url"\r\nEnd If\r\n\r\n' ********************************************************************************\r\n\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\\\Crystal Reports Infoview.url")\r\noShellLink.TargetPath = "http:\/\/apm-wp-crystal2\/businessobjects\/enterprise115\/InfoView\/logon.aspx"\r\noShellLink.Save\r\n\r\n' ********************************************************************************\r\n\r\nblnActiveSubst=False\r\nIf CreateSubstDrive("j","create") Then blnActiveSubst=True\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\Daily Update.lnk")\r\noShellLink.TargetPath = "J:\\DailyUpdate\\dailyupdate.html"\r\noShellLink.WorkingDirectory = "J:\\DailyUpdate"\r\noShellLink.IconLocation = "%SystemRoot%\\system32\\SHELL32.dll" & ",13"\r\noShellLink.Save\r\nIf blnActiveSubst then Call CreateSubstDrive("j","delete")\r\n\r\n' ********************************************************************************\r\n\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\Desktop eForms.lnk")\r\noShellLink.TargetPath = chr(34) & strProgramFiles & "\\Shana\\Informed\\Filler.exe" & chr(34)\r\noShellLink.IconLocation = strProgramFiles & "\\Shana\\Informed\\Filler.exe" & ",0"\r\noShellLink.Save\r\n\r\n' ********************************************************************************\r\n\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\\\HelpDesk Portal.url")\r\noShellLink.TargetPath = "http:\/\/helpdesk\/Versacat"\r\noShellLink.Save\r\n\r\n' ********************************************************************************\r\n\r\nblnActiveSubst=False\r\nIf CreateSubstDrive("h","create") Then blnActiveSubst=True\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\JobReady+ v8.lnk")\r\noShellLink.TargetPath = "H:\\JobReady\\JobReady_logon.fp7"\r\noShellLink.WorkingDirectory = "H:\\JobReady"\r\noShellLink.IconLocation = "%ProgramFiles%\\FileMaker\\FileMaker Pro 8.5\\FileMaker Pro.exe" & ",0"\r\noShellLink.Save\r\nIf blnActiveSubst then Call CreateSubstDrive("h","delete")\r\n\r\n' ********************************************************************************\r\n\r\nblnActiveSubst=False\r\nIf CreateSubstDrive("i","create") Then blnActiveSubst=True\r\nSet oShellLink = WshShell.CreateShortcut(strAUDesktop & "\\Resources.lnk")\r\noShellLink.TargetPath = "I:\\springboard\\onlineresources.htm"\r\noShellLink.WorkingDirectory = "I:\\springboard"\r\noShellLink.IconLocation = "%SystemRoot%\\system32\\SHELL32.dll" & ",98"\r\noShellLink.Save\r\nIf blnActiveSubst then Call CreateSubstDrive("i","delete")\r\n\r\n' ********************************************************************************\r\n\r\nSet WshShell = Nothing\r\nSet objfso = Nothing\r\nSet objFolder = Nothing\r\n\r\nWScript.Quit(0)\r\n\r\nFunction GetCurrentPath\r\n' Return path to the current script\r\n  DIM path\r\n  path = WScript.ScriptFullName\r\n  GetCurrentPath = Left(path, InstrRev(path, "\\"))\r\nEnd Function\r\n\r\nSub AddURLIcon(strShortCutPath,strIconFile,intIconIndex)\r\n  Dim objfile,ots,line,contents,blnIconNotSet\r\n  set objfile=objfso.getfile(strShortCutPath)\r\n  set ots=objfile.openastextstream(1)\r\n  contents=""\r\n  do while not ots.atEndofstream\r\n    line=ots.readline\r\n    if instr(1,line,"IconIndex",1)=0 and instr(1,line,"IconFile",1)=0 then\r\n      contents=contents & line & vbcrlf\r\n    end if\r\n  loop\r\n  ots.close\r\n  contents=contents & "IconFile=" & strIconFile & vbcrlf\r\n  contents=contents & "IconIndex=" & cstr(intIconIndex)\r\n  set ots=objfile.openastextstream(2)\r\n  ots.write contents\r\n  ots.close\r\n  set ots=nothing\r\n  set objfile=nothing\r\nEnd Sub\r\n\r\nFunction CreateSubstDrive(strLetter,strAction)\r\n  Dim ret, WshShell, objfso\r\n  set WshShell = WScript.CreateObject("WScript.Shell")\r\n  set objfso = CreateObject("Scripting.FileSystemObject")\r\n  If lcase(strAction)="create" Then\r\n    If NOT objfso.FolderExists(strLetter & ":\\") Then\r\n      ret = WshShell.Run ("cmd \/c subst " & strLetter & ": %SystemDrive%\\", 0, TRUE)\r\n      CreateSubstDrive = True\r\n    Else\r\n      CreateSubstDrive = False\r\n    End If\r\n  End If\r\n  If lcase(strAction)="delete" Then\r\n    ret = WshShell.Run ("cmd \/c subst " & strLetter & ": \/d", 0, TRUE)\r\n    CreateSubstDrive = True\r\n  End If\r\n  set WshShell = Nothing\r\n  set objfso = Nothing\r\nEnd Function\r\n\r\nSub WriteINIString(Section, KeyName, Value, FileName)\r\n  Dim INIContents, PosSection, PosEndSection\r\n\r\n' Get contents of the INI file As a string\r\n  INIContents = GetFile(FileName)\r\n\r\n' Find section\r\n  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)\r\n  If PosSection>0 Then\r\n'   Section exists. Find end of section\r\n    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")\r\n'   ?Is this last section?\r\n    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1\r\n\r\n'   Separate section contents\r\n    Dim OldsContents, NewsContents, Line\r\n    Dim sKeyName, Found\r\n    OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)\r\n    OldsContents = split(OldsContents, vbCrLf)\r\n\r\n'   Temp variable To find a Key\r\n    sKeyName = LCase(KeyName & "=")\r\n\r\n'   Enumerate section lines\r\n    For Each Line In OldsContents\r\n      If LCase(Left(Line, Len(sKeyName))) = sKeyName Then\r\n        Line = KeyName & "=" & Value\r\n        Found = True\r\n      End If\r\n      NewsContents = NewsContents & Line & vbCrLf\r\n    Next\r\n\r\n    If isempty(Found) Then\r\n'     key Not found - add it at the end of section\r\n      NewsContents = NewsContents & KeyName & "=" & Value\r\n    Else\r\n'     remove last vbCrLf - the vbCrLf is at PosEndSection\r\n      NewsContents = Left(NewsContents, Len(NewsContents) - 2)\r\n    End If\r\n\r\n'   Combine pre-section, new section And post-section data.\r\n    INIContents = Left(INIContents, PosSection-1) & _\r\n    NewsContents & Mid(INIContents, PosEndSection)\r\n  else'if PosSection>0 Then\r\n'   Section Not found. Add section data at the end of file contents.\r\n    If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then\r\n      INIContents = INIContents & vbCrLf\r\n    End If\r\n    INIContents = INIContents & "[" & Section & "]" & vbCrLf & _\r\n    KeyName & "=" & Value\r\n  end if'if PosSection>0 Then\r\n  WriteFile FileName, INIContents\r\nEnd Sub\r\n\r\nFunction GetFile(ByVal FileName)\r\n  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")\r\n' Go To windows folder If full path Not specified.\r\n  If InStr(FileName, ":\\") = 0 And Left (FileName,2)<>"\\\\" Then\r\n    FileName = FS.GetSpecialFolder(0) & "\\" & FileName\r\n  End If\r\n  On Error Resume Next\r\n\r\n  GetFile = FS.OpenTextFile(FileName).ReadAll\r\nEnd Function\r\n\r\nFunction WriteFile(ByVal FileName, ByVal Contents)\r\n\r\n  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")\r\n' On Error Resume Next\r\n\r\n' Go To windows folder If full path Not specified.\r\n  If InStr(FileName, ":\\") = 0 And Left (FileName,2)<>"\\\\" Then\r\n    FileName = FS.GetSpecialFolder(0) & "\\" & FileName\r\n  End If\r\n\r\n  Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)\r\n  OutStream.Write Contents\r\nEnd Function\r\n<\/pre>\n
        Enjoy!<\/p>\n","protected":false},"excerpt":{"rendered":"
        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\u00a0shortcuts 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 … Read more<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"ngg_post_thumbnail":0,"footnotes":""},"categories":[5],"tags":[117,112,111,114,113,62],"class_list":["post-233","post","type-post","status-publish","format-standard","hentry","category-scripting","tag-catastrophic-failure","tag-iconlocation","tag-shortcut","tag-truncate-target-path","tag-url","tag-vbscript"],"aioseo_notices":[],"jetpack_featured_media_url":"","_links":{"self":[{"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/posts\/233","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/comments?post=233"}],"version-history":[{"count":12,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/posts\/233\/revisions"}],"predecessor-version":[{"id":235,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/posts\/233\/revisions\/235"}],"wp:attachment":[{"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/media?parent=233"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/categories?post=233"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.jhouseconsulting.com\/jhouseconsulting\/wp-json\/wp\/v2\/tags?post=233"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}