File "linkmaker.bas"
Path: /linkmaker/linkmaker.bas
File size: 12.96 KB
MIME-type:
Charset: utf-8
#COMPILE EXE "linkmaker.exe"
#DIM ALL
#RESOURCE "linkmaker.pbr"
$SRC = "http://mougino.free.fr/code/linkmaker/linkmaker.bas"
$VER = "0.3"
'------------------------------------------------------------------------------
' ** Changelog **
'------------------------------------------------------------------------------
' - v0.3 (2026-01-21)
' o re-write GUI
' o add support for command line - type: linkmaker /?
' o allow to create internet url shortcuts
' o add a program updater
' o fix for Wine 11.0 breaking 'start.exe' retrocompatibility
' - v0.2 (2025-10-07)
' o allow multiple selection in order to mass-create shortcuts
' o propose to install program as a Linux App
' o improve behavior in Linux
' - v0.1 (2025-09-29)
' o Initial release
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "INC/MYMSGBOX.INC"
#INCLUDE ONCE "INC/SHORTCUT.INC"
#INCLUDE ONCE "INC/EXE2UNIX.INC"
#INCLUDE ONCE "INC/SELFUPDATE.INC"
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Globals **
'------------------------------------------------------------------------------
GLOBAL file() AS STRING
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
#IF NOT %DEF(%FN_EXISTS)
%FN_EXISTS = -1
FUNCTION EXISTS(BYVAL fileOrFolder AS STRING) AS LONG
LOCAL Dummy&
Dummy& = GETATTR(fileOrFolder)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
#ENDIF
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
LOCAL arg AS STRING
LOCAL sav AS STRING
LOCAL i AS LONG
' Create exe icon in Unix dock and Unix file explorer
Me2Unix 1, 1 ' askConfirmation=%TRUE, showInAppMenu=%TRUE
' Parse arguments
arg = TRIM$(COMMAND$(1), ANY $SPC+$TAB+$DQ)
' Argument is "/?" : display program version
IF arg = "/?" THEN
? "-= " + EXE.NAMEX$ + " v" + $VER + " =-" + $CRLF + $CRLF _
+ "Usage:" + $CRLF _
+ "linkmaker http://mougino.free.fr" + $CRLF _
+ "-or-" + $CRLF _
+ "linkmaker C:\folder\file1 D:\folder\file2 ..." + $CRLF + $CRLF _
+ "-------------------" + $CRLF _
+ "visit http://mougino.free.fr" _
,%MB_ICONINFORMATION,EXE.NAME$
EXIT FUNCTION
END IF
' If no argument passed: display main dialog
arg = TRIM$(COMMAND$, ANY $SPC+$TAB+$DQ)
IF arg = "" THEN
FUNCTION = ShowMain(0)
EXIT FUNCTION
END IF
' Else treat arguments:
i = INSTR(arg, "http")
' Argument is of the form "http(s)://..." > create internet url shortcut
IF i = 1 THEN
sav = SaveAsUrl(0, EXE.PATH$ + "New Internet Shortcut.url")
IF sav = "" THEN EXIT FUNCTION ' canceled by user
CreateUrl sav, arg ' create internet shorcut
SelectFile sav ' then select it in explorer
EXIT FUNCTION ' and quit
END IF
' Else assume argument is a list of files
REDIM file(1 TO 99)
i = 1
DO
file(i) = TRIM$(COMMAND$(i), ANY $SPC+$TAB+$DQ)
INCR i
LOOP UNTIL file(i) = "" OR i > 99
DECR i
REDIM PRESERVE file(1 TO i)
sav = CreateLnks(0) ' create file shortcut(s) based on file()
IF sav = "" THEN EXIT FUNCTION ' canceled by user
SelectFile sav ' select first shortcut in explorer
EXIT FUNCTION ' and quit
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION SaveAsLnk(BYVAL hDlg AS DWORD, BYVAL defPath AS STRING) AS STRING
' Open a file picker to save as a .lnk
LOCAL sav AS STRING
DISPLAY SAVEFILE hDlg, , , "Save as:", PATHNAME$(PATH, defPath), _
CHR$("Shortcut file (*.lnk)", 0, "*.lnk", 0), PATHNAME$(NAMEX, defPath), "lnk", _
%OFN_PATHMUSTEXIST OR %OFN_SHOWHELP OR %OFN_NONETWORKBUTTON OR _
%OFN_ENABLESIZING OR %OFN_OVERWRITEPROMPT TO sav
FUNCTION = sav
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION SaveAsUrl(BYVAL hDlg AS DWORD, BYVAL defPath AS STRING) AS STRING
' Open a file picker to save as a .url
LOCAL sav AS STRING
DISPLAY SAVEFILE hDlg, , , "Save as:", PATHNAME$(PATH, defPath), _
CHR$("Internet shortcut (*.url)", 0, "*.url", 0), PATHNAME$(NAMEX, defPath), "url", _
%OFN_PATHMUSTEXIST OR %OFN_SHOWHELP OR %OFN_NONETWORKBUTTON OR _
%OFN_ENABLESIZING OR %OFN_OVERWRITEPROMPT TO sav
FUNCTION = sav
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB CreateUrl(BYVAL sav AS STRING, BYVAL url AS STRING)
' Create internet address shortcut
LOCAL ff AS LONG
ff = FREEFILE
OPEN sav FOR OUTPUT AS #ff
PRINT #ff, "[InternetShortcut]"
PRINT #ff, "URL=" + url
CLOSE #ff
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION CreateLnks(BYVAL hDlg AS DWORD) AS STRING
' Create file shortcut(s) based on global var file(), return first file created
LOCAL lnk AS LINKTYPE
LOCAL i, cnt AS LONG
LOCAL sav AS STRING
cnt = UBOUND(file)
' Allow to specify target in case of single file
IF cnt = 1 THEN
sav = SaveAsLnk(hDlg, file(1) + ".lnk")
IF sav = "" THEN EXIT FUNCTION ' canceled by user
END IF
' Create shortcut(s)
FOR i = 1 TO cnt
lnk.zLinkFolder = PATHNAME$(PATH, IIF$(cnt=1, sav, file(i)))
lnk.zLinkName = PATHNAME$(NAMEX, IIF$(cnt=1, sav, file(i))) + IIF$(cnt=1, "", ".lnk")
lnk.zExeName = file(i)
lnk.zWorkDir = PATHNAME$(PATH, file(i))
WriteShortcut lnk
' And reveal their icon if they're shortcuts to .exe files
IF RIGHT$(LCASE$(file(i)), 4) = ".exe" THEN
FileIco2Unix IIF$(cnt=1, sav, file(i) + ".lnk"), IcoStrip2Unix(file(i))
END IF
NEXT
' Return first created shortcut
FUNCTION = IIF$(cnt=1, sav, file(1) + ".lnk")
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB SelectFile(BYVAL file AS STRING)
' Open the Windows explorer / Nautilus with selection of a file
IF IsOnUnix() THEN
UnixShell "/usr/bin/nautilus " + $DQ + UnixPath(file) + $DQ
ELSE
ShellExecute BYVAL 0, "open", "explorer.exe", "/select," _
+ $DQ + file + $DQ, BYVAL 0, %SW_SHOWNORMAL
END IF
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION ShowMain(BYVAL hParent AS DWORD) AS LONG
LOCAL hDlg AS DWORD
LOCAL hFont AS DWORD
LOCAL lRes AS LONG
LOCAL e AS STRING
DIALOG NEW PIXELS, hParent, "Create Shortcut",,, 424, 226, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET ICON hDlg, "AICO"
e = "What item would you like to create a shortcut for?"
CONTROL ADD LABEL, hDlg, 998, e, 8, 8, 392, 16
FONT NEW "MS Sans Serif", 10, 0, %ANSI_CHARSET TO hFont
CONTROL SET FONT hDlg, 998, hFont
CONTROL SET COLOR hDlg, 998, RGB(0, 0, 128), -1
e = "You can create shortcuts to internet addresses or local files."
CONTROL ADD LABEL, hDlg, 999, e, 8, 34, 392, 16
e = "Type the location of the item:"
CONTROL ADD LABEL, hDlg, 999, e, 8, 56, 392, 16
CONTROL ADD TEXTBOX, hDlg, 1000, "", 8, 72, 344, 20
CONTROL ADD BUTTON, hDlg, 1001, "&Browse", 352, 72, 48, 20
CONTROL ADD LABEL, hDlg, 999, "Click Next to continue.", 8, 112, 392, 16
CONTROL ADD BUTTON, hDlg, %IDOK, "&Next", 298, 168, 56, 24
CONTROL DISABLE hDlg, %IDOK
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 360, 168, 56, 24
DIALOG SHOW MODAL hDlg, CALL ProcMain TO lRes
FONT END hFont
FUNCTION = lRes
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain()
LOCAL sav AS STRING
LOCAL e AS STRING
LOCAL cnt AS LONG
LOCAL i AS LONG
M_SELF_UPDATE
SELECT CASE AS LONG CB.MSG
CASE %WM_INITDIALOG
' Initialization handler
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CB.CTL
CASE 1000 ' User typed in Textbox
'---------------------------------------------------
CONTROL GET TEXT CB.HNDL, 1000 TO e
IF INSTR(e, "http://") > 0 _
OR INSTR(e, "https://") > 0 THEN
CONTROL ENABLE CB.HNDL, %IDOK ' Next button
END IF
CASE 1001 ' User clicked Browse button
'--------------------------------------------------------
' Offer to pick 1 or more file(s)
DISPLAY OPENFILE CB.HNDL,,, "Create shortcut from file(s)...", "", _
CHR$("Everything (*.*)", 0, "*.*", 0), "", "", %OFN_FILEMUSTEXIST OR _
%OFN_SHOWHELP OR %OFN_NONETWORKBUTTON OR %OFN_ENABLESIZING _
OR %OFN_ALLOWMULTISELECT OR %OFN_NODEREFERENCELINKS TO sav, cnt
IF sav = "" OR cnt = 0 THEN EXIT FUNCTION ' canceled by user
CONTROL ENABLE CB.HNDL, %IDOK ' Next button
' Split files in case of multiselect, and populate textbox
REDIM file(1 TO cnt)
IF cnt = 1 THEN
file(1) = TRIM$(sav, $NUL)
CONTROL SET TEXT CB.HNDL, 1000, file(1)
ELSE
e = ""
FOR i = 1 TO cnt
file(i) = PARSE$(sav,CHR$(0),1) + "\" + PARSE$(sav,CHR$(0),i+1)
e += $DQ + PARSE$(sav,CHR$(0),i+1) + $DQ + ", "
NEXT
e = LEFT$(e, -2)
CONTROL SET TEXT CB.HNDL, 1000, e
END IF
CASE %IDOK ' User clicked Next button
'------------------------------------------------------
' Create internet url shortcut
'- - - - - - - - - - - - - - -
CONTROL GET TEXT CB.HNDL, 1000 TO e
i = INSTR(e, "http")
IF i > 0 THEN
e = MID$(e, i)
sav = SaveAsUrl(CB.HNDL, EXE.PATH$ + "New Internet Shortcut.url")
IF sav = "" THEN EXIT FUNCTION ' canceled by user
CreateUrl sav, e ' create internet shorcut
SelectFile sav ' then select it in explorer
DIALOG END CB.HNDL, -1 ' and quit
END IF
' Create file(s) shortcut(s)
' - - - - - - - - - - - - - -
sav = CreateLnks(CB.HNDL) ' create file shortcut(s) based on file()
IF sav = "" THEN EXIT FUNCTION ' canceled by user
SelectFile sav ' select first shortcut in explorer
DIALOG END CB.HNDL, -1 ' and quit
CASE %IDCANCEL ' User clicked Cancel button
'--------------------------------------------------------
DIALOG END CB.HNDL, 0
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------