Creating shortcuts to files by Windows API

[Fabio Siciliano]

Hi folks,

Do you have any idea about creating shortcuts to files (I mean, soft links ".lnk") by Windows API in Liberty BASIC without using any thirdy party utility such as, for instance, OptimumX "shortcut.exe" (www.optimumx.com/download) or NirSoft "nircmd.exe" (www.nirsoft.net/utils/nircmd.html)?

Thank you in advance and best regards.
Fabio

[Brandon Parker]

Well, you can definitely do it this way for sure if you are using Windows. You may have to tell Windows 10 to keep using the standard scripting app the first time (uuggghhhh...annoying as usual). You can strip this down to bare-bones if you want to; I just post stuff as I have set it up for my programs in the past.

Global False : False = 0
Global True : True = 0

Dim Info$(0, 0)


lnkLocation$ = ""       'Location to create the .lnk file at
lnkName$ = ""           'Name of the .lnk file to be created
exeLocation$ = ""       'Location of the .exe file you want the .lnk file to point to
lnkIconLoc$ = ""        'Location of the icon you want the .lnk file to use (typically just point to the .exe file as well)
lnkDescription$ = ""    'Description to use in the .lnk file internal description
exeWorkDir$ = ""        'Working directory of the .exe file pointed to above
result = CreateLink(lnkLocation$, lnkName$, exeLocation$, lnkIconLoc$, lnkDescription$, exeWorkDir$)
End

