How do I use fCreateShellLink in VB6?
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 4 of 4

Thread: How do I use fCreateShellLink in VB6?

  1. #1
    Join Date
    Mar 2001
    Posts
    14

    How do I use fCreateShellLink in VB6?

    So far, all the examples that I have seen use STKIT432.dll or VB5STKIT.DLL. VB6STKIT.DLL, however, doesn't work the same as the older dll's.


    Declare Function fCreateShellLink Lib "VB6STKIT.DLL" (byval lpstrFolderName as string, byval lpstrLinkName as string, byval lpstrLinkPath as string, byval lpstrLinkArgs as string) as Long




    This code just causes the program to crash. In order to create a shortcut, I have to include the VB4 or VB5 dll in my project. Any suggestions?




  2. #2
    Join Date
    Jul 2000
    Location
    Milano, Italy
    Posts
    7,726

    Re: How do I use fCreateShellLink in VB6?

    Private Declare Function fCreateShellLink Lib "VB5STKIT.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
    Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    ' -> code by Raist Lin
    'Create a shell link on your desktop
    lngresult = fCreateShellLink("..\..\Desktop", "LINK", "C:\myfile.exe", "")
    End Sub

    '-------------
    'even this from api guide:
    'explanations of parameters:
    lpstrFolderName
    folder where to create the link

    lpstrLinkName
    text caption for the link

    lpstrLinkPath
    full path to the target of the link

    lpstrLinkArguments
    command-line arguments for the link


    Special thanks to Lothar "the Great" Haensler, Tom Archer, Chris Eastwood Bruno Paris and all the other wonderful people who made and make Codeguru a great place. Come back soon, you Gurus.
    ...at present time, using mainly Net 4.0, Vs 2010



    Special thanks to Lothar "the Great" Haensler, Chris Eastwood , dr_Michael, ClearCode, Iouri and
    all the other wonderful people who made and make Codeguru a great place.
    Come back soon, you Gurus.

  3. #3
    Join Date
    Mar 2001
    Posts
    14

    Re: How do I use fCreateShellLink in VB6?

    That code works using VB5STKIT.DLL. I was wondering if there was a way to do it using the VB6STKIT.DLL.


  4. #4
    Join Date
    Apr 2000
    Location
    South Carolina,USA
    Posts
    2,210

    Re: How do I use fCreateShellLink in VB6?

    Here is a module I use that contains fCreateShellLink and fGetShellLinkInfo plus a few others I am to lazy to strip out.
    YOu will need to obtain a copy of "Shelllnk.tlb" rom the VB CDROM. Register it using RegisterTLB.exe or this API

    private Declare Function RegisterTLB Lib "vb6stkit.dll" _
    (byval lpTLBName as string) as Integer
    ' Here is the Module
    '
    '
    option Explicit

    public Enum STGM
    STGM_DIRECT = &H0&
    STGM_TRANSACTED = &H10000
    STGM_SIMPLE = &H8000000
    STGM_READ = &H0&
    STGM_WRITE = &H1&
    STGM_READWRITE = &H2&
    STGM_SHARE_DENY_NONE = &H40&
    STGM_SHARE_DENY_READ = &H30&
    STGM_SHARE_DENY_WRITE = &H20&
    STGM_SHARE_EXCLUSIVE = &H10&
    STGM_PRIORITY = &H40000
    STGM_DELETEONRELEASE = &H4000000
    STGM_CREATE = &H1000&
    STGM_CONVERT = &H20000
    STGM_FAILIFTHERE = &H0&
    STGM_NOSCRATCH = &H100000
    End Enum
    '
    ' Shell Folder Path Constants...
    '
    ' on NT:
    ' ..\WinNT\profiles\username
    '
    ' on Windows 9x:
    ' ..\Windows
    public Enum SHELLFOLDERS
    CSIDL_DESKTOP = &H0& ' \Desktop
    CSIDL_PROGRAMS = &H2& ' \Start Menu\Programs
    CSIDL_CONTROLS = &H3& ' No Path
    CSIDL_PRINTERS = &H4& ' No Path
    CSIDL_PERSONAL = &H5& ' \Personal
    CSIDL_FAVORITES = &H6& ' \Favorites
    CSIDL_STARTUP = &H7& ' \Start Menu\Programs\Startup
    CSIDL_RECENT = &H8& ' \Recent
    CSIDL_SENDTO = &H9& ' \SendTo
    CSIDL_BITBUCKET = &HA& ' No Path
    CSIDL_STARTMENU = &HB& ' \Start Menu
    CSIDL_DESKTOPDIRECTORY = &H10& ' \Desktop
    CSIDL_DRIVES = &H11& ' No Path
    CSIDL_NETWORK = &H12& ' No Path
    CSIDL_NETHOOD = &H13& ' \NetHood
    CSIDL_FONTS = &H14& ' \fonts
    CSIDL_TEMPLATES = &H15& ' \ShellNew
    CSIDL_COMMON_STARTMENU = &H16& ' ..\WinNT\profiles\All Users\Start Menu
    CSIDL_COMMON_PROGRAMS = &H17& ' ..\WinNT\profiles\All Users\Start Menu\Programs
    CSIDL_COMMON_STARTUP = &H18& ' ..\WinNT\profiles\All Users\Start Menu\Programs\Startup
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19& '..\WinNT\profiles\All Users\Desktop
    CSIDL_APPDATA = &H1A& ' ..\WinNT\profiles\username\Application Data
    CSIDL_PRINTHOOD = &H1B& ' ..\WinNT\profiles\username\PrintHood
    End Enum

    public Enum SHOWCMDFLAGS
    SHOWNORMAL = 5
    SHOWMAXIMIZE = 3
    SHOWMINIMIZE = 7
    End Enum

    public Const MAX_PATH = 255

    Declare Function SHGetSpecialFolderLocation Lib "Shell32" (byval hWndOwner as Long, byval nFolder as Integer, ppidl as Long) as Long
    Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (byval pidl as Long, byval szPath as string) as Long

    public Function fCreateShellLink(sLnkFile as string, sExeFile as string, sWorkDir as string, _
    sExeArgs as string, sIconFile as string, lIconIdx as Long, _
    ShowCmd as SHOWCMDFLAGS, sDescription as string) as Long

    Dim cShellLink as ShellLinkA ' An explorer IShellLinkA(Win 9x/Win NT) instance
    Dim cPersistFile as IPersistFile ' An explorer IPersistFile instance

    If (sLnkFile = "") Or (sExeFile = "") then Exit Function

    on error GoTo fCreateShellLinkError
    set cShellLink = new ShellLinkA 'Create new IShellLink interface
    set cPersistFile = cShellLink 'Implement cShellLink's IPersistFile interface
    Dim Z
    With cShellLink
    'set command line exe name & path to new ShortCut.
    .SetPath sExeFile
    'set working directory in shortcut
    If sWorkDir <> "" then .SetWorkingDirectory sWorkDir
    'Add arguments to command line
    If sExeArgs <> "" then .SetArguments sExeArgs
    'set shortcut description
    .SetDescription sDescription
    ' If (LnkDesc <> "") then .SetDescription pszName
    'set shortcut icon location & index
    If sIconFile <> "" then .SetIconLocation sIconFile, lIconIdx

    'set shortcut's startup mode (min,max,normal)
    .SetShowCmd ShowCmd

    End With
    ' Const SLR_UPDATE = 0 since Const doesn't exist, Update mode must be assumed jgd

    cShellLink.Resolve 0, SLR_UPDATE
    cPersistFile.Save StrConv(sLnkFile, vbUnicode), 0 'Unicode conversion that must be done!
    fCreateShellLink = 0 'Return Success
    set cPersistFile = nothing
    set cShellLink = nothing
    Exit Function

    fCreateShellLinkError:
    fCreateShellLink = Err.Number ' return error to user
    set cPersistFile = nothing
    set cShellLink = nothing
    End Function
    public Function fGetSystemFolderPath(byval hwnd as Long, byval Id as Integer, sfPath as string) as Long
    Dim lReturn as Long
    Dim lPidl as Long
    Dim lPath as Long
    Dim sPath as string

    sPath = Space$(MAX_PATH)
    lReturn = SHGetSpecialFolderLocation(hwnd, Id, lPidl) ' get lPidl for Id...
    If lReturn = 0 then ' If success is 0
    lReturn = SHGetPathFromIDList(lPidl, sPath) ' get Path from Item Id List
    If lReturn = 1 then ' If success is 1
    sPath = Trim$(sPath) ' Fix path string
    lPath = len(sPath) ' get length of path
    If Asc(Right$(sPath, 1)) = 0 then lPath = lPath - 1 'Adjust path length
    If lPath > 0 then sfPath = Left$(sPath, lPath) ' Adjust path string variable
    fGetSystemFolderPath = true ' Return success
    End If
    End If
    End Function

    public Function fGetShellLinkInfo _
    (sLnkFile as string, sExeFile as string, sWorkDir as string, _
    sExeArgs as string, sIconFile as string, sDescription as string, _
    lIconIdx as Long, lShowCmd as Long, lPidl as Long, _
    lHotKey as Long) as Long
    Dim lBuffLen as Long
    Dim sTemp as string
    Dim cShellLink as ShellLinkA ' An explorer IShellLink instance
    Dim cPersistFile as IPersistFile ' An explorer IPersistFile instance
    Dim fd as WIN32_FIND_DATA
    Dim X as Long
    If sLnkFile = "" then Exit Function

    set cShellLink = new ShellLinkA ' Create new IShellLink interface
    set cPersistFile = cShellLink ' Implement cShellLink's IPersistFile interface

    'Load Shortcut file...(must do this UNICODE hack!)
    on error GoTo fGetShellLinkInfoError
    cPersistFile.Load StrConv(sLnkFile, vbUnicode), STGM_DIRECT

    With cShellLink
    'get command line exe name & path of shortcut
    sExeFile = Space$(MAX_PATH)
    lBuffLen = len(sExeFile)
    .GetPath sExeFile, lBuffLen, fd, SLGP_UNCPRIORITY
    StripNulls sExeFile
    sTemp = fd.cFileName ' Not returned to calling function

    'get working directory of shortcut
    sWorkDir = Space$(MAX_PATH)
    lBuffLen = len(sWorkDir)
    .GetWorkingDirectory sWorkDir, lBuffLen
    StripNulls sWorkDir
    'get command line arguments of shortcut
    sExeArgs = Space$(MAX_PATH)
    lBuffLen = len(sExeArgs)
    .GetArguments sExeArgs, lBuffLen
    StripNulls sExeArgs
    'get description of shortcut
    sDescription = Space$(MAX_PATH)
    lBuffLen = len(sDescription)
    .GetDescription sDescription, lBuffLen
    StripNulls sDescription
    'get the HotKey for shortcut
    .GetHotkey lHotKey '

    'get shortcut icon location & index
    sIconFile = Space$(MAX_PATH)
    lBuffLen = len(sIconFile)
    .GetIconLocation sIconFile, lBuffLen, lIconIdx
    StripNulls sIconFile
    'get Item ID List...
    .GetIDList lPidl '

    'set shortcut's startup mode (min,max,normal)
    .GetShowCmd lShowCmd
    End With
    fGetShellLinkInfo = true

    fGetShellLinkInfoError:
    set cPersistFile = nothing
    set cShellLink = nothing
    End Function



    public Sub StripNulls(byref S)
    Dim X
    X = InStr(S, Chr(0))
    If X > 0 then S = Left(S, X - 1)
    End Sub




    John G

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center