Readme.txt -> see next post
Examples:
"Radio Station remix.kwed.org.exe" /cfg 7 /cbg 1 /order 1 /glass
"Radio Station remix.kwed.org.exe" /top50 /number 50 /top50dir -1
For Windows 7 users: TLS 1.1 and TLS 1.2 must be enabled to run this program properly (WinHTTP) (see Update to enable TLS 1.1 and TLS 1.2 as default secure protocols in WinHTTP in Windows)
Radio Station remix.kwed.org.bas
Code: Select all
'Version 0.60 build 2021-07-19 beta
'Coded by UEZ
'Information: 100 downloads per IP per hour allowed!
#Ifdef __Fb_64bit__
#Inclib "gdiplus"
#Include Once "win\gdiplus-c.bi"
Const GCL_HICON = -14, GCL_HICONSM = -34
#Else
#Include Once "win\gdiplus.bi"
Using Gdiplus
#Endif
#Include "String.bi"
#Include "fbthread.bi"
#Include "win\tlhelp32.bi"
#Include "win\commctrl.bi"
#Include "win\shellapi.bi"
#Include "Bass2.bi"
#Include "WinHTTP.bi"
Declare Function RtlGetVersion Lib "NtDll.dll" Alias "RtlGetVersion" (OsVersionInformation As RTL_OSVERSIONINFOW) As Long
Dim Shared As RTL_OSVERSIONINFOW OS
OS.dwOSVersionInfoSize = Sizeof(RTL_OSVERSIONINFOW)
RtlGetVersion(OS)
If OS.dwBuildNumber < 7600 Then
? "This operating system is NOT supported! Win7+ is required!"
Sleep(2500)
End
Endif
Dim As String sCoder = "Coded by UEZ v0.60 build 2021-07-19 beta "
Dim Shared As String sRadioSite
sRadioSite = "remix.kwed.org"
#Define DirExists(sPath) (GetFileAttributes(sPath) = FILE_ATTRIBUTE_DIRECTORY)
#Define _Round(x) (Int(x + 0.5))
Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
Dim Shared As QWORD iBytesLen, iEnd, iFilePosStart, iFilePos, iFileSize, iSongs
Dim Shared As String sRedirectURL, SOUNDFILE, sPlaying, sRating, sOriginal, sReleaseDate, sAllTimeRank
Dim Shared As Ubyte iCounter = 0, iFGCol = 15, iBGCol = 5, bShowLevel = 1, bAutoSwitchDevice = 1, bOneTime = 0, bEndless = 0, bExit = 0, bLimitReached = False, bTop50 = False, iTop50Items = 50
Dim Shared As Double length
Dim Shared As Single vol = 0.15, iW, iH, fBitrate, fDPI_ratio
Dim Shared As Ubyte iOrder = 0, iDLFinished, iTop50Pos = 1
Dim Shared As Byte iTop50PosDir = 1
Dim Shared As Short iNumber = -1, iPosCursor, iSongsreal = 0
Dim Shared As Integer iConsoleW, iConsoleH, iCsW = 100, iCsH = 12, iFsW = 0, iFsH = 14
Dim Shared As Any Ptr hSession, hConnect, hImage, hConsole, hSysMenu
Dim Shared As HBITMAP hBitmap
Dim Shared As HWND hGUI_logo, hPic_logo
Dim Shared As Ulong iPicBGColor
Dim Shared As HHOOK hMouseHook
Dim Shared As Handle hStdOut, hStdIn
Dim Shared As Long iCtrlPosX, iCtrlPosY, aTop50Titles(100)
Dim Shared As CONSOLE_FONT_INFOEX fsc
Dim Shared As CONSOLE_SCREEN_BUFFER_INFOEX buffinfoex, savebuffinfoex
Const WM_DPICHANGED = &h02E0, WM_DPICHANGED_BEFOREPARENT = &h02E2, WM_DPICHANGED_AFTERPARENT = &h02E3, ENABLE_VIRTUAL_TERMINAL_PROCESSING = 4, id_Exit = 5200, id_About = 5201
Randomize
Function SearchInCMDArgument(sSearchFor As String) As Ubyte
Dim As Ubyte i = 1
Do
If Lcase(Command(i)) = Lcase(sSearchFor) Then Return i
i += 1
Loop While Len(Command(i)) > 0
Return 0
End Function
Function GetFontInfo() As _CONSOLE_FONT_INFOEX
Dim As _CONSOLE_FONT_INFOEX fi
fi.cbSize = Sizeof(CONSOLE_FONT_INFOEX)
GetCurrentConsoleFontEx(GetStdHandle(STD_OUTPUT_HANDLE), False, @fi)
Return fi
End Function
Sub SetFontSize(w As Long, h As Long, ftype As String = "Consolas", nfont As DWORD = 0, nFontWeight As Uinteger = FW_BOLD, nFontFamily As Uinteger = FF_DONTCARE)
Dim As _CONSOLE_FONT_INFOEX x
With x
.cbsize = Sizeof(_CONSOLE_FONT_INFOEX)
.nfont = nFont
.dwfontsize = Type(w, h)
.fontfamily = nFontFamily
.fontweight = nFontWeight
.facename = ftype
End With
SetCurrentConsoleFontEx(GetStdHandle(STD_OUTPUT_HANDLE), 1, @x)
End Sub
Sub GetConsoleSize(Byref w As Integer, Byref h As Integer)
Dim As CONSOLE_SCREEN_BUFFER_INFO info
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), @info)
w = info.srWindow.Right - info.srWindow.Left
h = info.srWindow.Bottom - info.srWindow.Top
End Sub
Sub SetConsoleSize(cols As Long, lines As Long)
Shell "MODE CON: COLS=" + Str(cols) + "LINES=" + Str(lines)
End Sub
Sub ClrConsole(iSleep As Ushort = 100)
Shell "Cls"
Sleep(iSleep)
End Sub
Sub ClrConsole2(hConsole As HANDLE, x1 As Ushort = 0, y1 As Ushort = 0, x2 As Ushort = 0, y2 As Ushort = 0, cPosX As Ushort = 0, cPosY As Ushort = 0, ClrChar As Ubyte = 32) 'https://docs.microsoft.com/en-us/windows/console/clearing-the-screen example 2
Dim As CONSOLE_SCREEN_BUFFER_INFO csbi
Dim As SMALL_RECT scrollRect
Dim As COORD scrollTarget
Dim As CHAR_INFO fill
GetConsoleScreenBufferInfo(hConsole, @csbi)
scrollRect.Left = x1
scrollRect.Top = y1
scrollRect.Right = Iif(x2 = 0, csbi.dwSize.X, x2 - 1)
scrollRect.Bottom = Iif(y2 = 0, csbi.dwSize.Y, y2 -1)
scrollTarget.X = 0
scrollTarget.Y = (0 - csbi.dwSize.Y)
fill.Char.UnicodeChar = ClrChar 'Asc(" ")
fill.Attributes = csbi.wAttributes
ScrollConsoleScreenBuffer(hConsole, @scrollRect, NULL, scrollTarget, @fill)
csbi.dwCursorPosition.X = cPosX
csbi.dwCursorPosition.Y = cPosY
SetConsoleCursorPosition(hConsole, csbi.dwCursorPosition)
End Sub
Function Replace (Byval buffer As String, Byval oldstring As String, Byval newstring As String) As String
If Instr(buffer, oldstring) = 0 Then Return buffer
buffer = Chr(32) + buffer + Chr(32)
Dim rep As Ubyte
Dim SS As Integer
Dim SE As Integer
Do
rep = 0
If Instr(buffer, oldstring) > 0 Then
rep = 1
SS = Instr(buffer, oldstring) - 1
SE = SS + Len(oldstring) + 1
SS = Iif (SS < 1, 1, SS)
SE = Iif (SE > Len(buffer), Len(buffer), SE)
buffer = Mid(buffer, 1, SS) + newstring + Mid(buffer, SE, Len(buffer) - (SE - 1))
End If
Loop While rep = 1
Return Trim(buffer)
End Function
Function _WinAPI_GetProcessName(iPid As DWORD) As String
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, iPid)
If hSnapshot = 0 Then Return ""
Dim As PROCESSENTRY32W tPROCESSENTRY32W
tPROCESSENTRY32W.dwSize = Sizeof(PROCESSENTRY32W)
Process32FirstW(hSnapshot, @tPROCESSENTRY32W)
While True
If tPROCESSENTRY32W.th32ProcessID = iPid Then Exit While
If Process32NextW(hSnapshot, @tPROCESSENTRY32W) = 0 Then Exit While
Wend
CloseHandle(hSnapshot)
Return tPROCESSENTRY32W.szExeFile
End Function
Function _WinAPI_GetParentProcess() As Integer
Dim As DWORD pid = GetCurrentProcessId(), pid_parent = 0
Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Dim As PROCESSENTRY32 tPROCESSENTRY32
tPROCESSENTRY32.dwSize = Sizeof(tPROCESSENTRY32)
Process32First(hSnapshot, @tPROCESSENTRY32)
While TRUE
If tPROCESSENTRY32.th32ProcessID = pid Then
pid_parent = tPROCESSENTRY32.th32ParentProcessID
Exit While
End If
Process32Next(hSnapshot, @tPROCESSENTRY32)
Wend
CloseHandle(hSnapshot)
Return pid_parent
End Function
Function _WinAPI_DwmIsCompositionEnabled() As Bool 'Windows Vista+ / Server 2008+ required
Dim As Any Ptr pLib = Dylibload("Dwmapi.dll")
If pLib = NULL Then Exit Function
Dim pDwmIsCompositionEnabled As Function (Byval pfEnabled As Any Ptr) As Integer
Dim As Bool pfEnabled = False
pDwmIsCompositionEnabled = Dylibsymbol(pLib, "DwmIsCompositionEnabled")
If pDwmIsCompositionEnabled Then pDwmIsCompositionEnabled(@pfEnabled)
Dylibfree(pLib)
Return pfEnabled
End Function
Function _WinAPI_EnableBlurBehindWindow(hWND As HWND, bSet As Bool = True) As Integer 'Windows Vista+ / Server 2008+ required
Dim As Any Ptr pLib = Dylibload("Dwmapi.dll")
If pLib = NULL Then Exit Function
Type tagDWM_BLURBEHIND
Dim As DWORD dwFlags
Dim As BOOL fEnable
Dim As HRGN hRgnBlur
Dim As BOOL fTransitionOnMaximized
End Type
Dim pEnableBlurBehind As Function (Byval hWND As HWND, Byval pDWM_BLURBEHIND As Any Ptr) As Integer
Const DWM_BB_ENABLE = 1, DWM_BB_BLURREGION = 2, DWM_BB_TRANSITIONONMAXIMIZED = 4
Dim As tagDWM_BLURBEHIND tDWM_BLURBEHIND
tDWM_BLURBEHIND.dwFlags = DWM_BB_ENABLE Or DWM_BB_BLURREGION
tDWM_BLURBEHIND.fEnable = bSet
tDWM_BLURBEHIND.hRgnBlur = Null
tDWM_BLURBEHIND.fTransitionOnMaximized = bSet
pEnableBlurBehind = Dylibsymbol(pLib, "DwmEnableBlurBehindWindow")
If pEnableBlurBehind Then Function = pEnableBlurBehind(hWND, @tDWM_BLURBEHIND)
Dylibfree(pLib)
End Function
Type tagAccentPolicy
As Long AccentState, AccentFlags, AnimationId
As Ulong GradientColor
End Type
Type tagAttrData
As Dword Attribute
As PVOID pDataBuffer
As SIZE_T Size
End Type
Enum AccentState
ACCENT_DISABLED = 0
ACCENT_ENABLE_GRADIENT = 1
ACCENT_ENABLE_TRANSPARENTGRADIENT = 2
ACCENT_ENABLE_BLURBEHIND = 3
ACCENT_ENABLE_ACRYLICBLURBEHIND = 4
ACCENT_ENABLE_HOSTBACKDROP = 5
ACCENT_INVALID_STATE = 6
End Enum
Enum WINDOWCOMPOSITIONATTRIB
WCA_UNDEFINED = 0
WCA_NCRENDERING_ENABLED = 1
WCA_NCRENDERING_POLICY = 2
WCA_TRANSITIONS_FORCEDISABLED = 3
WCA_ALLOW_NCPAINT = 4
WCA_CAPTION_BUTTON_BOUNDS = 5
WCA_NONCLIENT_RTL_LAYOUT = 6
WCA_FORCE_ICONIC_REPRESENTATION = 7
WCA_EXTENDED_FRAME_BOUNDS = 8
WCA_HAS_ICONIC_BITMAP = 9
WCA_THEME_ATTRIBUTES = 10
WCA_NCRENDERING_EXILED = 11
WCA_NCADORNMENTINFO = 12
WCA_EXCLUDED_FROM_LIVEPREVIEW = 13
WCA_VIDEO_OVERLAY_ACTIVE = 14
WCA_FORCE_ACTIVEWINDOW_APPEARANCE = 15
WCA_DISALLOW_PEEK = 16
WCA_CLOAK = 17
WCA_CLOAKED = 18
WCA_ACCENT_POLICY = 19
WCA_FREEZE_REPRESENTATION = 20
WCA_EVER_UNCLOAKED = 21
WCA_VISUAL_OWNER = 22
WCA_HOLOGRAPHIC = 23
WCA_EXCLUDED_FROM_DDA = 24
WCA_PASSIVEUPDATEMODE = 25
WCA_USEDARKMODECOLORS = 26
WCA_LAST = 27
End Enum
Function _WinAPI_SetWindowCompositionAttribute(hWnd As HWND, bEnable As Bool = True, iAccentState As Long = ACCENT_ENABLE_BLURBEHIND, iAttribute As Long = WCA_ACCENT_POLICY, iAccentFlags As Long = 0, iGradientColor As Ulong = 0) As Bool
Dim As Any Ptr hLib = Dylibload("User32.dll")
If hLib = 0 Then Return False
Dim pSetWindowCompositionAttribute As Function (Byval hWnd As HWND, Byval pAttrData As PVOID) As Bool
pSetWindowCompositionAttribute = Dylibsymbol(hLib, "SetWindowCompositionAttribute")
Dim As Bool iReturn
Dim As tagAccentPolicy tAccentPolicy
Dim As tagAttrData tAttrData
tAccentPolicy.AccentState = Iif(bEnable, iAccentState, ACCENT_DISABLED)
tAccentPolicy.AccentFlags = iAccentFlags 'DRAWALLBORDERS
tAccentPolicy.GradientColor = iGradientColor
tAttrData.Attribute = iAttribute
tAttrData.pDataBuffer = @tAccentPolicy
tAttrData.Size = Sizeof(tAccentPolicy)
iReturn = pSetWindowCompositionAttribute(hWnd, @tAttrData)
Dylibfree(hLib)
Return iReturn
End Function
Function _GDIPlus_Startup() As Bool
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
Return False
Endif
Return True
End Function
Sub _GDIPlus_Shutdown()
GdiplusShutdown(gdipToken)
End Sub
Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False, iCol_GDI As Ulong = &hFF000000) As Any Ptr
Dim As HGLOBAL hGlobal
Dim As LPSTREAM hStream
Dim As Any Ptr hImage_Stream
Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
Dim As Any Ptr lpMemory = GlobalLock(hMemory)
RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
GlobalUnlock(hMemory)
CreateStreamOnHGlobal(hMemory, False, @hStream)
GdipCreateBitmapFromStream(hStream, @hImage_Stream)
IUnknown_Release(hStream)
GlobalFree(hGlobal)
If bBitmap_GDI = True Then
Dim hImage_GDI As Any Ptr
GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, iCol_GDI)
GdipDisposeImage(hImage_Stream)
Return hImage_GDI
Endif
Return hImage_Stream
End Function
Function _WinAPI_SetWindowTitleIcon(hImage As Any Ptr, hHWND As Any Ptr, iBGColor As ULong = 0) As Boolean
Dim As any Ptr hImageBg, hGfx, hIcon
If iBGColor > 0 Then
GdipCreateBitmapFromScan0(16, 16, 0, PixelFormat32bppARGB, 0, @hImageBg)
GdipGetImageGraphicsContext(hImageBg, @hGfx)
GdipSetInterpolationMode(hGfx, InterpolationModeHighQualityBicubic)
GdipGraphicsClear(hGfx, iBGColor)
GdipDrawImageRect(hGfx, hImage, 0, 0, 16, 16)
GdipCreateHICONFromBitmap(hImageBg, @hIcon)
GdipDeleteGraphics(hGfx)
GdipDisposeImage(hImageBg)
Else
GdipCreateHICONFromBitmap(hImage, @hIcon)
EndIf
SendMessageW(hHWND, WM_SETICON, Iif(OS.dwBuildNumber < 9200, 1, 0), Cast(LParam, hIcon))
Return 1
End Function
Function _WinAPI_FileExtractIcon(sFilename As String, iFlag As Uinteger = SHGFI_SMALLICON) As HICON
Dim As SHFILEINFO tSHFILEINFO
If SHGetFileInfo(sFilename, FILE_ATTRIBUTE_READONLY, @tSHFILEINFO, Sizeof(SHFILEINFO), iFlag) Then Return tSHFILEINFO.hIcon
Return 0
End Function
Function _WinAPI_GetDpiForWindow(hWND As HWND) As Integer 'Windows 10, version 1607 [desktop apps only]
Dim As Any Ptr pLib = Dylibload("User32.dll")
If pLib = NULL Then Exit Function
Dim pGetDpiForWindow As Function (Byval hWND As HWND) As Integer
pGetDpiForWindow = Dylibsymbol(pLib, "GetDpiForWindow")
If pGetDpiForWindow Then Function = pGetDpiForWindow(hWND)
Dylibfree(pLib)
End Function
Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
Select Case uMsg
Case WM_CLOSE
PostQuitMessage(0)
Case WM_PAINT, WM_NCPAINT
SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
Return 1
Case WM_ERASEBKGND
SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
Return 0
Case WM_DPICHANGED_AFTERPARENT 'WM_DPICHANGED, WM_DPICHANGED_BEFOREPARENT
Dim As RECT tRECT
Dim As Long cw, ch
GetClientRect(hConsole, @tRECT)
cw = (tRECT.right - tRECT.left)
ch = (tRECT.bottom - tRECT.top)
SetWindowPos(hGUI_logo, HWND_TOP, _
(cw - iW * 1.20), (ch - iH * 1.20), _
iW, iH, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Select
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
Sub ChildGUIThread(param As Any Ptr)
Dim szAppName As ZString * 10 => "FB GUI"
Dim As String sTitle = "Radio Station by UEZ"
Dim wc As WNDCLASSEX
Dim msg As MSG
With wc
.cbSize = SizeOf(WNDCLASSEX)
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetStockObject(COLOR_WINDOW)
.lpszMenuName = NULL
.lpszClassName = Cast(LPCSTR, @szAppName)
End With
RegisterClassEx(@wc)
Dim As Long iDpi = _WinAPI_GetDpiForWindow(hConsole)
iDpi = IIf(iDpi = 0, 96, iDpi)
Dim As RECT tRECT
Dim As Long cw, ch
GetClientRect(hConsole, @tRECT)
cw = (tRECT.right - tRECT.left) * iDpi / 96
ch = (tRECT.bottom - tRECT.top) * iDpi / 96
If cw = 0 Or ch = 0 Then
Dim As CONSOLE_FONT_INFOEX fsc
fsc.cbSize = Sizeof(CONSOLE_FONT_INFOEX)
GetCurrentConsoleFontEx(hStdOut, 0, @fsc)
cw = fsc.dwFontSize.X * (iCsW - 1) * iDpi / 96
ch = fsc.dwFontSize.Y * (iCsH - 1) * iDpi / 96
End If
iCtrlPosX = (cw - iW * 1.20)
iCtrlPosY = (ch - iH * 1.20)
hGUI_logo = CreateWindowEx(WS_EX_TRANSPARENT Or WS_EX_TOPMOST Or WS_EX_NOACTIVATE, wc.lpszClassName, sTitle, _
WS_VISIBLE Or WS_POPUP Or WS_CLIPCHILDREN, _
iCtrlPosX, iCtrlPosY, _
iW, iH, _
NULL, NULL, wc.hInstance, NULL)
hPic_logo = CreateWindowEx(WS_EX_TRANSPARENT, "Static", "", WS_CHILD Or WS_VISIBLE Or SS_BITMAP Or WS_CLIPSIBLINGS, 0, 0, iW, iH, hGUI_logo, NULL, NULL, NULL)
SetParent(hGUI_logo, hConsole)
SetWindowPos(hGUI_logo, HWND_TOP, iCtrlPosX, iCtrlPosY, iW, iH, SWP_NOACTIVATE Or SWP_SHOWWINDOW)
SetWindowPos(hPic_logo, HWND_TOPMOST, 0, 0, iW, iH, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
SetLayeredWindowAttributes(hGUI_logo, 0, 255, LWA_ALPHA)
ShowWindow(hGUI_logo, SW_SHOWNOACTIVATE)
SetActiveWindow(hConsole)
SetFocus(hConsole)
SetForegroundWindow(hConsole)
While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Sleep(50)
Wend
End Sub
Function Base64Decode(sString As String, Byref iBase64Len as Uinteger) As Ubyte Ptr
#Define P0(p) InStr(B64, Chr(sString[n + p])) - 1
Dim As String*64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim As String sDecoded
Dim As Long nChars = Len(sString) - 1
If nChars < 0 Then Return 0
For n As Long = 0 To nChars Step 4
Var b = P0(1), c = P0(2), d = P0(3)
If b >-1 Then
Var a = P0(0)
sDecoded += Chr((a Shl 2 + b Shr 4))
End If
If c > -1 Then sDecoded += Chr((b Shl 4 + c Shr 2))
If d > -1 Then sDecoded += Chr((c Shl 6 + d ))
Next
iBase64Len = Len(sDecoded)
Static As Ubyte aReturn(0 To iBase64Len - 1)
Redim aReturn(0 To iBase64Len - 1) As Ubyte
For i As ULong = 0 to Len(sDecoded) - 1 'convert result string to ascii code values
aReturn(i) = Asc(sDecoded, i + 1)
Next
Return @aReturn(0) 'return pointer to the array
End Function
Function DecompressImage(sLabel As String, bGDI As BOOL = False) As Any Ptr
Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
Dim As String sBaseType, sBase64, aB64(1)
select Case sLabel
Case "Label0"
Restore __Label0:
End Select
Read iLines
Read bCompressed
Read iFileSize
Read iCompressedSize
Read sBaseType
For i As Ushort = 0 To iLines - 1
Read aB64(0)
sBase64 &= aB64(0)
Next
Dim As Uinteger iLenB64
Static As Ubyte Ptr aBinary
aBinary = Base64Decode(sBase64, iLenB64)
Dim As Any Ptr hBitmap = _GDIPlus_BitmapCreateFromMemory3(aBinary, iLenB64, bGDI)
aBinary = 0
sBase64 = ""
Return hBitmap
End Function
Function GetLatestNumber(iAccessType As Long = WINHTTP_ACCESS_TYPE_NO_PROXY, sUserAgent As String = "FB_WinHTTP/1.0", sProxyName As String = WINHTTP_NO_PROXY_NAME) As Ushort
Dim As Any Ptr hSession, hConnect, hRequest
Dim As String sRead
hSession = _WinHttpOpen(iAccessType, sUserAgent, sProxyName)
If hSession = 0 Then ? "hSession = " & hSession
hConnect = _WinHttpConnect(hSession, Wstr(sRadioSite))
If hConnect = 0 Then ? "hConnect = " & hConnect
hRequest = _WinHttpSimpleSendRequest(hConnect, "")
If hRequest = 0 Then ? "hRequest = " & hRequest
sRead = _WinHttpSimpleReadData(hRequest)
_WinHttpCloseHandle(hRequest)
_WinHttpCloseHandle(hConnect)
_WinHttpCloseHandle(hSession)
Dim As String sSearch = "<a class=" & Chr(34) & "date" & Chr(34) & " href=" & Chr(34) & "/remix/"
Dim As Long iLen = Len(sSearch), iPos = Instr(sRead, sSearch) + iLen, iLatestNumber = Valint(Mid(sRead, iPos, Instr(iPos, sRead, Chr(34)) - iPos))
iSongsreal = Valint(Mid(sRead, Instr(sRead, " tunes" & Chr(10)) - 4, 4))
If iSongsreal = 0 Then iSongsreal = iLatestNumber
Return iLatestNumber
End Function
Sub GetSongInfo(iSongNumer As Ushort, iAccessType As Long = WINHTTP_ACCESS_TYPE_NO_PROXY, sUserAgent As String = "FB_WinHTTP/1.0", sProxyName As String = WINHTTP_NO_PROXY_NAME)
Dim As Any Ptr hSession, hConnect, hRequest
Dim As String sRead
hSession = _WinHttpOpen(iAccessType, sUserAgent, sProxyName)
If hSession = 0 Then ? "hSession = " & hSession
hConnect = _WinHttpConnect(hSession, "www.remix64.com")
If hConnect = 0 Then ? "hConnect = " & hConnect
hRequest = _WinHttpSimpleSendRequest(hConnect, "box.php?id=" & Str(iSongNumer) & "00")
If hRequest = 0 Then ? "hRequest = " & hRequest
sRead = _WinHttpSimpleReadData(hRequest)
_WinHttpCloseHandle(hRequest)
_WinHttpCloseHandle(hConnect)
_WinHttpCloseHandle(hSession)
Dim As Ushort iPosStart1 = Instr(sRead, "Rating<br><b>") + Len("Rating<br><b>"), iPosEnd1 = Instr(Iif(iPosStart1 > 0, iPosStart1, 1), sRead, "%</b> (") + 1, _
iPosStart2 = Instr(sRead, "%</b> (") + 6, iPosEnd2 = Instr(Iif(iPosStart2 > 0, iPosStart2, 1), sRead, "votes)</td>") - 1
Dim As String sPosStart3 = " <td class=""tabCell3"">Original by:</td>" & Chr(10) & " <td class=""tabCell3""><b>", _
sPosStart4 = " <td class=""tabCell3"">Release Date:</td>" & Chr(10) & " <td class=""tabCell3""><b>", _
sPosStart5 = " <td class=""tabCell3"">All-Time Rank:</td>" & Chr(10) & " <td class=""tabCell3""><b>"
Dim As Ushort iPosStart3 = Instr(sRead, sPosStart3), iLenPS3 = Len(sPosStart3), _
iPosEnd3 = Instr(Iif(iPosStart3 > 0, iPosStart3, 1), sRead, "</b></td>" & Chr(10) & " </tr>" & Chr(10) & " <tr>" & Chr(10) & " <td class=""tabCell3"">Release Date:</td>"), _
iPosStart4 = Instr(sRead, sPosStart4), iLenPS4 = Len(sPosStart4), _
iPosEnd4 = Instr(Iif(iPosStart4 > 0, iPosStart4, 1), sRead, "</b></td>" & Chr(10) & " </tr>" & Chr(10) & " <tr>" & Chr(10) & " <td class=""tabCell3"">All-Time Rank:</td>"), _
iPosStart5 = Instr(sRead, sPosStart5), iPosEnd5 = Instr(Iif(iPosStart5 > 0, iPosStart5, 1), sRead, ".</b></td>" & Chr(10))
sRating = Str("???% (??? votes)")
sReleaseDate = Str("???")
sOriginal = Str("???")
sAllTimeRank = Str("???")
If Instr(sRead, "Rating<br><b>") > 0 Then sRating = Mid(sRead, iPosStart1, iPosEnd1 - iPosStart1) & " " & Mid(sRead, iPosStart2, iPosEnd2 - iPosStart2) & " votes)"
If iPosStart3 > 0 And iPosEnd3 > 0 Then sOriginal = Mid(sRead, iPosStart3 + iLenPS3, iPosEnd3 - iPosStart3 - iLenPS3)
If iPosStart4 > 0 And iPosEnd4 > 0 Then
sReleaseDate = Mid(sRead, iPosStart4 + iLenPS4, iPosEnd4 - iPosStart4 - iLenPS4)
sReleaseDate = Iif(Len(sReleaseDate) > 10, Str("???"), sReleaseDate)
Endif
If iPosStart5 > 0 And iPosEnd5 > 0 Then
sAllTimeRank = Mid(sRead, iPosStart5 + Len(sPosStart5), iPosEnd5 - iPosStart5 - Len(sPosStart5))
sAllTimeRank = Iif(Len(sAllTimeRank) > 5, Str("???"), sAllTimeRank)
Endif
End Sub
Sub GetTop50(sSearch As String = "", iAccessType As Long = WINHTTP_ACCESS_TYPE_NO_PROXY, sUserAgent As String = "FB_WinHTTP/1.0", sProxyName As String = WINHTTP_NO_PROXY_NAME)
Dim As Any Ptr hSession, hConnect, hRequest
Dim As String sRead
hSession = _WinHttpOpen(iAccessType, sUserAgent, sProxyName)
If hSession = 0 Then ? "hSession = " & hSession
hConnect = _WinHttpConnect(hSession, "remix.kwed.org")
If hConnect = 0 Then ? "hConnect = " & hConnect
If sSearch <> "" Then
hRequest = _WinHttpSimpleSendRequest(hConnect, "search/" & sSearch & "?page=1&chart=&view=rating&search=" & sSearch)
Else
hRequest = _WinHttpSimpleSendRequest(hConnect, "?chart=&view=rating&page=1")
Endif
If hRequest = 0 Then ? "hRequest = " & hRequest
sRead = _WinHttpSimpleReadData(hRequest)
_WinHttpCloseHandle(hRequest)
_WinHttpCloseHandle(hConnect)
_WinHttpCloseHandle(hSession)
Dim As Long iPosStart = 1, iPosEnd, c = 1
Dim As String s1 = "<a class=""date"" href=""/remix/", s2 = """ title=""Permalink"">"
While True
iPosStart = Instr(iPosStart, sRead, s1)
If iPosStart > 0 Then
iPosEnd = Instr(iPosStart, sRead, s2)
If iPosEnd > 0 Then
aTop50Titles(c) = Clng(Mid(sRead, iPosStart + Len(s1), iPosEnd - iPosStart - Len(s1)))
c += 1
iPosStart = iPosEnd
If c > iTop50Items Then Exit While
Endif
Else
Exit While
End If
Wend
iTop50Items = c - 1
If c > 1 Then
bTop50 = True
iOrder = 3
Endif
End Sub
Sub CallBack_Redirect(hInternet As Any Ptr, dwContext As DWORD_PTR, dwInternetStatus As DWORD, lpvStatusInformation As Zstring Ptr, dwStatusInformationLength As DWORD)
Dim As String sResult
For i As Ulong = 0 To 2 * dwStatusInformationLength - 1
sResult &= Str(*(@lpvStatusInformation[i]))
Next
iCounter += 1
If sRedirectURL = "https://remix.kwed.org/download-limit.php" Then
bLimitReached = True
Else
bLimitReached = False
Endif
sRedirectURL = Replace(sResult, "%20", " ")
End Sub
Sub GetRedirectedFilename(iNumber As Ushort)
Dim As Any Ptr hRequest
_WinHttpSetStatusCallback(hConnect, @CallBack_Redirect, WINHTTP_CALLBACK_STATUS_REDIRECT)
hRequest = _WinHttpSimpleSendRequest(hConnect, "download.php/" & iNumber)
_WinHttpCloseHandle(hRequest)
End Sub
Sub Download_CurrentSong(param As Any Ptr)
Dim As String sSuffixURL = Mid(SOUNDFILE, Instr(SOUNDFILE, sRadioSite) + Len(sRadioSite))
Dim As HINTERNET hRequest_Dl = _WinHttpOpenRequest(hConnect, "GET", sSuffixURL, "HTTP/1.1", WINHTTP_NO_REFERER, WINHTTP_DEFAULT_ACCEPT_TYPES, WINHTTP_FLAG_ESCAPE_DISABLE Or WINHTTP_FLAG_SECURE)
If hRequest_Dl = 0 Then Exit Sub
_WinHttpSendRequest(hRequest_Dl)
If _WinHttpReceiveResponse(hRequest_Dl) Then
Locate iCsH, 1, 0
Color iFGCol, iBGCol
? "Downloading...";
Dim As Ulong iNumberOfBytesRead, i, j = 0, iNumberOfBytesAvailable
Dim As Ubyte aBinData(iFileSize), aBuffer
Do
iNumberOfBytesAvailable = 0
If _WinHttpQueryDataAvailable(hRequest_Dl, @iNumberOfBytesAvailable) = 0 Then Exit Do
If iNumberOfBytesAvailable = 0 Then Exit Do
Redim aBuffer(iNumberOfBytesAvailable - 1)
WinHttpReadData(hRequest_Dl, @aBuffer(0), iNumberOfBytesAvailable, @iNumberOfBytesRead)
For i = 0 To Ubound(aBuffer)
If j <= iFileSize Then aBinData(j) = aBuffer(i)
j += 1
Next
Loop Until iNumberOfBytesAvailable = 0
Dim As Long hFile = Freefile()
Open Exepath & "\" & sRadioSite & "\" & sPlaying For Binary Access Write As #hFile
Put #hFile, 0, aBinData(0), iFileSize
Close #hFile
Endif
_WinHttpCloseHandle(hRequest_Dl)
iDLFinished = 2
End Sub
Function ShortenString(sPlaying As String, txt As String) As String
Dim As Byte iDiff = (iCsW - 1) - Len(txt) - Len(sPlaying), iDiff1
If iDiff < 0 Then
iDiff1 = Len(sPlaying) + iDiff
sPlaying = Left(sPlaying, iDiff1 \ 2 - 2) & "..." & Right(sPlaying, iDiff1 \ 2 - 1)
End If
Return sPlaying
End Function
Function Stream() As hStream
Select Case iOrder
Case 0
If bOneTime Then
bOneTime = 0
Else
iNumber = 1 + Cshort(Rnd * iSongs) '2404
End If
Case 1
iNumber -= 1
If iNumber = 0 Then iNumber = iSongs + 1
Case 2
iNumber += 1
If iNumber > iSongs + 1 Then iNumber = 1
Case 3
If iTop50Pos = 0 Or iTop50Pos > iTop50Items Then
If iTop50PosDir = -1 Then
iTop50Pos = iTop50Items
Else
iTop50Pos = 1
Endif
Endif
iNumber = aTop50Titles(iTop50Pos)
iTop50Pos += 1 * iTop50PosDir
End Select
SOUNDFILE = "https://" & sRadioSite & "/download.php/" & Str(iNumber)
GetRedirectedFilename(iNumber)
Dim As Double fTimer = Timer
While sRedirectURL = ""
Sleep(10)
If Timer - fTimer > 1 Then Exit While
Wend
GetSongInfo(iNumber)
sPlaying = Mid(sRedirectURL, Instrrev(sRedirectURL, "/") + 1)
sRedirectURL = ""
Dim As Byte iDiff = (iCsW - 1) - Len("Playing: ") - Len(sPlaying), iDiff1
If iDiff < 0 Then
iDiff1 = Len(sPlaying) + iDiff
sPlaying = Left(sPlaying, iDiff1 \ 2 - 2) & "..." & Right(sPlaying, iDiff1 \ 2 - 1)
End If
Dim As HSTREAM hStream = _BASS_StreamCreateURL(SOUNDFILE)
iBytesLen = _BASS_ChannelGetLength(hStream)
iFileSize = _BASS_StreamGetFilePosition(hStream, BASS_FILEPOS_SIZE)
_BASS_ChannelGetAttribute(hStream, fBitrate)
iFilePosStart = _BASS_StreamGetFilePosition(hStream, BASS_FILEPOS_START)
length = _BASS_ChannelBytes2Seconds(hStream, iBytesLen)
iEnd = BASS_StreamGetFilePosition(hStream, BASS_FILEPOS_END)
_BASS_ChannelSetAttribute(hStream, BASS_ATTRIB_VOL, vol)
_BASS_ChannelPlay(hStream)
If iFileSize <> -1 Then
Color iFGCol, iBGCol
ClrConsole2(hStdOut) ', 14, 0, iCsW, 8, 0, 0)
Sleep(50)
? "URL: " & SOUNDFILE
? "Playing: " & ShortenString(sPlaying, "Playing: ")
? "Release Date: " & sReleaseDate
sOriginal = "Original by: " & ShortenString(sOriginal, "Original by: ") & Chr(10)
WriteConsole(hStdOut, StrPtr(sOriginal), Len(sOriginal), 0, 0)
? "Rating: " & sRating & " / All-time rank: " & sAllTimeRank
? "Bitrate: " & Wchr(&h00D8) & " " & Int(iFileSize * 8 / length / 1000) & " kbps (" & fBitrate & " kbps)"
? "Size: " & iFileSize & " bytes / " & Format(iFileSize / 1024 ^ 2, "##0.00 mib")
Dim As String sec, mins, hr, ms
ms = Format(Frac(length) * 1000, "000")
ms = Iif(ms = "1000", "000", ms)
sec = Format(length Mod 60, "00")
mins = Format(length \ 60, "00")
hr = Format(length \ 3600, "00")
? "Length: " & Format(length, "##0.00 s / ") & hr & ":" & mins & ":" & sec & ":" & ms
Else
Locate iCsH - 3, 1, 0
End If
SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
Return HSTREAM
End Function
Function mouseProc(nCode As Integer, wParam As WPARAM, lParam As LPARAM) As LRESULT
If nCode >= HC_ACTION And wParam = WM_LBUTTONUP Then
Dim As MENUITEMINFO tMENUITEMINFO
tMENUITEMINFO.cbSize = Sizeof(MENUITEMINFO)
tMENUITEMINFO.fMask = MIIM_STATE Or MIIM_ID Or MIIM_SUBMENU Or MIIM_CHECKMARKS Or MIIM_TYPE Or MIIM_DATA
GetMenuItemInfo(hSysMenu, id_Exit, False, @tMENUITEMINFO)
If tMENUITEMINFO.fState And MF_HILITE Then
bExit = 1
Endif
Endif
Return CallNextHookEx(hMouseHook, nCode, wParam, lParam)
End Function
Sub ChkMouseThread(param As Any Ptr)
hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, Cast(HOOKPROC, @mouseProc), GetModuleHandle(NULL), 0)
Dim As MSG msg
While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Sleep(50)
Wend
End Sub
Function Check4TLS() As Long
Dim As SYSTEM_INFO tSYSTEM_INFO 'https://docs.microsoft.com/en-us/windows/win32/api/sysinfoapi/ns-sysinfoapi-system_info
GetNativeSystemInfo(@tSYSTEM_INFO)
Dim As Any Ptr hReg, hReg2
Dim As Long iReturn
Dim As DWORD BinaryType
GetBinaryType(Command(0), @BinaryType)
If tSYSTEM_INFO.wProcessorArchitecture = 9 And BinaryType = 0 Then
iReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp", 0, KEY_QUERY_VALUE, @hReg)
If iReturn Then Return -iReturn
iReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Internet Settings", 0, KEY_QUERY_VALUE, @hReg2)
If iReturn Then Return -iReturn
Else
iReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp", 0, KEY_QUERY_VALUE, @hReg)
If iReturn Then Return -iReturn
iReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings", 0, KEY_QUERY_VALUE, @hReg2)
If iReturn Then Return -iReturn
Endif
Dim As DWORD iRegValue, iRegValue2, iRegValueLength = Sizeof(DWORD)
RegQueryValueEx(hReg, "DefaultSecureProtocols", NULL, NULL, Cast(Byte Ptr, @iRegValue), @iRegValueLength)
RegQueryValueEx(hReg2, "SecureProtocols", NULL, NULL, Cast(Byte Ptr, @iRegValue2), @iRegValueLength)
RegCloseKey(hReg)
RegCloseKey(hReg2)
If (iRegValue And &h0A00) /'And (iRegValue2 And &h0A00)'/ Then Return 3 'TLS 1.1 and TLS 1.2 supported
If (iRegValue And &h0800) /'And (iRegValue2 And &h0800)'/ Then Return 2 'TLS 1.2 supported
If (iRegValue And &h0200) /'And (iRegValue2 And &h0200)'/ Then Return 1 'TLS 1.1 supported
Return 0 'either TLS 1.1 or TLS 1.2 is not supported
End Function
If OS.dwBuildNumber < 9200 And Check4TLS < 1 Then End 5 * MessageBox(0, "TLS 1.1 and TLS 1.2 must be enabled to run Radio Station (see Readme.txt)!", "ERROR", MB_OK Or MB_ICONSTOP Or MB_TOPMOST)
If _GDIPlus_Startup() = False Then End 4
sRedirectURL = ""
AllocConsole()
Dim As Ulong iOldCP = GetConsoleOutputCP()
SetConsoleOutputCP(65001)
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hConsole = GetConsoleWindow()
SetConsoleActiveScreenBuffer(hStdOut)
While (GetWindowLong(hConsole, GWL_STYLE) And WS_MINIMIZE) = WS_MINIMIZE
Sleep(10)
Wend
Dim As DWORD cmode
GetConsoleMode(hStdIn, @cmode)
Dim As _CONSOLE_FONT_INFOEX fi = GetFontInfo()
Dim As Zstring * 255 sTitle
GetConsoleTitle(sTitle, 255)
savebuffinfoex.cbSize = Sizeof(CONSOLE_SCREEN_BUFFER_INFOEX)
GetConsoleScreenBufferInfoEx(hStdOut, @savebuffinfoex)
SetConsoleMode(hStdIn, ENABLE_EXTENDED_FLAGS Or (cmode And (Not ENABLE_MOUSE_INPUT) And (Not ENABLE_QUICK_EDIT_MODE) And (Not ENABLE_PROCESSED_INPUT)))
SetConsoleCtrlHandler(Null, True)
Dim As HDC scr = GetDC(hConsole)
Dim As Long iDPI = GetDeviceCaps (scr, LOGPIXELSX)
ReleaseDC (hConsole, scr)
fDPI_ratio = 96 / iDPI
If OS.dwBuildNumber < 9200 Then fDPI_ratio = iDPI / 96
SetFontSize(iFsW * fDPI_ratio, iFsH * fDPI_ratio)
SetConsoleSize(iCsW, iCsH)
Dim As RECT tRECT
Dim As Long cw, ch
GetClientRect(hConsole, @tRECT)
iConsoleW = tRECT.right - tRECT.left
iConsoleH = tRECT.bottom - tRECT.top
hImage = DecompressImage("Label0")
GdipGetImageDimension(hImage, @iW, @iH)
Dim As HICON hIcon_prev = Cast(HICON, SendMessage(hConsole, WM_GETICON, Cast(LParam, ICON_SMALL2), 0))
If hIcon_prev = 0 Then hIcon_prev = Cast(HICON, SendMessage(hConsole, WM_GETICON, Cast(LParam, ICON_SMALL), 0))
If hIcon_prev = 0 Then hIcon_prev = Cast(HICON, SendMessage(hConsole, WM_GETICON, Cast(LParam, ICON_BIG), 0))
If hIcon_prev = 0 Then hIcon_prev = Cast(HICON, GetClassLongPtr(hConsole, GCL_HICON))
If hIcon_prev = 0 Then hIcon_prev = Cast(HICON, GetClassLongPtr(hConsole, GCL_HICONSM))
If _WinAPI_GetProcessName(_WinAPI_GetParentProcess()) = "cmd.exe" Then
_WinAPI_SetWindowTitleIcon(hImage, hConsole) 'set new windows icon
Else
Dim As HICON hIcon = _WinAPI_FileExtractIcon(Exepath)
SendMessageW(hConsole, WM_SETICON, Iif(OS.dwBuildNumber < 9200, 1, 0), Cast(LParam, hIcon))
Endif
Dim As Ubyte iPos
Dim As String sUserAgent = "FB_WinHTTP/1.0", sProxyName = WINHTTP_NO_PROXY_NAME
Dim As Long iAccessType = WINHTTP_ACCESS_TYPE_NO_PROXY
Dim As Bool bGlass = False, bGlass10 = False, bGlassSet = False, bTopmost = False
? "Initializing WinHTTP..."
If _WinHttpStartup() = False Then ? "Unable To initialize Winhttp.dll! Exiting..." : End 1
? "Initializing Bass.dll..."
If _Bass_Startup(Exepath) = False Then ? "Unable To initialize Bass.dll! Exiting..." : End 2
? "Getting latest song number..."
iPos = SearchInCMDArgument("/proxy")
If iPos And Len(Command(iPos + 1)) > 0 Then sProxyName = (Command(iPos + 1))
If sProxyName <> "" Then iAccessType = WINHTTP_ACCESS_TYPE_NAMED_PROXY
hSession = _WinHttpOpen(iAccessType, sUserAgent, sProxyName)
hConnect = _WinHttpConnect(hSession, Wstr(sRadioSite))
iSongs = GetLatestNumber(iAccessType, sUserAgent, sProxyName)
If iSongs = 0 Then ? "Unable To Get latest song number! Exiting..." : End 3
iPos = SearchInCMDArgument("/number")
If iPos And Len(Command(iPos + 1)) > 0 Then
iNumber = ValInt(Command(iPos + 1))
iNumber = Iif(iNumber < 1, 1, Iif(iNumber > iSongs + 1, iSongs + 1, iNumber))
Endif
If iNumber > 0 Then bOneTime = 1
Dim As String sSearchToken = ""
iPos = SearchInCMDArgument("/search")
If iPos And Len(Command(iPos + 1)) > 0 Then
sSearchToken = Command(iPos + 1)
Endif
If SearchInCMDArgument("/top50") Then
GetTop50(sSearchToken)
If iNumber > 0 Then iTop50Pos = Iif(iNumber > iTop50Items, iTop50Items, iNumber)
iPos = SearchInCMDArgument("/top50dir")
If iPos And Len(Command(iPos + 1)) > 0 Then
iTop50PosDir = ValInt(Command(iPos + 1))
iTop50PosDir = Iif(iTop50PosDir > 1 Or iTop50PosDir = 0, 1, Iif(iTop50PosDir < -1, -1, iTop50PosDir))
Endif
Endif
iPos = SearchInCMDArgument("/order")
If iPos And Len(Command(iPos + 1)) > 0 Then
iOrder = ValInt(Command(iPos + 1))
iOrder = Iif(iOrder > 2, 2, Iif(iOrder < 0, 0, iOrder))
Endif
Dim As String sOrder = "Playing songs randomly"
Select Case iOrder
Case 1 'play from latest to oldest
If iNumber = -1 Then
iNumber = iSongs + 1
Else
iNumber += 1
Endif
sOrder = "Playing songs from latest to oldest"
Case 2 'play from oldest to latest
If iNumber = -1 Then
iNumber = 0
Else
iNumber -= 1
Endif
sOrder = "Playing songs from oldest to latest"
Case 3 'playing Top50 from 1st place to last place
sOrder = "Playing Top50 " & Iif(iTop50PosDir = 1, "ascending", "descending")
End Select
If SearchInCMDArgument("/nolevel") Then bShowLevel = 0
If SearchInCMDArgument("/noautoswitchdevice") Then bAutoSwitchDevice = 0
iPos = SearchInCMDArgument("/cfg")
If iPos And Len(Command(iPos + 1)) > 0 Then
iFGCol = ValInt(Command(iPos + 1))
iFGCol = Iif(iFGCol > 15, 15, Iif(iFGCol < 0, 0, iFGCol))
Endif
iPos = SearchInCMDArgument("/cbg")
If iPos And Len(Command(iPos + 1)) > 0 Then
iBGCol = ValInt(Command(iPos + 1))
iBGCol = Iif(iBGCol > 15, 15, Iif(iBGCol < 0, 0, iBGCol))
Endif
If SearchInCMDArgument("/glass") Then bGlass = True
If SearchInCMDArgument("/blur10") And OS.dwBuildNumber > 10000 Then bGlass10 = True
If _WinAPI_DwmIsCompositionEnabled() And (bGlass Or bGlass10) Then
If bGlass10 Then
_WinAPI_EnableBlurBehindWindow(hConsole)
_WinAPI_SetWindowCompositionAttribute(hConsole)
Else
_WinAPI_EnableBlurBehindWindow(hConsole)
Endif
bGlassSet = True
Endif
If SearchInCMDArgument("/topmost") Then
SetWindowPos(hConsole, (HWND_TOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
bTopmost = True
Endif
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
buffinfoex.cbSize = Sizeof(CONSOLE_SCREEN_BUFFER_INFOEX)
GetConsoleScreenBufferInfoEx(hStdOut, @buffinfoex)
iPicBGColor = Rgba((buffinfoex.ColorTable(iBGCol) And &hFF), (buffinfoex.ColorTable(iBGCol) And &h00FF00) Shr 8, (buffinfoex.ColorTable(iBGCol) And &h00FF0000) Shr 16, 255) 'get console color and convert it to ARGB
Color iFGCol, iBGCol
ClrConsole2(hStdOut)
Sleep(50)
hSysMenu = GetSystemMenu(hConsole, False)
Dim As Integer iOldStyle = GetWindowLong(hConsole, GWL_STYLE), iCount = GetMenuItemCount(hSysMenu)
Dim As HMENU aSave(0 To 3)
Dim As Uinteger aID(0 To Ubound(aSave))
Dim As HBITMAP aBmp(0 To Ubound(aSave))
Dim As ZString * 255 aTxt(0 To Ubound(aSave))
For j As Ubyte = 0 To Ubound(aSave)
Dim As MENUITEMINFO tMENUITEMINFO
tMENUITEMINFO.cbSize = Sizeof(MENUITEMINFO)
tMENUITEMINFO.fMask = &h3F
GetMenuItemInfo(hSysMenu, iCount - j - 1, True, @tMENUITEMINFO)
aSave(j) = GetSubMenu(hSysMenu, iCount - j - 1)
aBmp(j) = Cast(HBITMAP, tMENUITEMINFO.hbmpItem)
aID(j) = GetMenuItemID(hSysMenu, iCount - j - 1)
GetMenuString(hSysMenu, iCount - j - 1, Cast(LPSTR, @aTxt(j)), 255, MF_BYPOSITION)
Next
For j As Ubyte = iCount - 1 To iCount - 4 Step - 1 'delete last 4 menu entries
RemoveMenu(hSysMenu, j, MF_BYPOSITION)
Next
AppendMenu(hSysMenu, MF_STRING, id_Exit, "&Exit Radio Station")
Dim As MENUITEMINFO tMenuItem
With tMenuItem
.cbsize = Sizeof(tMenuItem)
.wID = id_Exit
.fMask = MIIM_BITMAP
.fType = MFT_OWNERDRAW Or MFT_STRING
.hbmpItem = Cast(HBITMAP, 8) 'aBmp(3)
End With
SetMenuItemInfo(hSysMenu, id_Exit, False, @tMenuItem)
SetWindowLong(hConsole, GWL_STYLE, iOldStyle And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX) 'grey Out maximize icon And disable resizing
DrawMenuBar(hSysMenu)
? "Please wait while connecting to a song..."
If bAutoSwitchDevice Then _BASS_SetConfig(BASS_CONFIG_DEV_DEFAULT, True) 'This option adds a "Default" entry to the output device list, which maps to the device that is currently the system's default.
'Its output will automatically switch over when the system's default device setting changes
_Bass_Init()
Dim As HSTREAM hStream = Stream()
Dim As QWORD iCurrentPos
Dim As Double t1, p = 0
Dim As Any Ptr thread, threadGUI, threadMouse
Dim As Integer bPause = 0, r = 1
Dim As BASS_LEVELS Levels
Dim As Ubyte aColorsBg(...) = {iBGCol, iBGCol, 1, 3, 9, 11, 7, 15}, aColorsFg(...) = {15, 15, 15, 14, 14, 13, 5, 1}, iUB = Ubound(aColorsBg), iLevel
Dim As String sec, mins, hr, ms
Dim As Single br
GdipCreateHBITMAPFromBitmap(hImage, @hBitmap, iPicBGColor)
threadGUI = ThreadCreate(@ChildGUIThread, 0)
Sleep(100)
threadMouse = ThreadCreate(@ChkMouseThread, 0)
iPosCursor = Csrlin
Dim As String sWaitChars = "|/-\"
Dim As Ubyte iPosWC = 1
While True
If bExit Then Exit While
If GetForegroundWindow() = hConsole Then 'https://docs.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes
If GetAsyncKeyState(VK_ESCAPE) Or GetAsyncKeyState(&h51) Then Exit While 'ESC or q to exit program
If (GetAsyncKeyState(VK_SPACE) And &h8000) And bPause = 0 And bEndless = 0 Then 'skip current song and load next one
While (GetAsyncKeyState(VK_SPACE) And &h8001)
Sleep(10)
Wend
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
Elseif (GetAsyncKeyState(VK_BACK) And &h8000) Then 'backspace to play again
While (GetAsyncKeyState(VK_BACK) And &h8001)
Sleep(10)
Wend
_BASS_ChannelSetPosition(hStream, 0, BASS_POS_BYTE Or BASS_POS_SCAN)
Elseif (GetAsyncKeyState(&h45) And &h8000) Then 'press e to play song endless
While (GetAsyncKeyState(&h45) And &h8001)
Sleep(10)
Wend
If bEndless = 0 Then
bEndless = 1
Else
bEndless = 0
End If
Elseif (GetAsyncKeyState(&h50) And &h8000) Then 'press p to pause / resume stream
While (GetAsyncKeyState(&h50) And &h8001)
Sleep(10)
Wend
If bPause = 0 Then
_BASS_ChannelPause(hStream)
bPause = 1
Else
_BASS_ChannelPlay(hStream, False)
bPause = 0
End If
Elseif (GetAsyncKeyState(VK_MEDIA_PLAY_PAUSE) And &h8000) Then 'press p to pause / resume stream
While (GetAsyncKeyState(VK_MEDIA_PLAY_PAUSE) And &h8001)
Sleep(10)
Wend
If bPause = 0 Then
_BASS_ChannelPause(hStream)
bPause = 1
Else
_BASS_ChannelPlay(hStream, False)
bPause = 0
End If
Elseif (GetAsyncKeyState(&h47) And &h8000) And bGlass10 = 0 Then 'press g to enable / disable glass effect
While (GetAsyncKeyState(&h47) And &h8001)
Sleep(10)
Wend
If bGlass = 0 Then
If _WinAPI_DwmIsCompositionEnabled() Then
_WinAPI_EnableBlurBehindWindow(hConsole)
bGlass = 1
bGlassSet = True
Endif
Else
If _WinAPI_DwmIsCompositionEnabled() Then
_WinAPI_EnableBlurBehindWindow(hConsole, False)
bGlass = 0
bGlassSet = False
Endif
Endif
Elseif (GetAsyncKeyState(&h54) And &h8000) Then 'press t to set console topmost or not
While (GetAsyncKeyState(&h54) And &h8001)
Sleep(10)
Wend
If bTopmost = 0 Then
SetWindowPos(hConsole, (HWND_TOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
bTopmost = 1
Else
SetWindowPos(hConsole, (HWND_NOTOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
bTopmost = 0
Endif
Elseif (GetAsyncKeyState(VK_OEM_PLUS) And &h8000) Or (GetAsyncKeyState(VK_ADD) And &h8000) Or (GetAsyncKeyState(VK_UP) And &h8000) Then '+ to increase volume
Sleep(100, 1)
If vol <= 1.0 Then
vol += 0.05
_BASS_ChannelSetAttribute(hStream, BASS_ATTRIB_VOL, vol)
Endif
Elseif (GetAsyncKeyState(VK_OEM_MINUS) And &h8000) Or (GetAsyncKeyState(VK_SUBTRACT) And &h8000) Or (GetAsyncKeyState(VK_DOWN) And &h8000) Then '- to decrease volume
Sleep(100, 1)
If vol > 0.05 Then
vol -= 0.05
_BASS_ChannelSetAttribute(hStream, BASS_ATTRIB_VOL, vol)
Endif
Elseif (GetAsyncKeyState(&h30) And &h8000) And bPause = 0 And iOrder <> 0 And bLimitReached = False Then '0 to play randomly a song
While (GetAsyncKeyState(&h30) And &h8001)
Sleep(10)
Wend
iOrder = 0
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
sOrder = "Playing songs randomly"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Elseif (GetAsyncKeyState(VK_NUMPAD0) And &h8000) And bPause = 0 And iOrder <> 0 And bLimitReached = False Then 'numpad 0 to play randomly a song
While (GetAsyncKeyState(VK_NUMPAD0) And &h8001)
Sleep(10)
Wend
iOrder = 0
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
sOrder = "Playing songs randomly"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Elseif (GetAsyncKeyState(&h31) And &h8000) And bPause = 0 And iOrder <> 1 And bLimitReached = False Then '1 to play from latest to oldest
While (GetAsyncKeyState(&h31) And &h8001)
Sleep(10)
Wend
iOrder = 1
iNumber = iSongs + 1
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
sOrder = "Playing songs from latest to oldest"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Elseif (GetAsyncKeyState(VK_NUMPAD1) And &h8000) And bPause = 0 And iOrder <> 1 And bLimitReached = False Then 'numpad 1 to play from latest to oldest
While (GetAsyncKeyState(VK_NUMPAD1) And &h8001)
Sleep(10)
Wend
iOrder = 1
iNumber = iSongs + 1
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
sOrder = "Playing songs from latest to oldest"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Elseif (GetAsyncKeyState(&h44) And &h8000) And bLimitReached = False Then 'd to download current playing song to local disk
While (GetAsyncKeyState(&h44) And &h8001)
Sleep(10)
Wend
If DirExists(Exepath & "\" & sRadioSite) = 0 Then Mkdir Exepath & "\" & sRadioSite
If iDLFinished = 0 And iFileSize <> -1 Then
thread = ThreadCreate(@Download_CurrentSong, 0)
iDLFinished = 1
Endif
Elseif (GetAsyncKeyState(VK_RIGHT) And &h8000) And bPause = 0 Then 'right to forward 5 seconds
'While (GetAsyncKeyState(VK_RIGHT) And &h8001)
' Sleep(10)
'Wend
Sleep(100)
If p + 5 < iBytesLen - 5 Then
Dim As QWORD iNewPos = _BASS_ChannelSeconds2Bytes(hStream, p + 5)
_BASS_ChannelSetPosition(hStream, iNewPos, BASS_POS_BYTE)
Endif
Elseif (GetAsyncKeyState(VK_LEFT) And &h8000) And bPause = 0 Then 'left to rewind 5 seconds
'While (GetAsyncKeyState(VK_LEFT) And &h8001)
' Sleep(10)
'Wend
Sleep(100)
If p - 5 >= 0 Then
Dim As QWORD iNewPos = _BASS_ChannelSeconds2Bytes(hStream, p - 5)
_BASS_ChannelSetPosition(hStream, iNewPos, BASS_POS_BYTE)
Endif
Elseif (GetAsyncKeyState(&h46) And &h8000) Then 'press f to play from current song to oldest song
While (GetAsyncKeyState(&h46) And &h8001)
Sleep(10)
Wend
iOrder = 1
sOrder = "Playing songs to oldest"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Elseif (GetAsyncKeyState(&h42) And &h8000) Then 'press b to play from current song to latest song
While (GetAsyncKeyState(&h42) And &h8001)
Sleep(10)
Wend
iOrder = 2
sOrder = "Playing songs to latest"
SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongsreal & " songs available / " & sOrder)
Endif
End If
_BASS_ChannelGetLevelEx(hStream, Levels, 0.02, BASS_LEVEL_MONO)
iCurrentPos = _BASS_ChannelGetPosition(hStream, BASS_POS_BYTE)
p = _BASS_ChannelBytes2Seconds(hStream, iCurrentPos)
Locate iPosCursor, 1, 0
Color iFGCol, iBGCol
ms = Format(Frac(p) * 1000, "000")
ms = Iif(ms = "1000", "000", ms)
sec = Format(p Mod 60, "00")
mins = Format(p \ 60, "00")
hr = Format(p \ 3600, "00")
If iFileSize = -1 Then
If bLimitReached Then
? "Played: Hourly limit reached! Please try later again. :-("
Else
? "Played: searching for a new song... " & Mid(sWaitChars, 1 + (iPosWC Mod 4), 1) & " "
iPosWC += 1
EndIf
Else
? "Played: " & hr & ":" & mins & ":" & sec & ":" & ms & " / " & Format(iCurrentPos / iBytesLen, "00.00 % / ") & Format (length - p, "##0.00 s / ") & "volume: " & Cubyte(vol * 100) & _
IIf(bEndless, " (endless) ", IIf(bPause, " (paused) ", " "))
Endif
Locate iPosCursor + 2, 1, 0
iLevel = Levels.Left * iUB
If bShowLevel Then Color aColorsFg(iLevel), aColorsBg(iLevel) ', 6 'aColors(6 - (Levels.Left + Levels.Right) * 6)
If iFileSize <> -1 Then ? sCoder;
If (iCurrentPos >= iBytesLen) Or (iFileSize - iFilePosStart - _BASS_StreamGetFilePosition(hStream, BASS_FILEPOS_CURRENT) <= 0) Then
If bEndless Then
_BASS_ChannelSetPosition(hStream, 0, BASS_POS_BYTE Or BASS_POS_SCAN)
Else
If bLimitReached = False Then
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
hStream = Stream()
iBytesLen = _BASS_ChannelGetLength(hStream)
Endif
Endif
End If
If iDLFinished = 2 Then
ThreadDetach(thread)
iDLFinished = 0
Locate iCsH, 1, 0
Color iFGCol, iBGCol
? " ";
End If
Sleep(15)
Wend
DestroyWindow(hGUI_logo)
ThreadDetach(threadGUI)
ThreadDetach(threadMouse)
_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
_Bass_Free()
_Bass_Shutdown()
_WinHttpCloseHandle(hConnect)
_WinHttpCloseHandle(hSession)
_WinHttpShutdown()
DeleteObject(hBitmap)
GdipDisposeImage(hImage)
_GDIPlus_Shutdown()
UnhookWindowsHookEx(hMouseHook)
'Restore console settings
If _WinAPI_GetProcessName(_WinAPI_GetParentProcess()) = "cmd.exe" Then
If bGlassSet Then
If OS.dwBuildNumber > 10000 And bGlass10 Then
_WinAPI_SetWindowCompositionAttribute(hConsole, False)
_WinAPI_EnableBlurBehindWindow(hConsole, False)
Else
_WinAPI_EnableBlurBehindWindow(hConsole, False)
Endif
Endif
SetWindowPos(hConsole, (HWND_NOTOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
SendMessageW(hConsole, WM_SETICON, 0, Cast(LParam, hIcon_prev))
SetWindowLong(hConsole, GWL_STYLE, iOldStyle Or WS_MAXIMIZEBOX Or WS_SIZEBOX)
SetConsoleMode(hStdIn, cmode)
SetConsoleScreenBufferInfoEx(hStdOut, @savebuffinfoex)
SetConsoleTitle(sTitle)
SetFontSize(fi.dwFontSize.x, fi.dwFontSize.y, fi.facename, fi.nFont, fi.FontWeight, fi.FontFamily)
SetConsoleOutputCP(iOldCP)
SetConsoleCtrlHandler(Null, False)
DeleteMenu(hSysMenu, id_Exit, MF_BYCOMMAND)
iCount = GetMenuItemCount(hSysMenu)
Dim As LPSTR pTxt(0 To Ubound(aSave))
Dim As MENUITEMINFO tMENUITEMINFO
With tMENUITEMINFO
.cbSize = Sizeof(MENUITEMINFO)
.fMask = MIIM_ID Or MIIM_STRING Or MIIM_SUBMENU Or MIIM_BITMAP
.fType = MFT_STRING
End With
For j As Byte = Ubound(aSave) To 0 Step -1
Dim As LPSTR pTxt
pTxt = Allocate(Len(aTxt(j)))
*pTxt = aTxt(j)
With tMENUITEMINFO
.wID = aID(j)
.hSubMenu = aSave(j)
.dwTypeData = pTxt
.hbmpItem = aBmp(j)
End With
InsertMenuItem(hSysMenu, iCount + Ubound(aSave) - j, True, @tMENUITEMINFO)
Next
DrawMenuBar(hSysMenu)
EnableMenuItem(hSysMenu, SC_CLOSE, MF_BYCOMMAND)
ClrConsole2(hStdOut)
UpdateWindow(hConsole)
Locate(1, 1, 1)
? "Bye...."
Endif
FreeConsole()
Sleep(100)
End 0
'Code below was generated by: FB File2Bas Code Generator v1.05 build 2020-09-23 beta
'C64_3D_2_82x64.png
__Label0:
Data 9,0,3027,0,"Base64"
Data "iVBORw0KGgoAAAANSUhEUgAAAFIAAABACAMAAAC+7NA5AAACxFBMVEUVADYgHF1KGShjHi0cGl9/Ji6PHCeQHCq4HxWUJjjCIhXBIBocHFWLLj0VETwvGjVTHjMzHTobGEYhH1oUGUIuHDshIVcfHEwfHkgSEjALDSYVCygQCywRES0YGEYeG1ImImEpI2YrJmkjH1SPHCcoIGctJn09NoE+MZN+YshXRqUsI3lJONaFZs0iGI6Md8lvHCWFJUaBb8A3LIknH2kVFVIzGC1pWbIqImkqInM0Ko4cFUYkH38yJ55pJEM9MMpaTJNEOYYsJ3UzHDQVFTEVADIAACAAABxKFSJ3Kj0VCSwICBhdIj1OGis4HzAoJEoWFSoTEyoREy0REi4TFCwLCxwKDiAGCRYHDCMHCxgHBxUDBREDAwcFAQkEAQNHcExSSHNKQXFQSHtPRX8cFWQcFVwVFVgVFU8VFUQrIncsIn4eGVYAABy8IyK7IRs8LpC0"
Data "IhxANI9RQ51eUKkyJ40mHGYpIXA4LY8yJHkrInUVFUkmHHEVADgpIGUtI2y3HBwVAEIiGYUuJ4AwJ4MxJ4gdFW1WSaEoFSMyFSgAJHoAABVcTqUVFVs0K4UAACQABC0iGWAVADy7KirEJyS8IhxoWa+4IhxvXbQVFUE0K5A4K4wVFTy/IQBEN5hIOZtGOpJLP5pZRqccABY7Los5L38VFTZoULWlIh4AAEYAAAB4XcGcJy8AAFArHVqzHBxUQaRLMGxhSq4WAB+DHiCPHCUVADEVADWzLzIrInIwJripKi8uIaknImwmHG6tHA8mHJXEIxxnUbAcFX07LpMcFW81K40VAF92ZLmxIhkfInthU6ZBNJZjU6yTf88ZFSFjTvc/Mb43JW1RPuknGVU0LHVIABhSG0ocFV90IlwcFXWGc8hMPH8VFVMcFWpNPZ+/IhyYHCJHOK0uJ3tlHEYAFVRbRqkcAFCQGBwrIpgsJ3hwVrsAHGm6uEWQAAAA"
Data "ZHRSTlP79v39/v32/f7+/vzl6NnHuq6poJaXj4N0eIWVnrnIv7evzNfl5+zt+/77+v79/vz+/v7++vX2+vb8/Pr5/vP+2Nvd5+zt8vjg2c/Rx5x7ZWdeU0lCOzQrJh0SCQUCAQB6kZ/ANAFUbwAACFpJREFUeNqN2IN75FwbBvCsbRRr47Vtu8Yg58XYrm3btrm27X3t/ax/4nuek06aneTqNXfdpr+9D3omOwyRDqtQwHtZRODaLbtehDw7a8fqoDAZfE+pJDOHkQZZeBcduHWX3pCZmWmYiv7ortUhsYD6Q4pBWegWfUl2dlYmBDDMI4/AR8+sjdGc6T9JS8QG7CppBDBLQEIM+oRH9Amzgmc2GYmKisA9dntXCURMQllPYsyMJiOuGPFNbvteMBtBFJIYIPXl6iCi8JsEUfbV9Zr9jlZ7F5AlUuRRtWq50m8SxPA3r9Rdz3W0ttmlSSyp0kYSpX8kTOMXT/9ypa6mKNfRBiOXJBPUKpU6"
Data "2E8SxC9v3XraSzZCSy5ZmfHx8QYIkm4gVZsJ6w8J4le3nkDxJpCt2DI+NWUEk+LRUxDJchXkudgZajLTIvs1iEhed4Jp707Rph8uKy0tLSsrO1xv9AAJOUlJdShRzExy4je/AHgFSKfT0d5dnlgBST4MSU6uSO5pMuoRTVFhjOF+tGTJ18ABWFd3vaiozd2v09WnpyN56BBFm3p0CQa9xz0XyU1+LI+SBDpfqKmrq6mBjkXd/0xMTORJMJPBrNeBmapCUu3HJoL9mOt0Omtu3nSCeC8dRDCBrEhOxpoMwyQ31Tfp9KmXf8QFVyqUM88liNF7cotyUS1yFqX0a7VaJHW69AoGSVq0Akxjwik3lAyjv6RUsjOQyu1/tDscuR3OIocjZViLpNdMfu/jjcFBwRs+Znqamtx02d2b14ZG05FDW6UkCRPZ0tLa3t4+5hhzpKKIJDWXbwiXES4xIR+/AguESUg4mbJjdUikjDv/IT6kko3d3QJpbQW2"
Data "+7J2mnw3SE4gChpC5LtQRPKRlxLgNE5ZuiUgPJZ467ICkmyNs1pv3LgBapeqWKP5DYLqphjguCspHKZ/hP9Lh3jw7eSszWtDomScy7EMiJElcXFxFy4Aao+fq/aSumBkOI4jtxseJmmQLV+6JTgsRjFVl6ElG+Ig1gtWe/xllZr21OqCHn4sVJKI7wx6SdKTlOQ55caH0AisyyhJVBaSaHa15cAWUWvA1IU8VJFOz18fEZB8EITAh5NuqBsUCeTqBgyol9q6LoP5o7q4ONH3XFCyUVBSkkSO5ln4qO55nyGxj/CkXX8q53eVau5cjejRBf5lLClNcqInyW08PFD4CUPCXFNkQ4n+Ys4pIFVzVxOFb8loPN2kB86ZAB4aGDCZNjFkTQOXSw2GHMjvkKUypajkWrrc0iTGnVgKIGQjo3ibgi6XqyGJI3NUvhOJfw0vQklpkgcLC5EMZqIyEcRko4hZKmfFJQtejY+XIpMQ1BUOFJrwxfRBaQgT"
Data "5PKSWV5yrW9JlpW9/tO9goJrki3LEcQgaSoNZ2AqefLni5i5ogOWJZ9XNtsW/TR+DVQoKyTLKwagoZcs/ThExmwVktRcKieiksvOVlc3Ny8cemr8P1T1NjQmA8indFMYlGHeFpDnf0Z0tW9JBQk5ctZisZgti5ub+576IaWgQI/zetTYIwTf3xhFjwJm9zR5LeM8oBeDfEhWIf+oykJTbTZD2dML/jbyv4LUkUNC8N0gOOboUSQgsw1nMgC9GOZDKkgoLYkkxGy2LGk+/WBOWWcn75lgCvlbbiGZffdMxvmMJBGp/KhqsZeEWGpra82Wq99PIjmAi0OncPoIflvQ8tG7j2c8fi1cSGLJsONYUkhCLP8yceQHGyIJB4pJl+Evd46deTwjzJf81GwRkghCRr/Hkb8bHINbggeR3D5NZmfeuQ9mAPE5eocW86TXozULOz/h1oQ8FMG+pDXvnziz3Ydcaa72JdPwne3DMIUYBHK9gMw23L3z6IlX"
Data "Y1ml8OhddFZEUtSyU07PQBEZnk01jgTz/qMnviACkqyqPGsWk4jaPsMLxaRst5B0ZZ5449huGT8ahTLmKZhJIZmGXFpabdpo2nwcj5gkWwUDBzPrtWPH1kA7CIXXVS6BksKWNhvn2qRrAhlIRY5sxHcNr/070HtyyMJer66CI8NcPRXvqKGozbZwfoy4JpDRBhefxkuYElfJ29sCAtav2bp9T6rxhwPHK6v+FII0SNpGpWoyShg5n7jGqbgan7Hixyxjuaq/88mhSqgK4Sy6gxCE2YwW16S3Bi9jQS5WvEWIA/oZ+p+UBK1GXf7tZOHseUcqqwQl0YPX2qvimvSeaA0tSGPl09WFpFGjKS5Wf5ufZ8qfM3Sk6s+FPAkgZoF4NoFkYx8RgVa7HVRrvJaS6vCwVc9PmmbPO15pXggckl5UXJPeDH7hsnpJek9IY4eUc+QWuDD28xV5prw5i46Y8cjgSETFexNIMAPi9lKOWq2Ylhb4qjtdg2Rx"
Data "OCvHAxGqdkLVIWg5U00kWZhO617oB9ofEPoe3dRhJNU7FKyC0If2mHXv5E/enj2vb1q0iWoiCSa7zeuNeeNwtMGwkQwkyHGnohyq5t3On3OwjxPp3hSTeLViWwtyHXwA/W6YkrNkSGLoSabAqnm3Zz/54CqSo2kHo8AUkWCSwLax/R1jHRNc/tHR4TBqKLlG+BssjlL2xYp8rHqgD1fo9EpJEucz4q2O3t6JiXO9mHMTvb/2U1LtU4KrGjFddeFBvD0Rk7ju8sC3ev/L59zI3ym5xUeE0KWSha7Iz7+dN/tA39WVkiSEjujNusF9kMHBQUe/mpYMg5kUhXsAi6RV8598MoKa0s9tEEX4V2/WDO577LF994Y1vwEpvjMUPisnC8Gq+avEpBAl8sigHeO/jk/NZIC4pHBWuarPywgrTfIjUkYFf/J+WX2iRjMrVkSKLodZjSZKESlSSWzYhuXvPsfvoJmrCi/6P42d5v/ByZJPAAAAAElFTkSu"
Data "QmCC"
Please compile it as console (-s console). I used my own bass.bi because built-in cannot handle x64 code.
Download source code and needed files: Radio Stations v0.61 build 2023-06-17 beta.zip (790 kb) or on my OneDrive
Happy listening