'_________________________________________________________________________________________________________________________________________________________
'_________________________________________________________________________________________________________________________________________________________

   Function CreateLink(lnkLocation$, lnkName$, exeLocation$, lnkIconLoc$, lnkDescription$, exeWorkDir$)
       If lnkDescription$ = "" Then
           Prompt "Please provide a description for this link."; lnkDescription$
       End If
       data$ = "<package>" + chr$(13) + chr$(10) _
           + "<job id=" + chr$(34) + "vbs" + chr$(34) + ">" + chr$(13) + chr$(10) _
               + "<script language=" + chr$(34) + "VBScript" + chr$(34) + ">" + chr$(13) + chr$(10) _
                   + "set WshShell = WScript.CreateObject(" + chr$(34) + "WScript.Shell" + chr$(34) + ")" + chr$(13) + chr$(10) _
                   + "set oShellLink = WshShell.CreateShortcut(" + chr$(34) + lnkLocation$ + "\" + lnkName$ + ".lnk" + chr$(34) + ")" + chr$(13) + chr$(10) _
                   + "oShellLink.TargetPath = " + chr$(34) + exeLocation$ + chr$(34) + chr$(13) + chr$(10) _
                   + "oShellLink.WindowStyle = 1" + chr$(13) + chr$(10) _
                   + "oShellLink.IconLocation = " + chr$(34) + lnkIconLoc$ + ", 0" + chr$(34) + chr$(13) + chr$(10) _
                   + "oShellLink.Description = " + chr$(34) + lnkDescription$ + chr$(34) + chr$(13) + chr$(10) _
                   + "oShellLink.WorkingDirectory = " + chr$(34) + exeWorkDir$ + chr$(34) + chr$(13) + chr$(10) _
                   + "oShellLink.Save" + chr$(13) + chr$(10) _
                   + "</script>" + chr$(13) + chr$(10) _
               + "</job>" + chr$(13) + chr$(10) _
           + "</package>"
       result$ =  OpenFile$(DefaultDir$ + "\" + CurrentUser$ + "CreateIcon.wsf", "Output", data$)
       file$ = DefaultDir$ + "\" + CurrentUser$ + "CreateIcon.wsf"
       'result = 5000
       CallDLL #shell32, "ShellExecuteA", 0 As long, "Open" As ptr, file$ As ptr, "" As ptr, "" As ptr, 8 As long, result As long
       'CallDLL #kernel32, "WaitForSingleObject", result As long, 1500 As long, result2 As long
       CallDLL #kernel32, "Sleep", 1500 As uLong, result As Void
       'Use fileExists() to test for the existence of the .lnk file
       If fileExists(lnkLocation$, lnkName$ + ".lnk") > False Then
           CreateLink = True
       Else
           CreateLink = False
           Notice "- SYSTEM ERROR! -" + chr$(13) + "Error creating the Shortcut - [" + lnkName$ + ".lnk] file."
       End If
       If fileExists(DefaultDir$, CurrentUser$ + "CreateIcon.wsf") > False Then
           Kill DefaultDir$ + "\" + CurrentUser$ + "CreateIcon.wsf"
       End If
   End Function

'_________________________________________________________________________________________________________________________________________________________
'_________________________________________________________________________________________________________________________________________________________

   Function OpenFile$(filepath$, InOut$, data$)
       On Error GoTo [Error]
           Select Case InOut$
               Case "BinaryInput"
                   Open filepath$ For Binary As #OpenFile
                   fileOpened = True
                   OpenFile$ = Trim$(Input$(#OpenFile, LOF(#OpenFile)))
               Case "Input"
                   Open filepath$ For Input As #OpenFile
                   fileOpened = True
                   OpenFile$ = Trim$(Input$(#OpenFile, LOF(#OpenFile)))
               Case "BinaryOutput"
                   Open filepath$ For Binary As #OpenFile
                   fileOpened = True
               Case "Output"
                   Open filepath$ For Output As #OpenFile
                   fileOpened = True
               Case "BinaryAppend"
                   Open filepath$ For Binary As #OpenFile
                   fileOpened = True
               Case "Append"
                   Open filepath$ For Append As #OpenFile
                   fileOpened = True
           End Select
           If (Instr(InOut$, "Output") > False) Or (Instr(InOut$, "Append") > False) Then
               #OpenFile data$;
               OpenFile$ = str$(True)
           End If
           Close #OpenFile
           Exit Function
       [Error]
           If (fileOpened = True) Then Close #OpenFile
   End Function

'_________________________________________________________________________________________________________________________________________________________
'_________________________________________________________________________________________________________________________________________________________

   Function fileExists(path$, filename$)
       Files path$, filename$, Info$()
       fileExists = Val(Info$(0, 0))
       ReDim Info$(0, 0)
   End Function


{:0)

Brandon Parker

[Fabio Siciliano]

Hi Brandon, cool, thank you. Yes, you're right, the user may have to tell Windows 10 to keep using the standard scripting app the first time (and frankly I hate it!)... if it was some kind of trick to avoid it at all, it could be great! But I still wonder if there is a quite badly undocumented way to do it directly from Windows API, without using any scripting language, I mean throughout native Windows API only. I am very disappointed by the fact that sometimes Windows does not offer straightforward ways to do some basic stuff... it seems, sometimes, that folks made things difficult on purpose.

[bonkyboat]

HomeFa$="5-1":AwayFa$="4-3":HomeHud$="02U":AwayHud$="03D":Year$="2022"
a$="d:\uk databases\"+Year$+"\supdowns\[5-1]-[4-3]\"+HomeHud$+"-"+AwayHud$+"\"
result=mkdir( a$ )

can anyone tell me why this does not create the directory? The fixed folder names exist. Thankyou in advance

[tenochtitlanuk]

I suspect mkdir only operates one level at a time. So for me the following example works.
path$ ="C:/"

for level =0 to 4
   n$          =path$ +"Level_" +str$( level)
   print n$
   result      =mkdir( n$ +"/")
   if result <> 0 then print "Directory not created"
   path$       =n$ +"/"
next level


C:/Level_0
C:/Level_0/Level_1
C:/Level_0/Level_1/Level_2
C:/Level_0/Level_1/Level_2/Level_3
C:/Level_0/Level_1/Level_2/Level_3/Level_4


You'd obviously use each successive deeper-level directory name rather than a synthesized one.

Note code will error out if the directories already exist so you may want to add if_dir_exists check.

You specify spaces in your filename/path. This is usually permissible if you 'quote' the string with surrounding chr$( 34) quotes- but it wouldn't work for me on my set up. ( Linuz/Wine) Underscore symbols look good and work without problems.

[Brandon Parker]

@bonkyboat

Please create a new thread when you are asking a question unrelated to the OP's question...thanks!!


@Fabio Siciliano

I definitely understand what you mean. This is just how I have done it in the past on Windows. I think I looked into it and it was going to be more trouble or possibly impossible with LB back when I came up with this solution.

{:0)

Brandon Parker

[Chris Iverson]

Here's some sample code written by a user who came up with a very crafty solution to be able to use the COM API in LB(COM is necessary to interface with some windows shell APIs, including the ones that handle link/shortcut generation and resolution).

' Create and store a shortcut, version 1.0, 03-Nov-2013
' Demonstrates calling COM methods from Liberty BASIC!
' (C) Richard Russell 2013

   call shortcut SpecialFolder$(0) + "\Test Shortcut.lnk", _
                 StartupDir$ + "\lbpro.exe", _
                 DefaultDir$, _
                 "Test shortcut created by Liberty BASIC"
   end

' Use the IShellLink and IPersistFile COM interfaces to
' create and store a shortcut to the specified object.
' LnkFile$ - the path/filename of the shortcut (.LNK)
' Target$  - the object for which to create a shortcut
' StartIn$ - the working directory to start in
' Comment$ - the description of the shortcut
sub shortcut LnkFile$, Target$, StartIn$, Comment$

   open "OLE32.DLL" for DLL as #ole32
   calldll #ole32, "CoInitialize", 0 as long, r as long

   struct clsid, a as long, b as long, c as long, d as long
   struct iidsl, a as long, b as long, c as long, d as long
   struct iidpf, a as long, b as long, c as long, d as long

   clsid.a.struct = hexdec("00021401") ' CLSID_ShellLink
   clsid.b.struct = hexdec("00000000")
   clsid.c.struct = hexdec("000000C0")
   clsid.d.struct = hexdec("46000000")

   iidsl.a.struct = hexdec("000214EE") ' IID_IShellLink
   iidsl.b.struct = hexdec("00000000")
   iidsl.c.struct = hexdec("000000C0")
   iidsl.d.struct = hexdec("46000000")

   iidpf.a.struct = hexdec("0000010B") ' IID_IPersistFile
   iidpf.b.struct = hexdec("00000000")
   iidpf.c.struct = hexdec("000000C0")
   iidpf.d.struct = hexdec("46000000")

   ' Get a pointer to the IShellLink interface:
   CLSCTX.INPROC.SERVER = 1
   struct temp, v as long
   calldll #ole32, "CoCreateInstance", clsid as struct, 0 as long, _
                   CLSCTX.INPROC.SERVER as long, iidsl as struct, _
                   temp as struct, r as long
   psl = temp.v.struct
   if psl = 0 then notice "Cannot create IShellLink interface" : end

   ' Set the target object, working directory and description:
   struct parm, psz as ptr
   parm.psz.struct = Target$
   result = CallMethod(psl, 20, parm.struct) ' IShellLink::SetPath
   parm.psz.struct = StartIn$
   result = CallMethod(psl, 9, parm.struct) ' IShellLink::SetWorkingDirectory
   parm.psz.struct = Comment$
   result = CallMethod(psl, 7, parm.struct) ' IShellLink::SetDescription

   ' Query IShellLink for the IPersistFile interface:
   struct temp, v as long
   struct parm, iid as struct, ppv as struct
   parm.iid.struct = iidpf.struct
   parm.ppv.struct = temp.struct
   result = CallMethod(psl, 0, parm.struct) ' IShellLink::QueryInterface
   temp.struct = parm.ppv.struct
   ppf = temp.v.struct
   IF ppf = 0 then notice "Cannot create IPersistFile interface" : end

   ' Convert the path/filename string to Unicode:
   wsz$ = space$(2*len(LnkFile$) + 2)
   n = len(wsz$) / 2
   calldll #kernel32, "MultiByteToWideChar", 0 as long, 0 as long, _
                      LnkFile$ as ptr, -1 as long, wsz$ as ptr, _
                      n as long, r as long

   ' Save the shortcut:
   struct parm, pszFilename as ptr, fRemember as long
   parm.pszFilename.struct = wsz$
   parm.fRemember.struct = 1
   result = CallMethod(ppf, 6, parm.struct) ' IPersistFile::Save

   ' Tidy up:
   result = CallMethod(ppf, 2, "") ' IPersistFile::Release
   result = CallMethod(psl, 2, "") ' IShellLink::Release
   calldll #ole32, "CoUninitialize", r as void
   close #ole32
end sub

' Call a COM method:
' object - a pointer to the COM object interface
' method - the zero-based index of the method to be called
' parm$  - a structure containing the parameters to be passed
function CallMethod(object, method, parm$)
   code$ = chr$(139)+"D$"+chr$(4)+chr$(139)+"T$"+chr$(8)+chr$(139)+"L$" _
   + chr$(16)+"VW"+chr$(139)+"t$"+chr$(20)+chr$(43)+chr$(225)+chr$(139) _
   + chr$(252)+chr$(243)+chr$(164)+chr$(80)+chr$(139)+chr$(0)+chr$(255) _
   + chr$(20)+chr$(144)+chr$(95)+chr$(94)+chr$(194)+chr$(16)+chr$(0)

   p$ = parm$
   n = len(p$)
   calldll #user32, "CallWindowProcA", code$ as ptr, object as long, _
           method as long, p$ as ptr, n as long, CallMethod as long
end function

' Get the location of a Special Folder:
function SpecialFolder$(csidl)
   struct idl, pp as long
   calldll #shell32, "SHGetSpecialFolderLocation", _
     0 as long, csidl as long, idl as struct, r as long
   if r = 0 then
     path$ = space$(_MAX_PATH)
     ppidl = idl.pp.struct
     calldll #shell32, "SHGetPathFromIDListA", _
       ppidl as long, path$ as ptr, r as long
     SpecialFolder$ = trim$(path$)
     open "OLE32.DLL" for DLL as #ole32
     calldll #ole32, "CoTaskMemFree", ppidl as long, _
       r as long
     close #ole32
   end if
end function