File "VLC Shortcut Play Folder.bas"
Path: /VLC Shortcut Play Folder/VLC Shortcut Play Folder.bas
File size: 9.89 KB
MIME-type: text/plain
Charset: utf-8
#COMPILER PBWIN 9
#COMPILE EXE
#REGISTER NONE
#DIM ALL
#RESOURCE "VSPF.PBR"
$VER = "1.3"
'------------------------------------------------------------------------------
' Changelog
'------------------------------------------------------------------------------
' v1.3 (2026-01-21) Fix for Wine 11.0 breaking 'start.exe' retrocompatibility
' v1.2 (2025-10-10) Now vlcrun and Linux compatible
' v1.1 (2025-07-14) Now compatible with VLC Portable
' v1.0 (2025-01-28) Initial release
'------------------------------------------------------------------------------
' Include files
'------------------------------------------------------------------------------
%USEMACROS = 1
MACRO MyMsgBox(hd,m,t,st) = MessageBox(hd,m,t,st)
#INCLUDE ONCE "Win32API.inc"
#INCLUDE ONCE "ShFolder.inc"
#INCLUDE ONCE "CommCtrl.inc"
#INCLUDE ONCE "inc/SavePos.inc"
#INCLUDE ONCE "inc/DragnDrop.inc"
#INCLUDE ONCE "inc/CreateShortcut.inc"
#INCLUDE ONCE "inc/Registry.inc"
#INCLUDE ONCE "inc/Exe2Unix.inc"
'------------------------------------------------------------------------------
' Equates
'------------------------------------------------------------------------------
%IDC_LABEL1 = %WM_USER + 2110 ' control ids
%IDC_CHECKBOX1 = %WM_USER + 2111
%IDC_BTNPATH = %WM_USER + 2120
%IDC_BTNBUILD = %WM_USER + 2121
%IDC_TXT1 = %WM_USER + 2140
%IDC_TXT2 = %WM_USER + 2141
'------------------------------------------------------------------------------
' Global variables
'------------------------------------------------------------------------------
GLOBAL ghDlg AS DWORD ' main dialog's handle
GLOBAL ghIcon AS DWORD ' main dialog's icon handle
GLOBAL gStartPath AS STRING ' path of video folder
GLOBAL VlcPath AS STRING
'------------------------------------------------------------------------------
' Util functions
'------------------------------------------------------------------------------
SUB SetNewPath()
' Set new start path
gStartPath = RTRIM$(gStartPath, ANY "\/")
CONTROL SET TEXT ghDlg, %IDC_TXT1, gStartPath
CONTROL ENABLE ghDlg, %IDC_BTNBUILD
END SUB
'------------------------------------------------------------------------------
#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
'------------------------------------------------------------------------------
FUNCTION GetVlcPath() AS STRING
LOCAL e, r, r2 AS STRING
' vlcrun
r = DIR$(EXE.PATH$ + "vlcrun.exe") : DIR$ CLOSE
IF r <> "" THEN FUNCTION = r : EXIT FUNCTION
' VLC Portable
r = DIR$(EXE.PATH$ + "VlcPortable*", ONLY %SUBDIR) : DIR$ CLOSE
IF r <> "" THEN
r = EXE.PATH$ + r + "\"
r2 = DIR$(r + "VLC*.exe")
IF r2 <> "" THEN r += r2 ELSE r = ""
IF r <> "" THEN FUNCTION = r : EXIT FUNCTION
END IF
' Specific if we run from Unix/Wine
IF IsOnUnix() THEN
LET r = GetUnixRet("whereis vlc")
IF LEN(r) THEN
' Parse the vlc path from the string "vlc: /usr/bin/vlc /usr/lib/x86_64-linux-gnu/vlc ..."
r = TRIM$(MID$(r, INSTR(r,":") + 1))
IF INSTR(r, " ") THEN r = LEFT$(r, INSTR(r," ") - 1)
END IF
IF r = "" AND UnixExists("/usr/bin/vlc") THEN r = "/usr/bin/vlc"
FUNCTION = r : EXIT FUNCTION
END IF
' Run from Windows: get VLC path from registry
LET r = GETREGVALUE(%HKEY_LOCAL_MACHINE, "SOFTWARE\VideoLAN\VLC", "")
IF r <> "" THEN FUNCTION = r : EXIT FUNCTION
' Not found in default key > try another key
LET r = GETREGVALUE(%HKEY_LOCAL_MACHINE, "SOFTWARE\VideoLAN\VLC", "InstallDir")
IF r <> "" THEN r += "\vlc.exe" : FUNCTION = r : EXIT FUNCTION
' Not found via registry > try a manual method
r = "C:\Program Files (x86)\VideoLAN\VLC\"
e = DIR$(r + "vlc.exe") : DIR$ CLOSE
IF e <> "" THEN r += e : FUNCTION = r : EXIT FUNCTION
' Last attempt...
r = "C:\Program Files\VideoLAN\VLC\"
e = DIR$(r + "vlc.exe") : DIR$ CLOSE
IF e <> "" THEN r += e : FUNCTION = r : EXIT FUNCTION
END FUNCTION
'------------------------------------------------------------------------------
' Main callback
'------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc () AS LONG
LOCAL t AS STRING
LOCAL r AS STRING
LOCAL i AS LONG
' Callback handlers
CB_DRAGNDROP
CB_SAVEPOS
SELECT CASE CB.MSG
CASE %WM_SETCURSOR ' change cursor to link-hand when hovering over icons
i = GetDlgCtrlId(CB.WPARAM)
IF i = %IDC_TXT2 THEN
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
CASE %WM_INITDIALOG
CONTROL SET CHECK CB.HNDL, %IDC_CHECKBOX1, 1
CASE %WM_COMMAND
IF CB.CTLMSG <> %BN_CLICKED THEN EXIT SELECT
SELECT CASE CB.CTL
CASE %IDCANCEL
DIALOG END CB.HNDL
CASE %IDC_TXT2
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
ShellExecute %NULL, "open", "http://mougino.free.fr/freeware", "", "", %SW_SHOW
END IF
CASE %IDC_BTNPATH
' Change path of video folder
DISPLAY BROWSE CB.HNDL,,, "", "", %BIF_RETURNONLYFSDIRS OR %BIF_DONTGOBELOWDOMAIN OR %BIF_NONEWFOLDERBUTTON TO gStartPath
IF LEN(gStartPath) THEN
SetNewPath()
END IF
CASE %IDC_BTNBUILD
' Save shortcut as... (ask to replace if it already exists)
DISPLAY SAVEFILE 0,,, "Save as...", LEFT$(gStartPath,3), _
"Shortcut" + CHR$(0) + "*.lnk" + CHR$(0), _
PATHNAME$(NAME, gStartPath)+".lnk", "lnk", _
%OFN_PATHMUSTEXIST OR %OFN_OVERWRITEPROMPT TO t
IF t = "" THEN EXIT FUNCTION ' Cancelled by user
' Replace if existing
IF EXISTS(t) THEN KILL t
' Random play option?
CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX1 TO i
IF i = 0 THEN r = "" ELSE r = "--random "
' Create shortcut
CreateShortcut _
t, _ ' 1. the link file to be created
VlcPath, _ ' 2. the file/document where the shortcut should point to
r + $DQ + gStartPath + $DQ, _ ' 3. command-line parameters
gStartPath, _ ' 4. the folder where the executable file should start in
%SW_SHOW, _ ' 5. %SW_SHOW, %SW_HIDE etc.
VlcPath, _ ' 6. icon file or executable file containing an icon
0, _ ' 7. icon index in the aforementioned file
("(c) mougino.free.fr 2024") ' 8. any comment (stored in the shortcut)
' Display created shortcut in Windows Explorer
ShellExecute 0, "open", "explorer.exe" + CHR$(0), "/select," _
+ $DQ + t + $DQ + CHR$(0), "", %SW_SHOW
END SELECT
CASE %WM_DESTROY
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
' Main entry point for the application
'------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL r AS STRING
' Create exe icon in Unix dock and Unix file explorer
Me2Unix 0, 0 ' askConfirmation=%FALSE, showInAppMenu=%FALSE
' Get VLC path (or vlcrun, VLC Portable...)
LET VlcPath = GetVlcPath()
' Create dialog
DIALOG NEW %HWND_DESKTOP, EXE.NAME$ + $SPC + $VER,,, 258, 40, _
%WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO ghDlg
DIALOG SET ICON ghDlg, "ICO1"
CONTROL ADD LABEL, ghDlg, -1, "Folder :", 5, 6, 35, 12
CONTROL ADD TEXTBOX, ghDlg, %IDC_TXT1, "", 40, 4, 150, 12
r = "Browse for a folder or drag'n drop one here ^"
CONTROL ADD LABEL, ghDlg, %IDC_LABEL1, r, 5, 22, 150, 10, _
%SS_PATHELLIPSIS OR %WS_CHILD OR %WS_VISIBLE, %WS_EX_LEFT OR %WS_EX_LTRREADING
CONTROL ADD CHECKBOX,ghDlg, %IDC_CHECKBOX1, "Random play", 150, 22, 60, 10, %SS_RIGHT
CONTROL ADD BUTTON, ghDlg, %IDC_BTNPATH, "...", 190, 4, 12, 12
CONTROL ADD BUTTON, ghDlg, %IDC_BTNBUILD, "&Create", 212, 6, 40, 18, %WS_TABSTOP OR %BS_DEFAULT
CONTROL DISABLE ghDlg, %IDC_BTNBUILD
CONTROL ADD LABEL, ghDlg, %IDC_TXT2, "[?]", 246, 29, 8, 12, %SS_NOTIFY
CONTROL SET COLOR ghDlg, %IDC_TXT2, %BLUE, -1
' Show dialog
DIALOG SHOW MODAL ghDlg CALL DlgProc
END FUNCTION
'------------------------------------------------------------------------------
' File dropped management
'------------------------------------------------------------------------------
SUB FileDropped(BYVAL myfile AS STRING)
LOCAL hSearch AS DWORD ' Search handle
LOCAL WFD AS WIN32_FIND_DATA ' FindFirstFile structure
LOCAL imglst AS STRING ' Path to existing image list
LOCAL xt AS STRING ' File extension
LOCAL r AS STRING ' Cmd result
LOCAL i AS LONG ' Enumerator
hSearch = FindFirstFile((myfile), WFD) ' Get search handle
FindClose hSearch
IF hSearch <> %INVALID_HANDLE_VALUE THEN
IF (WFD.dwFileAttributes AND _
%FILE_ATTRIBUTE_DIRECTORY) _ ' If it's a directory
= %FILE_ATTRIBUTE_DIRECTORY THEN
gStartPath = myfile ' Set the path
SetNewPath()
END IF
END IF
END SUB