Visual Basic Win32 Shell Routines
SHGetSpecialFolderLocation: Create a Desktop Shortcut
     
Posted:   Wednesday May 19, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
None.

When using the VB's setup/deployment utility, VB developers are stuck with accepting the default shortcut installation when installing applications. While the creation of the application icon under the \Programs folder may suffice in some situations, the ability to create a convenient desktop shortcut still eludes the VB developer without hacking VB's setup application to add commands to create the shortcut in a system folder other than the default provided by the tool.

But, by utilizing Windows' SHFileOperation API and a couple of wrapper routines, as this page demonstrates we can create the desired desktop shortcut by copying the one installed with by setup. And while perfectly functional, this would be considered by some as a workaround, and by others a 'slimy hack'!

This method is lightweight and can be embedded into right your VB app, providing the ability to (re-)create the shortcut on-demand or as part of the application's normal operation. In addition, on a system using profiles (Windows NT or later) or user groups (Win98), this can assure that each logged on user has the shortcut on their desktop.  It's one shortcoming is that the routine will always recreate the desktop icon (assuming the source link file exists). This means that while repeated calling of the code will only generate one icon on the desktop (as each call simply replaces the existing icon), should the user rename the shortcut the code will create another using the default name coded into the routine. If you see this as a showstopper then you'll have to write code to manipulate the setup kit's shortcut-creation function,

The method shown here is straightforward ... for a given installation created by the VB setup utility there will be a folder and shortcut placed under the user's \start menu\programs folder.  This code uses SHGetSpecialFolderLocation and SHGetPathFromIDList to retrieve the user's paths to the desktop and start menu, builds a string to the application folder and existing shortcut, then calls SHFileIOPeration to copy the shortcut to the user's desktop. And as you'll see by running the code, this method could be extended to add a shortcut to any required folder obtainable via the SHGetSpecialFolderLocation API. Because the SILENT and NOCONFIRMATION flags are specified, the action will is transparent to the user.

I preparation for this demo create a folder and shortcut under the \Start Menu\Programs menu to simulate those that would be created by the setup program. For this demo I created a dummy folder named "MyApp", and into it copied an existing shortcut from another folder that I renamed "MyApp.lnk", (Naturally, as with all Windows shortcuts the .lnk extension is invisible.)

 BAS Module Code
None.

 Form Code
Start a new project, and to the form add a one text box (Text1), one label (Label1) and one command button (Command1). Set the Index property of the text box and label to 0 to create control arrays -- the code below takes care of creating the rest of the controls.

Before starting, create the test folder under \start menu\programs and add any shortcut to it, and name MyApp per the demo.  Later you would change the code in Command1 to correspond to the name of the application's program file folder and shortcut names. Once this has been completed, add the following to the form:


Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const ERROR_SUCCESS As Long = 0
Private Const CSIDL_PROGRAMS As Long = &H2
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10

Private Const FO_COPY As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_NOCONFIRMATION As Long = &H10

Private Type SHFILEOPSTRUCT
  hWnd      As Long
  wFunc      As Long
  pFrom      As String
  pTo        As String
  fFlags     As Integer
  fAborted   As Boolean
  hNameMaps  As Long
  sProgress  As String
End Type

Private Declare Function SHFileOperation Lib "shell32" _
   Alias "SHFileOperationA" _
  (lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
   pidl As Long) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long



Private Sub Form_Load()

   Dim cnt As Long
   
   For cnt = 0 To 5
   
      If cnt > 0 Then
         Load Text1(cnt)
         Load Label1(cnt)
      End If
      
      With Text1(cnt)
         .Text = ""
         .Move 2300, 300 + (cnt * 300), 6000, 285
         .Visible = True
         .Text = cnt
      End With
      
      With Label1(cnt)
         .Move 200, 310 + (cnt * 310), 100, 285
         .AutoSize = True
         .Visible = True

         Select Case cnt
            Case 0: .Caption = "User's Desktop path:"
            Case 1: .Caption = "User's Program Files path:"
            Case 2: .Caption = "Path to application link:"
            Case 3: .Caption = "Source link (path/file):"
            Case 4: .Caption = "Destination (path/file):"
            Case 5: .Caption = "Desktop link created:"
         End Select
         
      End With
   Next
   
End Sub


Private Sub Command1_Click()

   Dim sPathToDesktop As String
   Dim sPathToStartMenuPrograms As String
   Dim sPathToStartMenuProgramAppFolder As String
   Dim sNameOfShortcut As String
   Dim sSourceFileToCopy As String
   Dim sShortcutOnDesktop As String
   
  'path to the current user's Desktop folder
   sPathToDesktop = GetSpecialFolder(Me.hWnd, CSIDL_DESKTOPDIRECTORY)

  'path to the current user's Programs folder
   sPathToStartMenuPrograms = GetSpecialFolder(Me.hWnd, CSIDL_PROGRAMS)
   
  'path to application link folder under Programs
   sPathToStartMenuProgramAppFolder = QualifyPath(QualifyPath(sPathToStartMenuPrograms) & "MyApp")
  
  'name of shortcut in that folder (must specify the extension!)
   sNameOfShortcut = "MyApp.lnk"
   
  'path and name of file under programs folder
   sSourceFileToCopy = sPathToStartMenuProgramAppFolder & sNameOfShortcut
   
  'path and name of file expected on desktop
   sShortcutOnDesktop = QualifyPath(sPathToDesktop) & sNameOfShortcut
   
  'show the results
   Text1(0).Text = sPathToDesktop
   Text1(1).Text = sPathToStartMenuPrograms
   Text1(2).Text = sPathToStartMenuProgramAppFolder
   Text1(3).Text = sSourceFileToCopy
   Text1(4).Text = sShortcutOnDesktop

  'create the desktop link
   Call CreateDesktopLink(sSourceFileToCopy, sPathToDesktop)

  'confirm creation using Dir() returning the file name created
   Text1(5).Text = Dir(sShortcutOnDesktop)
   
End Sub


Private Sub CreateDesktopLink(sSource As String, sDestination As String)

   Dim SHFileOp As SHFILEOPSTRUCT
  
  'terminate passed strings with a null
   sSource = sSource & Chr$(0)
   sDestination = sDestination & Chr$(0)
  
  'set up the options
   With SHFileOp
     .wFunc = FO_COPY
     .pFrom = sSource
     .pTo = sDestination
     .fFlags = FOF_SILENT Or FOF_NOCONFIRMATION
   End With
   
  'and perform the copy
   Call SHFileOperation(SHFileOp)
  
End Sub


Private Function GetSpecialFolder(hWnd As Long, CSIDL As Long) As String

  Dim pidl As Long
  Dim sPath As String
     
 'fill the pidl with the specified folder item
   If SHGetSpecialFolderLocation(hWnd, CSIDL, pidl) = ERROR_SUCCESS Then
     
     'initialize & get the path
      sPath = Space$(260)

      If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
      
        'return folder
         GetSpecialFolder = TrimNull(sPath)
         
      End If
          
   End If
    
   Call CoTaskMemFree(pidl)
    
End Function


Private Function QualifyPath(sPath As String) As String
 
   If Len(sPath) > 0 Then
 
      If Right$(sPath, 1) <> "\" Then
         QualifyPath = sPath & "\"
      Else
         QualifyPath = sPath
      End If
   Else
      QualifyPath = ""
   End If
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function
 Comments
Run the project. If you've coded sPathToStartMenuProgramAppFolder and sNameOfShortcut path correctly, the name of the link should appear in Text1(5), and the shortcut will be on the desktop.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter