File "MyWebradios.bas"
Path: /MyWebradios/MyWebradios.bas
File size: 36.03 KB
MIME-type: text/plain
Charset: utf-8
#DIM ALL
#COMPILER PBWIN 9
#COMPILE EXE "MyWebradios.exe"
#RESOURCE "mwr.pbr"
$MWR = "MyWebradios"
$VER = "1.5"
$SRC = "http://mougino.free.fr/code/MyWebradios/MyWebradios.bas"
'------------------------------------------------------------------------------
' Changelog:
' ----------
' v1.5 (2026-01-21)
' - Fix for Wine 11.0 breaking 'start.exe' retrocompatibility
' v1.4 (2026-01-13)
' - Add a program updater!
' v1.3 (2025-10-10)
' - New feature: adblocker! mutes radio until next song
' - Now fully Linux compatible! registers as a Linux App
' - Improve GUI by showing selected webradio
' v1.2 (2025-08-03)
' - Save/restore volume level
' v1.1 (2025-07-13)
' - Mousewheel up/down increases/decreases the volume
' v1.0 (2025-01-28)
' - Initial release
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "ShFolder.inc"
#INCLUDE ONCE "inc\Bass.inc"
#INCLUDE ONCE "inc\Ini.inc"
#INCLUDE ONCE "inc\Registry.inc"
#INCLUDE ONCE "inc\MyMsgBox.inc"
#INCLUDE ONCE "inc\Icon.inc"
#INCLUDE ONCE "inc\SavePos.inc"
#INCLUDE ONCE "inc\Tooltip.inc"
#INCLUDE ONCE "inc\ResFont.inc"
#INCLUDE ONCE "inc\DragnDrop.inc"
#INCLUDE ONCE "inc\CreateShortcut.inc"
#INCLUDE ONCE "inc\RTF.inc"
#INCLUDE ONCE "inc\Exe2Unix.inc"
#INCLUDE ONCE "inc\SelfUpdate.inc"
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
GLOBAL g_hDlg AS DWORD ' dialog handle
GLOBAL g_tLock AS CRITICAL_SECTION ' thread lock structure
GLOBAL g_dwRequest AS DWORD ' request number/counter
GLOBAL g_hStream AS DWORD ' stream handle
GLOBAL g_szProxy AS ASCIIZ*256 ' proxy server
GLOBAL g_stURL() AS STRING ' stream URLs
GLOBAL g_stIco() AS STRING ' stream icons
GLOBAL g_stCurMwr AS STRING ' .mwr file used for this session
GLOBAL g_stInfo AS STRING ' stream information
GLOBAL g_icosz AS LONG ' icons size
GLOBAL g_autoplay AS LONG ' autoplay option
GLOBAL g_lastplay AS LONG ' last radio played
GLOBAL g_magick AS LONG ' ImgMagick installed or not
GLOBAL g_readme AS LONG ' show readme at startup
GLOBAL g_vol_lvl AS LONG ' volume level
'------------------------------------------------------------------------------
MACRO FI_INI = LEFT$(EXE.FULL$, -3) + "ini"
MACRO FI_LOG = LEFT$(EXE.FULL$, -3) + "log"
MACRO FI_MWR_1 = RTRIM$(EXE.PATH$,"\") + "\Progressive.mwr"
MACRO FI_MWR_2 = RTRIM$(EXE.PATH$,"\") + "\Classics.mwr"
MACRO WIN_BG_COL = GETSYSCOLOR(%COLOR_BTNFACE)
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION WebFName(BYVAL url AS STRING) AS STRING
' return the file name from an internet url
LOCAL i AS LONG
i = INSTR(-1, url, "/")
FUNCTION = MID$(url, i+1)
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB LogMe(BYVAL e AS STRING)
LOCAL ff AS LONG
LOCAL t, r AS STRING
IF NOT EXIST(FI_LOG) THEN EXIT SUB
' Timestamp
t = DATE$
t = "["+RIGHT$(t,4)+LEFT$(t,2)+MID$(t,4,2)+"-"
t += "-"+REMOVE$(TIME$,":")
t += ","+FORMAT$((TIMER*1000) MOD 1000, "000")+"] "
' Get existing log
ff = FREEFILE
OPEN FI_LOG FOR BINARY ACCESS READ LOCK SHARED AS #ff
GET$ #ff, LOF(#ff), r
CLOSE #ff
' Append text (at the top!)
r = t + e + $CRLF + LEFT$(r,4096)
ff = FREEFILE
OPEN FI_LOG FOR BINARY ACCESS WRITE LOCK WRITE AS #ff
PUT$ #ff, r
CLOSE #ff
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB ErrorMsg(BYVAL stMsg AS STRING)
LogMe stMsg + " (error code: " + FORMAT$(BASS_ErrorGetCode()) + ")"
DIALOG SET TEXT g_hDlg, "Error - " + $MWR + $SPC + $VER
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB DoMeta()
' Update stream title from metadata
LOCAL pMeta AS ASCIIZ PTR
LOCAL stMeta AS STRING
LOCAL lgPtr AS LONG
LOCAL stArtist AS STRING
LOCAL stTitle AS STRING
pMeta = BASS_ChannelGetTags (g_hStream, %BASS_TAG_META)
IF pMeta THEN 'got Shoutcast metadata
stMeta = @pMeta
IF LEFT$(stMeta, 13) = "StreamTitle='" THEN
stMeta = MID$(stMeta, 14)
lgPtr = INSTR(stMeta, "';")
IF lgPtr THEN
stMeta = LEFT$(stMeta, lgPtr - 1)
END IF
END IF
ELSE
pMeta = BASS_ChannelGetTags(g_hStream, %BASS_TAG_OGG)
IF pMeta THEN 'got Icecast/OGG tags
stMeta = @pMeta
DO UNTIL LEN(stMeta) = 0
IF LCASE$(LEFT$(stMeta, 7)) = "artist=" THEN
stArtist = MID$(stMeta, 8)
ELSEIF LCASE$(LEFT$(stMeta, 6)) = "title=" THEN
stTitle = MID$(stMeta, 7)
END IF
pMeta = pMeta + LEN(stMeta) + 1
stMeta = @pMeta
LOOP
IF LEN(stArtist) AND LEN(stTitle) THEN
stMeta = stTitle + " - by " + stArtist
ELSEIF LEN(stArtist) THEN
stMeta = stArtist
ELSEIF LEN(stTitle) THEN
stMeta = stTitle
END IF
END IF
END IF
g_stInfo = TRIM$(stMeta)
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB MetaSync(BYVAL lgHandle AS LONG, BYVAL lgChannel AS LONG, _
BYVAL lgData AS LONG, BYVAL lgUser AS LONG)
CALL DoMeta
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB EndSync(BYVAL lgHandle AS LONG, BYVAL lgChannel AS LONG, _
BYVAL lgData AS LONG, BYVAL lgUser AS LONG)
DIALOG SET TEXT g_hDlg, $MWR + $SPC + $VER ' not playing
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB StatusProc(BYVAL pBuffer AS ASCIIZ PTR, _
BYVAL dwLength AS DWORD, _
BYVAL dwUser AS DWORD)
LOCAL stStatus AS STRING
IF pBuffer AND (dwLength = 0) AND (dwUser = g_dwRequest) THEN
stStatus = @pBuffer
LogMe stStatus
END IF
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
THREAD FUNCTION OpenURL(BYVAL pURL AS ASCIIZ PTR) AS LONG
LOCAL hStream AS DWORD
LOCAL dwRequest AS DWORD
LOCAL szURL AS ASCIIZ*256
szURL = @pURL
LogMe "Opening webradio "+$DQ+TRIM$(szURL)+$DQ
EnterCriticalSection(g_tLock) 'Make sure only 1 thread at a time can do the following
INCR g_dwRequest 'Increment the request counter for this request
dwRequest = g_dwRequest
LeaveCriticalSection(g_tlock)
KillTimer(g_hDlg, 0) 'stop prebuffer monitoring
BASS_StreamFree(g_hStream) 'close old stream
hStream = BASS_StreamCreateURL (szURL, 0, %BASS_STREAM_BLOCK OR %BASS_STREAM_STATUS OR %BASS_STREAM_AUTOFREE, _
CODEPTR(StatusProc), BYVAL dwRequest) 'open URL
EnterCriticalSection(g_tLock)
IF dwRequest <> g_dwRequest THEN 'there is a newer request, discard this stream
LeaveCriticalSection(g_tLock)
IF hStream THEN BASS_StreamFree(hStream)
EXIT FUNCTION
END IF
g_hStream = hStream 'this is now the current stream
LeaveCriticalSection(g_tLock)
IF g_hStream = 0 THEN 'failed to open
ErrorMsg("Cannot open stream")
ELSE
SetTimer(g_hDlg, 0, 50, 0) 'start prebuffer monitoring
END IF
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB FileDropped(BYVAL myfile AS STRING)
LOCAL ff AS LONG
IF EXIST(myfile) AND RIGHT$(LCASE$(myfile),4) = ".mwr" THEN
' Create batch file to restart with new webradios list
ff = FREEFILE
OPEN LocalAppData() + EXE.NAME$ + ".bat" FOR OUTPUT AS #ff
PRINT #ff, "TimeOut 1"
PRINT #ff, "start " + $DQ+$DQ + $SPC + $DQ+EXE.FULL$+$DQ + $SPC + $DQ+myfile+$DQ
CLOSE #ff
ff = SHELL(LocalAppData() + EXE.NAME$ + ".bat", 6) ' minimized without focus
' Close ourselves
PostMessage g_hDlg, %WM_SYSCOMMAND, %SC_CLOSE, 0
SLEEP 500
ExitProcess(12345)
ELSE
BEEP
END IF
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB SetVolume(BYVAL hDlg AS DWORD, BYVAL vol AS LONG)
LOCAL col AS LONG
' BASS_SetVolume(vol/100)
BASS_ChannelSetAttribute(g_hStream, %BASS_ATTRIB_VOL, vol/100)
GRAPHIC ATTACH hDlg, 5, REDRAW
GRAPHIC CLEAR %RGB_LIGHTGRAY
SELECT CASE vol
CASE >90 : col = %RGB_DARKRED
CASE >75 : col = %RED
CASE >60 : col = %RGB_DARKORANGE
CASE >45 : col = %RGB_ORANGE
CASE >30 : col = %RGB_DARKGREEN
CASE ELSE: col = %GREEN
END SELECT
GRAPHIC BOX (1,MIN(13,14-vol*0.14))-(7,14), 0, col, col
GRAPHIC REDRAW
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB ReadIniFile(BYVAL cmd AS STRING)
LOCAL e, t AS STRING
IF NOT EXIST(FI_INI) OR NOT EXIST(FI_MWR_1) OR NOT EXIST(FI_MWR_2) THEN MakeIniAndMwr()
' Ini variables
g_readme = 1 - GetIniV(FI_INI, "ProgConfig", "ReadmeOff")
g_autoplay = GetIniV(FI_INI, "ProgConfig", "Autoplay")
g_stCurMwr = GetIniS(FI_INI, "ProgConfig", "LastMwr")
g_vol_lvl = GetIniV(FI_INI, "ProgConfig", "Volume") : IF g_vol_lvl = 0 THEN g_vol_lvl = 100
IF cmd <> "" THEN ' .mwr passed as argument
LogMe $DQ+TRIM$(COMMAND$,$DQ)+$DQ+" passed as argument"
e = TRIM$(COMMAND$, ANY $DQ+$SPC)
IF RIGHT$(LCASE$(e),4) = ".mwr" AND EXIST(e) THEN
g_stCurMwr = e
SetIni FI_INI, "ProgConfig", "LastMwr", g_stCurMwr
e = PATHNAME$(NAME,g_stCurMwr) + " - " + $MWR
t = RTRIM$(EXE.PATH$,"\") + "\" + e + ".lnk"
IF NOT EXIST(t) THEN ' No local shortcut yet
IF MyMsgBox(0, $DQ + PATHNAME$(NAMEX,g_stCurMwr) + $DQ +$CR+$CR _
+ "Create a shortcut for these webradios?", _
$MWR, %MB_ICONQUESTION + %MB_YESNO) = %IDYES THEN ' Create shortcut
LogMe "Creating shortcut "+$DQ+t+$DQ
CreateShortcut _
t, _ ' 1. the link file to be created
EXE.FULL$, _ ' 2. the file/document where the shortcut should point to
$DQ + g_stCurMwr + $DQ, _ ' 3. command-line parameters
EXE.PATH$, _ ' 4. the folder where the executable file should start in
%SW_SHOW, _ ' 5. %SW_SHOW, %SW_HIDE etc.
EXE.FULL$, _ ' 6. icon file or executable file containing an icon
0, _ ' 7. icon index in the aforementioned file
("(c) mougino.free.fr - v." + $VER) ' 8. any comment (stored in the shortcut)
END IF
END IF
ELSE
LogMe "- incorrect argument: not a valid/existing .mwr!"
END IF
ELSE
LogMe "Opening webradio listing " + $DQ + g_stCurMwr + $DQ
END IF
' Mwr variables
g_icosz = GetIniV(g_stCurMwr, "MwrConfig", "IconSize")
g_lastplay = GetIniV(g_stCurMwr, "MwrConfig", "LastPlayed") - 1
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
MACRO M_STOP_ADBLOCK
KillTimer(CB.HNDL, 3)
adBlock = 0
adBlink = 0
GRAPHIC ATTACH CB.HNDL, %IDOK
GRAPHIC RENDER "BMPA", (0, 0) - (7, 7)
END MACRO
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
MACRO M_UNDERLINE_ACTIVE_RADIO
' Show active radio indicator
FOR i = LBOUND(g_stURL) TO UBOUND(g_stURL)
GRAPHIC ATTACH CB.HNDL, 100+i
GRAPHIC CLEAR IIF(g_lastplay = i, %GREEN, WIN_BG_COL)
NEXT
END MACRO
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
MACRO M_RESET_NFO_PANEL
GRAPHIC ATTACH CB.HNDL, 3, REDRAW
GRAPHIC CLEAR WIN_BG_COL
FOR i = 0 TO w STEP 11
GRAPHIC RENDER "BMP1", (i, 0) - (i+10, 19)
NEXT
END MACRO
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain() AS LONG
STATIC szURL AS ASCIIZ*256
STATIC hIcon AS DWORD
STATIC hFont AS DWORD
STATIC nfoUrl AS STRING
STATIC nfoName AS STRING
STATIC nfoString AS STRING
STATIC nfoLength AS DOUBLE
STATIC nfoOffset AS DOUBLE
STATIC idResFont AS DOUBLE
STATIC isPlaying AS LONG
STATIC adBlock AS LONG
STATIC adBlink AS LONG
LOCAL lgCheck AS LONG
LOCAL dwProgress AS DWORD
LOCAL pText AS ASCIIZ PTR
LOCAL stText AS STRING
LOCAL hThread AS DWORD
LOCAL i, w, h AS LONG
CB_SAVEPOS
CB_DRAGNDROP
M_SELF_UPDATE
SELECT CASE CB.MSG
CASE %WM_TIMER
'===========================================
' Timer to display the readme box
IF CB.WPARAM = 2 THEN
KillTimer(CB.HNDL, 2)
ShowReadme CB.HNDL
CONTROL SET FOCUS CB.HNDL, 9
' Adblock timer
ELSEIF CB.WPARAM = 3 THEN
adBlink = 1 - adBlink
GRAPHIC ATTACH CB.HNDL, %IDOK
IF adBlink THEN
GRAPHIC RENDER "BMPA", (0, 0) - (7, 7)
ELSE
GRAPHIC CLEAR WIN_BG_COL
END IF
' Timer to display stream information
ELSEIF CB.WPARAM = 1 THEN
IF g_stInfo = "" THEN EXIT FUNCTION
IF REMOVE$(g_stInfo, ANY "0123456789- ") = "" THEN g_stInfo = TRIM$(nfoUrl)
IF g_stInfo = "" THEN g_stInfo = TRIM$(nfoName)
w = MAX(148, (UBOUND(g_stURL)+1)*(g_icosz+6)-6)
stText = SPACE$(MAX(2*LEN(g_stInfo), 2*w\11)) + g_stInfo
' The information text has changed!
IF nfoString <> stText THEN
' Check if next song is reached: if yes stop Adblocker
IF adBlock = 1 AND INSTR(LCASE$(stText), "adblocker") = 0 THEN
M_STOP_ADBLOCK
SetVolume(CB.HNDL, g_vol_lvl)
END IF
' Force new information text
nfoString = stText
nfoOffset = 0
GRAPHIC ATTACH CB.HNDL, 3
GRAPHIC SET FONT hFont
GRAPHIC TEXT SIZE nfoString TO nfoLength, h
END IF
' In any case, refresh information panel (scrolling effect)
M_RESET_NFO_PANEL
nfoOffset += 4
IF nfoOffset > nfoLength THEN nfoOffset = 0
GRAPHIC SET FONT hFont
GRAPHIC COLOR %BLACK, -2
GRAPHIC SET POS (-nfoOffset, -2)
GRAPHIC PRINT nfoString
GRAPHIC REDRAW
' Timer to get the percentage of the buffer filled when loading is in progress
ELSEIF CB.WPARAM = 0 THEN
dwProgress = BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_BUFFER) _
* 100 / BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_END) ' Percentage of buffer filled
' Over 75% full (or end of download)...
IF (dwProgress > 75) OR (BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_CONNECTED) = 0) THEN
KillTimer(CB.HNDL, 0) ' Finished prebuffering, stop monitoring
' Update dialog icon with webradio icon
ARRAY SCAN g_stURL(), =(szURL), TO i : DECR i
DialogSetIconFile CB.HNDL, g_stIco(i)
SetIni g_stCurMwr, "MwrConfig", "LastPlayed", FORMAT$(i+1)
' Get the broadcast name from metadata
pText = BASS_ChannelGetTags(g_hStream, %BASS_TAG_ICY)
IF pText = 0 THEN ' No ICY tags, try HTTP...
pText = BASS_ChannelGetTags(g_hStream, %BASS_TAG_HTTP)
END IF
IF pText THEN
stText = @pText
DO UNTIL LEN(stText) = 0
IF LEFT$(stText, 9) = "icy-name:" THEN
nfoName = MID$(stText, 10)
DIALOG SET TEXT CB.HNDL, nfoName + " - " + $MWR + $SPC + $VER
ELSEIF LEFT$(stText, 8) = "icy-url:" THEN
nfoUrl = MID$(stText, 9)
END IF
pText = pText + LEN(stText) + 1
stText = @pText
LOOP
END IF
IF LEN(stText) = 0 THEN
DIALOG SET TEXT CB.HNDL, PATHNAME$(NAME, g_stIco(i)) + " - " + $MWR + $SPC + $VER
END IF
' Get the stream information and set sync for subsequent titles
DoMeta()
BASS_ChannelSetSync(g_hStream, %BASS_SYNC_META, 0, CODEPTR(MetaSync), BYVAL 0)
BASS_ChannelSetSync(g_hStream, %BASS_SYNC_OGG_CHANGE, 0, CODEPTR(MetaSync), BYVAL 0)
BASS_ChannelSetSync(g_hStream ,%BASS_SYNC_END, 0, CODEPTR(EndSync), BYVAL 0)
SetVolume(CB.HNDL, g_vol_lvl)
SetTimer(g_hDlg, 1, 50, 0) ' Trigger timer to display stream nfo
' Show Stop icon
GRAPHIC ATTACH CB.HNDL, 6
GRAPHIC CLEAR WIN_BG_COL
GRAPHIC BOX (0, 0) - (7, 7), 20,, %BLACK, %BLACK ' Stop icon
' Show active radio indicator
M_UNDERLINE_ACTIVE_RADIO
' Stop Adblocker if active
M_STOP_ADBLOCK
' Play the stream!
BASS_ChannelPlay(g_hStream, 0)
isPlaying = 1
END IF
END IF
CASE %WM_INITDIALOG
'===========================================
IF BASS_Init(-1, 44100, 0, CB.HNDL, BYVAL 0) = 0 THEN
ErrorMsg "Cannot initialize output device"
MyMsgBox 0, "Fatal error - See log file", EXE.NAME$, %MB_ICONERROR
DIALOG POST CB.HNDL, %WM_DESTROY, 0, 0
END IF
BASS_SetConfig(%BASS_CONFIG_NET_PLAYLIST, 1) ' enable playlist processing
BASS_SetConfig(%BASS_CONFIG_NET_PREBUF, 0) ' minimize automatic pre-buffering
BASS_SetConfigPtr(%BASS_CONFIG_NET_PROXY, g_szProxy) ' setup proxy server location
InitializeCriticalSection(g_tLock)
idResFont = AddResFont("FNT1")
FONT NEW "Square Dot-Matrix", 28, 0 TO hFont
FOR i = LBOUND(g_stURL) TO UBOUND(g_stURL)
SetTooltip CB.HNDL, 10+i, PATHNAME$(NAME,g_stIco(i))
NEXT
SetTooltip CB.HNDL, 6, "Play/Stop"
SetTooltip CB.HNDL, %IDOK, "Adblocker"
SetTooltip CB.HNDL, 7, "Edit .mwr"
SetTooltip CB.HNDL, 9, "About..."
SetVolume(CB.HNDL, g_vol_lvl)
IF ISTRUE g_readme THEN SetTimer(g_hDlg, 2, 1000, 0)
IF ISTRUE g_autoplay THEN
CONTROL SET CHECK CB.HNDL, 8, 1 ' checkbox checked
IF g_lastplay >= LBOUND(g_stURL) _
AND g_lastplay <= UBOUND(g_stURL) THEN
szURL = g_stURL(g_lastplay)
THREAD CREATE OpenURL(VARPTR(szURL)) TO hThread
END IF
END IF
CASE %WM_SETCURSOR ' change cursor to link-hand when hovering over controls
'===========================================
i = GetDlgCtrlId(CB.WPARAM)
IF i = %IDOK OR (i >= 6 AND i <= 9) THEN
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
CASE %WM_MOUSEWHEEL
'===========================================
SELECT CASE HIINT(CB.WPARAM)
CASE > 0 : g_vol_lvl = MIN(100, g_vol_lvl + 2)
CASE < 0 : g_vol_lvl = MAX( 2, g_vol_lvl - 2)
END SELECT
SetVolume(CB.HNDL, g_vol_lvl)
CASE %WM_COMMAND
'===========================================
SELECT CASE CB.CTL
' User hit Escape key
'------------------------------------
CASE %IDCANCEL
DIALOG END CB.HNDL
' User clicked information panel
'------------------------------------
CASE 3
CONTROL SET FOCUS CB.HNDL, 9
' User clicked "Adblocker" button
'------------------------------------
CASE %IDOK
IF isPlaying = 0 THEN EXIT FUNCTION
adBlock = 1
adBlink = 1
BASS_ChannelSetAttribute(g_hStream, %BASS_ATTRIB_VOL, 0)
g_stInfo = "Adblocker activated - waiting for next song"
SetTimer(CB.HNDL, 3, 500, 0) ' Trigger timer to make Adblocker icon blink
CONTROL SET FOCUS CB.HNDL, 9
' User clicked "Play/Stop" button
'------------------------------------
CASE 6
isPlaying = 1 - isPlaying
' User clicked "Stop"
'--------------------
IF isPlaying = 0 THEN
KillTimer(CB.HNDL, 1)
' Release media stream
IF ISTRUE g_hStream THEN
BASS_StreamFree(g_hStream)
g_hStream = 0
END IF
' Remove active radio indicator
FOR i = LBOUND(g_stURL) TO UBOUND(g_stURL)
GRAPHIC ATTACH CB.HNDL, 100+i
GRAPHIC CLEAR WIN_BG_COL
NEXT
' Stop blinking adBlock if active
M_STOP_ADBLOCK
' Show Play icon
GRAPHIC ATTACH CB.HNDL, 6
GRAPHIC CLEAR WIN_BG_COL
GRAPHIC RENDER "BMPP", (0, 0) - (7, 7)
' Set dialog title and icon
DIALOG SET TEXT CB.HNDL, $MWR + $SPC + $VER
DIALOG SET ICON CB.HNDL, "ICO1"
' Reset information panel
w = MAX(148, (UBOUND(g_stURL)+1)*(g_icosz+6)-6)
M_RESET_NFO_PANEL
GRAPHIC REDRAW
' User clicked "Play"
'--------------------
ELSE 'IF isPlaying = 1
' Show Stop icon
GRAPHIC ATTACH CB.HNDL, 6
GRAPHIC CLEAR WIN_BG_COL
GRAPHIC BOX (0, 0) - (7, 7), 20,, %BLACK, %BLACK
' Show active radio indicator
M_UNDERLINE_ACTIVE_RADIO
' Restart last media stream
IF g_lastplay = 0 THEN g_lastplay = 1
IF g_lastplay < LBOUND(g_stURL) OR g_lastplay > UBOUND(g_stURL) THEN EXIT FUNCTION
szURL = g_stURL(g_lastplay)
THREAD CREATE OpenURL(VARPTR(szURL)) TO hThread
END IF
CONTROL SET FOCUS CB.HNDL, 9
' User clicked "Configure" button
'------------------------------------
CASE 7
ShellExecute %NULL, "open", "notepad", (g_stCurMwr), "", %SW_SHOW
CONTROL SET FOCUS CB.HNDL, 9
' Ignore user (un)checking the 'Autoplay' checkbox
'------------------------------------
CASE 8
CONTROL SET FOCUS CB.HNDL, 9
' User clicked "About" link
'------------------------------------
CASE 9
ShellExecute %NULL, "open", "http://mougino.free.fr/freeware", "", "", %SW_SHOW
CONTROL SET FOCUS CB.HNDL, 9
' User clicked a Webradio button
'------------------------------------
CASE ELSE
' Stop information stream
KillTimer(CB.HNDL, 1)
' Show active radio indicator
g_lastplay = CB.CTL - 10
M_UNDERLINE_ACTIVE_RADIO
' Reset information panel
w = MAX(148, (UBOUND(g_stURL)+1)*(g_icosz+6)-6)
M_RESET_NFO_PANEL
GRAPHIC REDRAW
' Start media stream
szURL = g_stURL(CB.CTL - 10)
THREAD CREATE OpenURL(VARPTR(szURL)) TO hThread
SLEEP 200
CONTROL SET FOCUS CB.HNDL, 9
END SELECT ' SELECT CASE CB.CTL
CASE %WM_DESTROY
'===========================================
CONTROL GET CHECK CB.HNDL, 8 TO i
SetIni FI_INI, "ProgConfig", "Autoplay", FORMAT$(i)
SetIni FI_INI, "ProgConfig", "Volume", FORMAT$(g_vol_lvl)
BASS_Free()
FONT END hFont
RemoveResFont(idResFont)
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION PBMAIN() AS LONG
LOCAL e, t AS STRING
LOCAL x, i, w AS LONG
KILL LocalAppData() + EXE.NAME$ + ".bat"
' Create exe icon in Unix dock and Unix file explorer
Me2Unix 1, 1 ' askConfirmation=%TRUE, showInAppMenu=%TRUE
' Test version of Bass.dll
'===========================================
IF (HI(WORD, BASS_GetVersion()) <> %BASSVERSION) THEN
LogMe "FATAL ERROR: Bass header version "+FORMAT$(%BASSVERSION) _
+ " vs. DLL version "+FORMAT$(HI(WORD, BASS_GetVersion()))
MyMsgBox 0, "BASS.DLL version does not match the header version","Error",%MB_ICONERROR
EXIT FUNCTION
END IF
' Register .mwr extension
'===========================================
IF ISFALSE IsExtensionRegistered(".mwr") THEN
LogMe ".mwr extension not registered - trying to access registry"
RegisterExtension ".mwr"
IF ISFALSE IsExtensionRegistered(".mwr") THEN
LogMe "- Failed!"
MyMsgBox 0, "Could not register the .mwr file extension"+$CR+$CR _
+ "You may have to right click the program > Run as Admin" _
, $MWR, %MB_ICONWARNING
ELSE
LogMe "- Success registering .mwr extension"
END IF
END IF
' Get ini/mwr variables
'===========================================
ReadIniFile(COMMAND$)
' Check ImageMagick installation
'===========================================
g_magick = IIF(IsOnUnix(), %TRUE, IsImageMagickInstalled())
' Get webradios data
'===========================================
i = 0
DO
REDIM PRESERVE g_stURL(i)
REDIM PRESERVE g_stIco(i)
g_stURL(i) = GetIniS(g_stCurMwr, "MyWebradios", "radio"+FORMAT$(i+1))
g_stIco(i) = GetIniS(g_stCurMwr, "MyWebradios", "icon"+FORMAT$(i+1))
IF g_stIco(i) <> "" THEN ' User specified icon
' Download any internet icon/image to local
IF LEFT$(LCASE$(g_stIco(i)),4) = "http" THEN
e = LocalAppData() + WebFName(g_stIco(i))
IF NOT EXIST(e) THEN
URLDownloadToFile(BYVAL NOTHING, (g_stIco(i)), (e), 0, BYVAL NOTHING)
LogMe "Downloading "+$DQ+g_stIco(i)+$DQ+" to "+$DQ+e+$DQ
IF EXIST(e) THEN LogMe "- Success" ELSE LogMe "- Failed!"
END IF
g_stIco(i) = e
END IF
' Convert local png/bmp/jpeg to icon
IF RIGHT$(LCASE$(g_stIco(i)),3) <> "ico" THEN
LogMe "Using image "+$DQ+g_stIco(i)+$DQ+" as an icon: conversion to .ico needed"
e = LEFT$(g_stIco(i),-3) + "ico"
IF ISTRUE g_magick THEN
LogMe "- ImageMagick detected: starting conversion"
IF NOT EXIST(e) THEN ConvertIco g_stIco(i)
ELSE
LogMe "- ImageMagick NOT detected on system!"
END IF
IF EXIST(e) THEN LogMe "- Icon created > using it" ELSE LogMe "- Failed creating icon > skipping"
g_stIco(i) = e
ELSE
LogMe "Using "+$DQ+g_stIco(i)+$DQ+" as icon for radio #"+FORMAT$(i+1)
END IF
END IF
IF g_stURL(i) <> "" THEN INCR i ELSE EXIT LOOP
LOOP
REDIM PRESERVE g_stURL(i-1)
' Build main dialog
'===========================================
DIALOG NEW 0, $MWR + $SPC + $VER,,, MAX(160, 6+i*(g_icosz+6)), 12+g_icosz+36, _
%WS_SYSMENU OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_POPUP OR %DS_MODALFRAME _
TO g_hDlg
DIALOG SET ICON g_hDlg, "ICO1"
' Webradios row
'--------------
x = 6
FOR i = LBOUND(g_stURL) TO UBOUND(g_stURL)
CONTROL ADD IMGBUTTONX, g_hDlg, 10+i, "", x, 4, g_icosz, g_icosz
ImgbuttonSetIconFile g_hDlg, 10+i, g_stIco(i), g_icosz, g_icosz
CONTROL ADD GRAPHIC, g_hDlg, 100+i, "", x, g_icosz+5, g_icosz, 2
x += g_icosz + 6
NEXT i
' Stream information panel
'-------------------------
x = MAX(148, (UBOUND(g_stURL)+1)*(g_icosz+6)-6)
CONTROL ADD GRAPHIC, g_hDlg, 3, "", 6, 10+g_icosz, x, 19, %SS_NOTIFY
GRAPHIC ATTACH g_hDlg, 3 : GRAPHIC CLEAR WIN_BG_COL
FOR i = 0 TO x STEP 11
GRAPHIC RENDER "BMP1", (i, 0) - (i+10, 19)
NEXT
' [Footer] Volume level
'----------------------
x = 5 : w = 7
CONTROL ADD GRAPHIC, g_hDlg, 5, "", x, 32+g_icosz, w, 13
x += w + 4
' [Footer] Stop/Play button
'--------------------------
w = 7
CONTROL ADD GRAPHIC, g_hDlg, 6, "", x, 35+g_icosz, w, 7, %SS_NOTIFY
GRAPHIC ATTACH g_hDlg, 6 : GRAPHIC CLEAR WIN_BG_COL
IF ISTRUE g_autoplay THEN
GRAPHIC BOX (0, 0) - (7, 7), 20,, %BLACK, %BLACK ' Stop icon
ELSE
GRAPHIC RENDER "BMPP", (0, 0) - (7, 7) ' Play icon
END IF
x += w + 4
' [Footer] Adblocker button
'--------------------------
w = 7
CONTROL ADD GRAPHIC, g_hDlg, %IDOK, "", x, 35+g_icosz, w, 7, %SS_NOTIFY
GRAPHIC ATTACH g_hDlg, %IDOK : GRAPHIC CLEAR WIN_BG_COL
GRAPHIC RENDER "BMPA", (0, 0) - (7, 7) ' Adblock icon
x += w + 4
' [Footer] Config button
'-----------------------
w = 16
CONTROL ADD GRAPHIC, g_hDlg, 7, "", x, 32+g_icosz, w, 14, %SS_NOTIFY
GraphicDrawIconDll g_hDlg, 7, "shell32.dll", 72, 0, 0, 20, 20
x += w + 4
' [Footer] Autoplay checkbox
'---------------------------
w = 40
CONTROL ADD CHECKBOX, g_hDlg, 8, "Autoplay", x, 32+g_icosz, w, 14
x += w + 4
' [Footer] About link
'--------------------
w = 60
CONTROL ADD LABEL, g_hDlg, 9, "<mougino.free.fr>", x, 35+g_icosz, w, 12, %SS_NOTIFY
CONTROL SET COLOR g_hDlg, 9, %BLUE, -1
' Display main dialog!
'===========================================
DIALOG SHOW MODAL g_hDlg, CALL ProcMain
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION ShowReadme(BYVAL hParent AS DWORD) AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW PIXELS, hParent, $MWR, 5, -40, 320, 250, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT OR %WS_MINIMIZEBOX, %WS_EX_CONTROLPARENT OR _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET ICON hDlg, "ICO1"
' Create RTF control
LoadLibrary("RICHED32.DLL")
CONTROL ADD "RichEdit", hDlg, 991, "", 8, 8, 320-16, 250-40, _
%WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE _
OR %ES_READONLY OR %WS_VSCROLL
Fill_RichEdit hDlg, 991
CONTROL ADD CHECKBOX, hDlg, 992, "Do not show this window again", 8, 250-32, 220, 24
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "OK", 320-68, 250-32, 60, 24
DIALOG SHOW MODAL hDlg, CALL ProcReadme
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcReadme() AS LONG
LOCAL i AS LONG
SELECT CASE CB.MSG
' Process RTF hyperlinks
CASE %WM_NOTIFY
IF CB.NMID = 991 AND CB.NMCODE = %EN_LINK THEN RTF_hyperlink CB.HNDL, 991, CB.LPARAM
' Click on "OK" in the readme > close dialog
CASE %WM_COMMAND
IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL
' Dialog ending
CASE %WM_DESTROY
CONTROL GET CHECK CB.HNDL, 992 TO i
SetIni FI_INI, "ProgConfig", "ReadmeOff", FORMAT$(i)
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB Fill_RichEdit (hD AS DWORD, CtlId AS LONG)
LOCAL richtext AS STRING
richtext = "[black][c]"
richtext += "[font:o,11][b]" + $MWR + " v" + $VER + "[/b][eol][l]"
richtext += "[font:o,9][black][l][eol]"
richtext += "This program uses [blue].mwr [black]files, which are simple text files, "
richtext += "as a list to play your favorite webradios and show them with your custom icons."
richtext += "[eol][eol]"
richtext += "You can drag & drop an [blue].mwr [black]file onto the program to load and run it."
richtext += "[eol][eol]"
richtext += "Use the [blue]return [black]key to pause/resume radio playing, and the "
richtext += "[blue]escape [black]key to exit the program. Use the [blue]mouse wheel[black] to change the volume.[eop]"
richtext += "[eol]"
richtext += "[c][b][maroon]C[red]r[fuschia]e[purple]a[blue]t[teal]e[green]d [lime]b[grey]y [maroon]m[red]o[fuschia]u[purple]g[blue]i[teal]n[green]o[lime]"
richtext += " - http://mougino.free.fr[/b]"
RTF_SET hD, CtlId, richtext
END SUB
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
SUB MakeIniAndMwr()
LOCAL ff AS LONG
LogMe "Creating initial "+$DQ+FI_INI+$DQ+", "+$DQ+FI_MWR_1+$DQ+" and "+$DQ+FI_MWR_2+$DQ
ff = FREEFILE
OPEN FI_MWR_1 FOR OUTPUT AS #ff
PRINT #ff, "[MyWebradios]"
PRINT #ff, "radio1=http://hirschmilch.de:7000/psytrance.mp3"
PRINT #ff, "icon1=http://mougino.free.fr/mwr/hirschmilch-psytrance.ico"
PRINT #ff, "radio2=http://hirschmilch.de:7000/prog-house.mp3"
PRINT #ff, "icon2=http://mougino.free.fr/mwr/hirschmilch-prog-house.ico"
PRINT #ff, "radio3=http://hirschmilch.de:7000/techno.mp3"
PRINT #ff, "icon3=http://mougino.free.fr/mwr/hirschmilch-techno.ico"
PRINT #ff, "radio4=http://hirschmilch.de:7000/progressive.mp3"
PRINT #ff, "icon4=http://mougino.free.fr/mwr/hirschmilch-progressive.ico"
PRINT #ff, "radio5=http://hirschmilch.de:7000/chillout.mp3"
PRINT #ff, "icon5=http://mougino.free.fr/mwr/hirschmilch-chillout.ico"
PRINT #ff, "radio6=http://hirschmilch.de:7000/electronic.mp3"
PRINT #ff, "icon6=http://mougino.free.fr/mwr/hirschmilch-electronic.ico"
PRINT #ff, ""
PRINT #ff, "[MwrConfig]"
PRINT #ff, "IconSize=24"
PRINT #ff, "LastPlayed=1"
CLOSE #ff
ff = FREEFILE
OPEN FI_MWR_2 FOR OUTPUT AS #ff
PRINT #ff, "[MyWebradios]"
PRINT #ff, "radio1=https://jazz-wr10.ice.infomaniak.ch/jazz-wr10-128.mp3"
PRINT #ff, "icon1=http://mougino.free.fr/mwr/jazz-soul-radio.ico"
PRINT #ff, "radio2=https://scdn.nrjaudio.fm/fr/30601/mp3_128.mp3?origine=mytuner&cdn_path=adswizz_lbs9&access_token=a1f2fda391774702a62a62234f12ed82"
PRINT #ff, "icon2=http://mougino.free.fr/mwr/nostalgie.ico"
PRINT #ff, "radio3=https://mbs.ice.infomaniak.ch/mbs-128.mp3"
PRINT #ff, "icon3=http://mougino.free.fr/mwr/mbs.ico"
PRINT #ff, "radio4=https://scdn.nrjaudio.fm/fr/30621/mp3_128.mp3?aw_0_1st.station=Nostalgie-Rock&origine=mytuner&cdn_path=adswizz_lbs10&adws_out_1&access_token=739e9bc713cd4691b34acc2e1ea80cff"
PRINT #ff, "icon4=http://mougino.free.fr/mwr/nostalgie-pop-rock.ico"
PRINT #ff, ""
PRINT #ff, "[MwrConfig]"
PRINT #ff, "IconSize=48"
PRINT #ff, "LastPlayed=4"
CLOSE #ff
ff = FREEFILE
OPEN FI_INI FOR OUTPUT AS #ff
PRINT #ff, "[ProgConfig]"
PRINT #ff, "LastMwr=" + FI_MWR_1
PRINT #ff, "Autoplay=0"
CLOSE #ff
END SUB
'-----------------------------------------------------------------------------