Radio Stations v0.50 build 2021-04-21 beta [Windows only]

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 708
Joined: May 05, 2017 19:59
Location: Germany

Radio Stations v0.50 build 2021-04-21 beta [Windows only]

Postby UEZ » Mar 11, 2021 14:35

If you are a C64 / Amiga music enthusiast then this might be something for you. It is a simple player using Bass.dll to connect to remix.kwed.org / amigaremix.com and play a random song from that site.

Image

Image

Keys:
* Backspace to play current song again
* Space to skip current song
* p to pause or resume current song
* +, - to increase / decrease volume level
* 0 to play songs randomly again
* 1 to play from latest to oldest song
* d to download current song to disk (exe path + folder remix.kwed.org or amigaremix.com)
* ESC or q to exit

Command-line parameter:
/nolevel -> disable sound level color flash
/order [0-2] -> plays the songs 0 = random, 1 = from latest to oldest, 2 = from oldest to latest
/cfg [0-15] -> set text color
/cbg [0-15] -> set background color

Example: "Radio Station remix.kwed.org.exe" /cfg 7 /cbg 1 /order 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.50 build 2021-04-21 beta
'Coded by UEZ
'Information: 100 downloads per IP per Hour allowed!

#Ifdef __Fb_64bit__
   #Inclib "gdiplus"
   #Include Once "win/gdiplus-c.bi"
#Else
   #Include Once "win/gdiplus.bi"
   Using Gdiplus
#Endif
#Include "String.bi"
#Include "fbthread.bi"
#Include "win\tlhelp32.bi"
#Include "win\commctrl.bi"
#Include "Bass2.bi"
#Include "WinHTTP.bi"

Dim Shared As OSVERSIONINFO OS
OS.dwOSVersionInfoSize = Sizeof(OS)
GetVersionEx(@OS)

If OS.dwBuildNumber < 7600 Then
   ? "This operating system is NOT supported! Win7+ is required!"
   End
Endif

Dim As String sCoder = "Coded by UEZ v0.50 build 2021-04-21 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))

Union uCol
   Dim As Ulong bgr
   Type
      As Ubyte r, g, b, a
   End Type
End Union

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
Dim Shared As Ubyte iCounter = 0, iFGCol = 15, iBGCol = 5, bShowLevel = 1
Dim Shared As Double length
Dim Shared As Single vol = 0.15, iW, iH, fBitrate
Dim Shared As Ubyte iOrder = 0, iDLFinished
Dim Shared As Ushort iNumber, iPosCursor, iConsoleW, iConsoleH
Dim Shared As Any Ptr hSession, hConnect, hImage, hConsole
Dim Shared As HBITMAP hBitmap
Dim Shared As HWND hGUI_logo, hPic_logo
Randomize

Function SearchInCMDArgument(sSearchFor As String) As Ubyte
   Dim As Ubyte i = 1
   Do
      If Command(i) = 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 = 800, nFontFamily As Uinteger = 0)
    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

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 _GDIPlus_Startup() As Bool
   GDIp.GdiplusVersion = 1
   If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
      'Error 1
      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))
   Sleep(50)
   DestroyIcon(hIcon)
   Return 1
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
   End Select
   Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Sub ChildGUI(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(BLACK_BRUSH)
      .lpszMenuName  = NULL
      .lpszClassName = @szAppName
   End With
   
   RegisterClassEx(@wc)
   
   hGUI_logo = CreateWindowEx(WS_EX_TRANSPARENT, wc.lpszClassName, sTitle, _
                        WS_VISIBLE Or WS_POPUP Or WS_CLIPCHILDREN, _
                        (iConsoleW - iW * 1.20), (iConsoleH - iH * 1.20), _
                        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, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
   SetWindowPos(hPic_logo, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
   SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
   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)
   
    'workaround for multiple embedded file other crash will occure
    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 GetLatestNumber() As Ushort
   Dim As Any Ptr hSession, hConnect, hRequest
   Dim As String sRead   
   hSession = _WinHttpOpen(WINHTTP_ACCESS_TYPE_DEFAULT_PROXY)
   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)
   Sleep(100)
   '<a class=3D"date" href=3D"https://remix.kwed.org/remix/6342" title=
   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))
   Return iLatestNumber
End Function

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
   sRedirectURL = Replace(sResult, "%20", " ")
End Sub

Sub GetRedirectedFilename(iNumber As Ushort)
   Dim As Any Ptr hRequest
   Dim As String sRead
   _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 iPosCursor + 3, 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 Stream() As hStream
   Select Case iOrder
      Case 0
         iNumber = 1 + Cshort(Rnd * iSongs) '2404
      Case 1
         iNumber -= 1
      Case 2
         iNumber += 1
   End Select
   SOUNDFILE = "https://" & sRadioSite & "/download.php/" & Str(iNumber)
   GetRedirectedFilename(iNumber)
   Sleep (150)
   sPlaying = Mid(sRedirectURL, Instrrev(sRedirectURL, "/") + 1)
   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
      Locate 1, 1, 0
      Color iFGCol, iBGCol
      Shell "Cls"
      ? "URL:     " & SOUNDFILE
      ? "Playing: " & sPlaying
      ? "Bitrate: " & Wchr(&h00D8) & " " & Int(iFileSize * 8 / length / 1000) & " kbps (" & fBitrate & " kbps)"
      ? "Size:    " & iFileSize & " bytes"
      ? Using "Length: ####.## seconds"; length
   Else
      Locate 6, 1, 0
   End If
   SendMessage(hPic_logo, STM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hBitmap))
   Return HSTREAM
End Function

Function _WinAPI_SetProcessDPIAware() As Bool 'Windows Vista+ [desktop apps only]
   Dim As Any Ptr pLib = Dylibload("User32.dll")
   If pLib = NULL Then Exit Function
   Dim pSetProcessDPIAware As Function () As Bool
   pSetProcessDPIAware = Dylibsymbol(pLib, "SetProcessDPIAware")
   If pSetProcessDPIAware Then Function = pSetProcessDPIAware()
   Dylibfree(pLib)   
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

If _GDIPlus_Startup() = False Then End 4

_WinAPI_SetProcessDPIAware()

AllocConsole()

Dim As Handle hStdOut = GetStdHandle(STD_OUTPUT_HANDLE), hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hConsole = GetConsoleWindow()

Dim As DWORD cmode
GetConsoleMode(hStdIn, @cmode)
SetConsoleMode(hStdIn, ENABLE_EXTENDED_FLAGS Or (cmode And (Not ENABLE_MOUSE_INPUT) And (Not ENABLE_QUICK_EDIT_MODE)))

Dim As HDC scr = GetDC(hConsole)
Dim As Long iDPI = GetDeviceCaps (scr, LOGPIXELSX)
ReleaseDC (hConsole, scr)

? "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..."
hSession = _WinHttpOpen(WINHTTP_ACCESS_TYPE_NO_PROXY)
hConnect = _WinHttpConnect(hSession, Wstr(sRadioSite))
iSongs = GetLatestNumber()
If iSongs = 0 Then ? "Unable To Get latest song number! Exiting..." : End 3

Dim As Ubyte 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

Select Case iOrder
   Case 1 'play from latest to oldest
      iNumber = iSongs + 1
   Case 2 'play from oldest to latest
      iNumber = 0
End Select

If SearchInCMDArgument("/nolevel") Then bShowLevel = 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

Dim As UInteger iLines, iCompression, iFileSize2, iCompressedSize
Dim As String sBaseType, sBase64, aB64(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize2
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB64(0)
   sBase64 &= aB64(0)
Next
Dim As UInteger l
Dim As Ubyte Ptr aBinary = Base64Decode(sBase64, iCompressedSize)
hImage = _GDIPlus_BitmapCreateFromMemory3(aBinary, iFileSize2)
GdipGetImageDimension(hImage, @iW, @iH)
aBinary = 0
sBase64 = ""

'Save previous window icon
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))

_WinAPI_SetWindowTitleIcon(hImage, hConsole) 'set new windows icon

Dim As Integer cw, ch
GetConsoleSize(cw, ch)
Dim As _CONSOLE_FONT_INFOEX fi = GetFontInfo()
Dim As Zstring * 255 sTitle
GetConsoleTitle(sTitle, 255)
Dim As CONSOLE_SCREEN_BUFFER_INFO buffinfo
GetConsoleScreenBufferInfo(hStdOut, @buffinfo)

SetConsoleTitle("Radio Station " & sRadioSite & " / ~" & iSongs & " songs available")

Dim As Single fDPI_ratio = 96 / iDPI
If OS.dwBuildNumber < 9200 Then fDPI_ratio = iDPI / 96
Dim As Ubyte iFsW = 8, iFsH = 12, iCsW = 90, iCsH = 9

SetFontSize(iFsW * fDPI_ratio, iFsH * fDPI_ratio)
SetConsoleSize(iCsW, iCsH)

iConsoleW = iFsW * iCsW * IIf(OS.dwBuildNumber < 9200 And fDPI_ratio <> 1, IIf(iDPI <= 120, 104 / iDPI, 1), 1)
iConsoleH = iFsH * iCsH * IIf(OS.dwBuildNumber < 9200 And fDPI_ratio <> 1, fDPI_ratio, 1)

Dim As Any Ptr hSysMenu = GetSystemMenu(hConsole, False)
Dim As Integer iOldStyle = GetWindowLong(hConsole, GWL_STYLE)
SetWindowLong(hConsole, GWL_STYLE, iOldStyle And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX) 'grey Out maximize icon And disable resizing
EnableMenuItem(hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED) 'grey Out Close icon
For j As Ubyte = 1 To 4 'delete last 5 menu entries
   DeleteMenu(hSysMenu, GetMenuItemCount(hSysMenu) - 1, MF_BYPOSITION)
Next

Color iFGCol, iBGCol
Shell "Cls"
? "Please wait while connecting to a song..."

_BASS_SetConfig(BASS_CONFIG_DEV_DEFAULT, True)
_Bass_Init()

Dim As HSTREAM hStream = Stream()

Dim As QWORD iCurrentPos
Dim As Double t1, p = 0
Dim As Any Ptr thread, threadGUI
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

Dim As uCol col
Dim As HDC dc = GetDC(hConsole)
col.bgr = GetPixel(dc, 0, 0) 'bgr
ReleaseDC(hConsole, dc)

GdipCreateHBITMAPFromBitmap(hImage, @hBitmap, Rgba(col.r, col.g, col.b, 255))

threadGUI = ThreadCreate(@ChildGUI, 0)

Sleep(100)

iPosCursor = Csrlin

Dim As Double t = Timer

While True
   Select Case Inkey()
      Case Chr(27), Chr(113) 'ESC or q to exit program
         Exit While
      Case Chr(32) 'skip current song And load Next one
         While Inkey() = Chr(32)
            Sleep (5)
         Wend
         _BASS_ChannelStop(hStream)
         _BASS_StreamFree(hStream)
         hStream = Stream()
         iBytesLen = _BASS_ChannelGetLength(hStream)
      Case Chr(8) 'backspace To play again
         While Inkey() = Chr(8)
            Sleep (5)
         Wend
         '_BASS_ChannelStop(hStream)
         _BASS_ChannelSetPosition(hStream, 0, BASS_POS_BYTE Or BASS_POS_SCAN)
         '_BASS_ChannelPlay(hStream)
      Case Chr(112) 'press p To pause / Resume stream
         While Inkey() = Chr(112)
            Sleep (5)
         Wend
         If bPause = 0 Then
            _BASS_ChannelPause(hStream)
            bPause = 1
         Else
            _BASS_ChannelPlay(hStream, False)
            bPause = 0
         End If
      Case Chr(43) '+ To increase volume
         While Inkey() = Chr(43)
            Sleep (5)
         Wend      
         If vol <= 1.0 Then vol += 0.05
         _BASS_ChannelSetAttribute(hStream, BASS_ATTRIB_VOL, vol)
      Case Chr(45) '- To decrease volume
         While Inkey() = Chr(45)
            Sleep (5)
         Wend
         If vol > 0.05 Then vol -= 0.05
         _BASS_ChannelSetAttribute(hStream, BASS_ATTRIB_VOL, vol)
      Case Chr(48) '0 to play randomly a song
         While Inkey() = Chr(48)
            Sleep (5)
         Wend
         iOrder = 0
         _BASS_ChannelStop(hStream)
         _BASS_StreamFree(hStream)
         hStream = Stream()
         iBytesLen = _BASS_ChannelGetLength(hStream)   
      Case Chr(49) '1 to play from latest to oldest
         While Inkey() = Chr(49)
            Sleep (5)
         Wend
         iOrder = 1
         iNumber = iSongs + 1
         _BASS_ChannelStop(hStream)
         _BASS_StreamFree(hStream)
         hStream = Stream()
         iBytesLen = _BASS_ChannelGetLength(hStream)      
      Case Chr(100) 'd to download current playing song to local disk
         While Inkey() = Chr(100)
            Sleep (5)
         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
   End Select
   _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")
   sec = Format(p Mod 60, "00")
   mins = Format(p \ 60, "00")
   hr = Format(p \ 3600, "00")

   If iFileSize <> -1 Then ? "Played:  " & Format(iCurrentPos / iBytesLen, "00.00 % / ") & Format (length - p, "##0.00 s / ") & hr & ":" & mins & ":" & sec & ":" & ms & " / volume: " & Cubyte(vol * 100) & "       "
   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 
      _BASS_ChannelStop(hStream)
      _BASS_StreamFree(hStream)
      hStream = Stream()
      iBytesLen = _BASS_ChannelGetLength(hStream)
   End If
   If iDLFinished = 2 Then
      ThreadDetach(thread)
      iDLFinished = 0
      Locate iPosCursor + 3, 1, 0
      Color iFGCol, iBGCol
      ? "                               ";
   End If
         
   Sleep(15)
Wend

DestroyWindow(hGUI_logo)
ThreadDetach(threadGUI)

_BASS_ChannelStop(hStream)
_BASS_StreamFree(hStream)
_Bass_Free()
_Bass_Shutdown()

_WinHttpCloseHandle(hConnect)
_WinHttpCloseHandle(hSession)
_WinHttpShutdown()

GdipDisposeImage(hImage)
_GDIPlus_Shutdown()

'Restore console settings
If _WinAPI_GetProcessName(_WinAPI_GetParentProcess()) = "cmd.exe" Then
   SendMessageW(hConsole, WM_SETICON, 0, Cast(LParam, hIcon_prev))
   SetConsoleMode(hStdIn, cmode)
   SetWindowLong(hConsole, GWL_STYLE, iOldStyle Or WS_MAXIMIZEBOX Or WS_SIZEBOX)
   EnableMenuItem(hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_ENABLED)
   SetConsoleTextAttribute(hStdOut, buffinfo.wAttributes)
   SetConsoleTitle(sTitle)
   SetConsoleSize(cw, ch)
   SetFontSize(fi.dwFontSize.x, fi.dwFontSize.y, fi.facename, fi.nFont, fi.FontWeight, fi.FontFamily)
   Shell "Cls"
   ? "Bye...."
Endif
FreeConsole()

End 0

'Code below was generated by: FB File2Bas Code Generator v1.05 build 2020-09-23 beta

'C64_3D_48x48_2.png
__Label0:
Data 9,0,3173,0,"Base64"
Data "iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAMLElEQVR4XsVaC5AV1Zn+zunue+/cO29gBpBZ5OVAxHILiWQVTRUbdssQNSaLkWg0SnbdJBU1koBGjSJLiC+2KqvJrpsioaxgscYVEl/RuCriAzVR4otBBxgIDDjIPO7cR3ef8//bc25P91wvEBmY3Z/6+Oc/XVP1ff9jzrmnr8Bx2sY1qlm5co6r6RwoWa8Jn3J9alCKbSIrG/h9yld7fa3e9eBv81PeS7cvb+rHCbJhCXhmvWrxCuJypcVCpXC61gKBh9YcQMBXXIrVwDoFsYIaBCn45G9m5stW3jeuA8dpNo7BnntIzVCevEm5WMQEySTAzAEAhD6OS8/IxBRDE6AxVylvAoDjFiDxCezFjQerNv1a3UNKvs2ES5khiQXIEBYl4gAQrcH4EnkdgMpBGrlizxQAGHEBr/zWbSVVt10reT2RkIZsCAzNPIWkqQRmLgMRGQzG"
Data "UlgmeSPaQlse9T7nFa0NRCLDHLcLsxjkHvry9olBBkQEIBZlMiekM6IV+MOT6vPKs5/giDwARjlRlBOm0IdiIwBshBiPsALSEiMm4NUninOKeflr0sIOycVASLCMLEAwcSSMmIwvRyxICokREbDlsWK9cp2HmFBlMoihPQ1QVA0TVwiJwXHPx4iqIAIbEQGkrHtJy5aoLSgmRuUeQCxMKR/7u3ZhW/sr2PLGBvx+0y/xzOa1+MNbv8H2nZvR+eE2FIp90e+AcaIFmKE9h7R1qcleWU9z2cACiJ4rpbB7fxvebHsa23Zswf6DO9CXPYjebDeIfbDwUPQ/wqHsdrR1/A7vtT8VPOuEZl11QgWsWPp7WyvxgNmcqLItKIoFiEqC+nN96FMdSNcCUlpmx3UcB7btIF1VhdraWlQF3nZsEGkIIZArduG9nY/jT+9v6D2hAs49c+6XSNsTiRmEuHXiasSblCFf6IVvd6GpqQnFoouenl7zIOEkkEgk"
Data "UFtXi+rqati2BTBBawWlPBTdPJRWvaPHjn7vX77bu375Nfmf3vTPvdcuu/rgRUsWd85edsP+McPbB9i+MmqVoX1PYfYpBHNAoginph8pq95UpL+/H319fchkqk0FkskE0nYVHMc2pJXyoUkjn8/B84qAJVdlkqkbtUfnkwbIY5AqIb/Dx7cW7vCU1m2aVIfWei+BPtBaHQjQJtLofPCRM/eUCVj/0540IOZHfR+R5zAuF6SdbtMilkihUPSRV94BmXbWS2k9BikOSsdxAxFpZn06gb/AEp933YJTKOTBgjpOOfXU3fDVj4kUiEx7mQpppaAGvFaJwJ9GRKfp8BkFnjSBioSrL3v+/eSU6tafLD+DjYDG+sy5gLDC7BvibDIfgmJBuUIWqVEMpRhOyl5rOViV/NTY9ofvnadQaa8B+PmC8/4t3Z/PXULQtwhLLBdF70YWNpg1SGsYIRx4aON1ACJtxJTEaXB4FDlpms7NPsv+wteuOoOjCmit"
Data "zyLLGtI6Aprj7IMRDW5BHUJaZPKK+KsXLEptxCewx574Th7Amr8588b1rTNm/KPuL5xGUkJIgiYfVCIcbn4UHgBD0jr0TBg3ifDVKyd8bc7Zk7eXDXHBLZ43SJ6YQ4SzQNEcGLD08h7R+YsWN23EMdrLr67KwXVnMJEhJSVDkzYgQ9ggyrYRxmRQ06BxxTcmrg7IP1I2xCvvfMoCY2rYInHLlB2NORLSvmv35+5cMv9lDNOY2RASARgazIiIU5hxoiEVCeAkFb593dTnWyaOv6FiHxDkzWXieh2TL3mNkDRHa1ozqseNbsfxGRtiRNCGLEV9rrSCCiuiByvCPhZ/u+Wtlpbx5ze3CL/iOO3lu2fqOoYmxJvW0HYaXCcAENizfb+H2IZfBTDaO7ZC+TYE2wAscABAQsA2PDQpXHH1+N2t0yctaJ4ssqg02Jr82UrrkDgQz4KJYx/uwBMaJ58M4M1hkwcYzHBdiVnpNhQh0MtV2P4Rw9USxGEb"
Data "MeOyK2Z3z5o1bf6EU8QeHMFsJtWay2dRkx4V9j0bH7WOERXPx6jGMWcdjwAIMLOFllQfzhv/36jlQqlNJybgUj36CkkU0YDunIPJSP1xQuu523EUk0R+g+vnTdvoMNuV5AEdeikSX8RxmJCCqp1aTK7eDEZ8XGFdgK32ot5uxxixBVMzm8B/vOtvX1k0+dajCgCznXMPlshrLpHVhyVvRCZk6uz//JGSGKYlE6P3Ts18QLbohrBsgBFZSRADwkg1TrC67cWvnHz5EQU4iapMtrgvIh/NgalIWBVGfAoF0r72r8MwbWbtc+/UyxekkALCcqJPeAbmX/kRHhCQrO9/4eKJnz2sANuyem3HRU9fd0mAFmHWeaioUCCZTQfMK+/+QdcMDMMcoRZYUpjjt5ASDITgimHB4DOBJJg2PrNw6vQKAclUda9lWejq3lUizwxFDG1ECJAB4muRAMSccuzk2ntu7k7hGE1aDkshMQAKZwBl5IVBSDyaEwGu"
Data "c7j4+JP/0Dq2vAK28w4x0PnRVmiiqP8NBqugI/KRB/GnBfG6ld//c+LYBCRYSBl4aaoMcPl1DAACotYaNDYLNCkhrKfX/fDuv4oFJNJbTb+JLPZ3dZisx7PA4bZOEZiGCGK+yJGJl+64tXP6JxZgJ2BZElJKKKXLLwQQzluESFxkUnfPbOjY9NSaO39VBwB2oqr+f5j3gcHYsfclNNafXHabZjxTuYiBmCNBZ1COX125dO+y2nGZf//Od+sZRzHLsrSwLAgAfZxAXqUhWUMXcwD5sMCQARwpIFBubBYEUtnXWpu21zzyk/ue/zuztOLW/9p9YN/elnzOw5TxF6B59NSQaCTkiNBDY6a3YOHeVE1y3bLlY/tRaVh7000/trMdy3xnNmaNegMYzDJKJfCVgucrKK3heR4EEcj3QKXrbvhuAZICX8ihe8z8nxsBK1dsuKNz966l2WwBrDOYM/PrsCznkwgIt/5QSIxsgN9oohelFHkhuJOZa4pF"
Data "t7k25V7seuKz2VwO3zrjAXB4g/DxWRZhtjn6H6WfQw9Gj4vUQiPgvp+9Pvn9t19rP9TVDWKJxsypmD55XiSggjAdWVR8whwUZuJK6ByunbMOzLryj5BxAkKGAcf0hTDhAWKcN3PZmjeiNlu25IEHu/bvv0QrRjKZRlPtZ9A8alosgLlymDmKy4nqj63pyqopVcA1cx97WFKhSZDHABogrEkSSgOoE0JABjCMy/SJvQwsaF1y/9ZSHNrq1Zun72x7+0+FfNHJpKuhFNBcczZqq5si8lye/Yrh/ouZ10MEaE+veWSejSPYe/d8MyMFpkrBSUA0AtwCIetdWbdp5jWrtlRcq1x//dxtt9z48L+CDi51bAeJhI09B1/ASXwOqtONJeIcbWQBjj4Xle1n1qJngGAcxWYs+VkOwNZjulqcNnPWbbUNjR/YtmO2+nQmhZ2dz6Kn70DlX51KRISZKi52I/Lx3ajoP+F3o5dfOqkwqmncQmlZeSKGZVmo"
Data "qnKw79DL+PCjHUckzRzGWpdlOXx+eIDTI3I7ff335r6Zrmu8nIjZkpa550wmkziUexs797wGpbyQvA6JaxNzGWkKfTmAWFyAkXtDc/Ot8x9OpjPfhBBIJJLh9Evk/H14t/3poKX2ReSHEqTQl4koqwIBHB2axYi+YvrRXRf+RypdvVgp6idieL4PrTQYLtp2PI9t7S8il+8pOyMxUyUQEkcoAgSEVRjxt5Qr7liwJiA+S2tqF0Iakr6vYNsJuH432nZuwo6grXqzH4JIH77viT+2DuPBhBNhFv6Cvf7mhkOzTr9orWXZp4LRqhRBWpYRYbpAUoACerL7oHTR3EQLYZmWAwMcZT4kHokDZk67+Pa33n/w/+6rBlct+uUXiwX3Ds/zTwk/rQ28wDBzIqWFhvoGNDU3w7YkXNdDoRAg76M/m4fnlYZdSpjjtK/cPck6+uv7f/GVQyMooBKLLrrf1r7+p4DwD2zLOcm2Hdi2jXRVBk1NzQbV1TVm"
Data "jYiQzxfN+4NCoRARIKKefKFw9orVn3kXx2kCx2GLL1l3ZpD9K9PpzJdrqmvH1NbVBVVoNK+WLMuC6/qGuO/7A7GplOPYPlu44JKv1zyJE2ACJ8hWr3jntKqq9LmNjQ3zAqJTiHgsEdVYUu5JpxNZ25a7AOzWgp79+wvtR3GC7H8BoP+BBmuYT0MAAAAASUVORK5CYII="


Bass2.bi

Code: Select all

'Coded by UEZ build 2021-04-21
#Include Once "windows.bi"
#Include Once "file.bi"

Const BASS_UNICODE = &h80000000, BASS_DEVICE_ENABLED = 1, BASS_DEVICE_DEFAULT = 2, BASS_DEVICE_INIT = 4, BASS_DEVICE_LOOPBACK = 8, BASS_FILEDATA_END = 0, BASS_FILEPOS_START = 3, _
     BASS_SAMPLE_8BITS = 1, BASS_SAMPLE_FLOAT = 256, BASS_SAMPLE_MONO = 2, BASS_SAMPLE_LOOP = 4, BASS_SAMPLE_3D = 8, BASS_SAMPLE_SOFTWARE = 16, _
     BASS_SAMPLE_MUTEMAX = 32, BASS_SAMPLE_VAM = 64, BASS_SAMPLE_FX = 128, BASS_STREAM_PRESCAN = &h20000, BASS_STREAM_AUTOFREE = &h400001, _
     BASS_STREAM_RESTRATE = &h800001, BASS_STREAM_BLOCK = &h100000, BASS_STREAM_DECODE = &h200000, BASS_MUSIC_RAMP = &h200, _
     BASS_MUSIC_RAMPS = &h400, BASS_MUSIC_SURROUND = &h800, BASS_MUSIC_SURROUND2 = &h1000, BASS_MUSIC_FT2PAN = &h2000, _
     BASS_MUSIC_FT2MOD = &h2000, BASS_MUSIC_PT1MOD = &h4000, BASS_MUSIC_NONINTER = &h10000, BASS_MUSIC_STOPBACK = &h80000, _
     BASS_ASYNCFILE = &h40000000, BASS_CTYPE_SAMPLE = 1, BASS_CTYPE_RECORD = 2, BASS_CTYPE_STREAM = &h10000, BASS_CTYPE_STREAM_OGG = &h10002, _
     BASS_CTYPE_STREAM_MP1 = &h10003, BASS_CTYPE_STREAM_MP2 = &h10004, BASS_CTYPE_STREAM_MP3 = &h10005, BASS_CTYPE_STREAM_AIFF = &h10006, _
     BASS_CTYPE_STREAM_CA = &h10007, BASS_CTYPE_STREAM_MF = &h10008, BASS_CTYPE_STREAM_AM = &h10009, BASS_CTYPE_STREAM_DUMMY = &h18000, _
     BASS_CTYPE_STREAM_DEVICE = &h18001, BASS_CTYPE_STREAM_WAV = &h40000, BASS_CTYPE_STREAM_WAV_PCM = &h50001, BASS_CTYPE_STREAM_WAV_FLOAT = &h50003, _
     BASS_CTYPE_MUSIC_MOD = &h20000, BASS_CTYPE_MUSIC_MTM = &h20001, BASS_CTYPE_MUSIC_S3M = &h20002, BASS_CTYPE_MUSIC_XM = &h20003, _
     BASS_CTYPE_MUSIC_IT = &h20004, BASS_CTYPE_MUSIC_MO3 = &h00100, BASS_DATA_AVAILABLE = 0, BASS_DATA_FIXED = &h20000000, _
     BASS_DATA_FLOAT = &h40000000, BASS_DATA_FFT256 = &h80000000, BASS_DATA_FFT512 = &h80000001, BASS_DATA_FFT1024 = &h80000002, _
     BASS_DATA_FFT2048 = &h80000003, BASS_DATA_FFT4096 = &h80000004, BASS_DATA_FFT8192 = &h80000005, BASS_DATA_FFT16384 = &h80000006, _
     BASS_DATA_FFT32768 = &h80000007, BASS_DATA_FFT_INDIVIDUAL = &h10, BASS_DATA_FFT_NOWINDOW = &h20, BASS_DATA_FFT_REMOVEDC = &h40, _
     BASS_DATA_FFT_COMPLEX = &h80, BASS_DATA_FFT_NYQUIST = &h100, BASS_POS_BYTE = 0, BASS_POS_MUSIC_ORDER = 1, BASS_POS_OGG = 3, _
     BASS_ATTRIB_FREQ = 1, BASS_ATTRIB_VOL = 2, BASS_ATTRIB_PAN = 3, BASS_ATTRIB_EAXMIX = 4, BASS_ATTRIB_NOBUFFER = 5, BASS_ATTRIB_VBR = 6, _
     BASS_ATTRIB_CPU = 7, BASS_ATTRIB_SRC = 8, BASS_ATTRIB_NET_RESUME = 9, BASS_ATTRIB_SCANINFO = 10, BASS_ATTRIB_NORAMP = 11, _
     BASS_ATTRIB_BITRATE = 12, BASS_ATTRIB_BUFFER = 13, BASS_ATTRIB_MUSIC_AMPLIFY = &h100, BASS_ATTRIB_MUSIC_PANSEP = &h101, _
     BASS_ATTRIB_MUSIC_PSCALER = &h102, BASS_ATTRIB_MUSIC_BPM = &h103, BASS_ATTRIB_MUSIC_SPEED = &h104, BASS_ATTRIB_MUSIC_VOL_GLOBAL = &h105, _
     BASS_ATTRIB_MUSIC_ACTIVE = &h106, BASS_ATTRIB_MUSIC_VOL_CHAN = &h200, BASS_ATTRIB_MUSIC_VOL_INST = &h300, BASS_MUSIC_PRESCAN = BASS_STREAM_PRESCAN, _
     BASS_LEVEL_STEREO = 2, BASS_FILEPOS_CURRENT = 0, BASS_FILEPOS_DECODE = BASS_FILEPOS_CURRENT, BASS_FILEPOS_DOWNLOAD = 1, BASS_FILEPOS_END = 2, _
     BASS_FILEPOS_START = 3, BASS_FILEPOS_CONNECTED = 4, BASS_FILEPOS_BUFFER = 5, BASS_FILEPOS_SOCKET = 6, BASS_FILEPOS_ASYNCBUF = 7, BASS_FILEPOS_SIZE = 8, _
     BASS_FILEPOS_BUFFERING = 9, BASS_TAG_ID3 = 0, BASS_TAG_ID3V2 = 1, BASS_TAG_OGG = 2, BASS_TAG_HTTP = 3, BASS_TAG_ICY = 4, BASS_TAG_META = 5, _
     BASS_TAG_APE = 6, BASS_TAG_MP4 = 7, BASS_TAG_WMA = 8, BASS_TAG_VENDOR = 9, BASS_TAG_LYRICS3 = 10, BASS_TAG_CA_CODEC = 11, BASS_TAG_MF = 13, _
     BASS_TAG_WAVEFORMAT = 14, BASS_TAG_AM_MIME = 15, BASS_TAG_AM_NAME = 16, BASS_TAG_RIFF_INFO = &h100, BASS_TAG_RIFF_BEXT = &h101, _
     BASS_TAG_RIFF_CART = &h102, BASS_TAG_RIFF_DISP = &h103, BASS_TAG_RIFF_CUE = &h104, BASS_TAG_RIFF_SMPL = &h105, BASS_TAG_APE_BINARY = &h1000, _
     BASS_TAG_MUSIC_NAME = &h10000, BASS_TAG_MUSIC_MESSAGE = &h10001, BASS_TAG_MUSIC_ORDERS = &h10002, BASS_TAG_MUSIC_AUTH = &h10003, _
     BASS_TAG_MUSIC_INST = &h10100, BASS_TAG_MUSIC_SAMPLE = &h10300, BASS_POS_SCAN   = &h40000000, BASS_LEVEL_MONO = 1, BASS_LEVEL_STEREO = 2, BASS_LEVEL_RMS = 4, _
     BASS_LEVEL_VOLPAN = 8, BASS_CONFIG_DEV_DEFAULT = 36

Type HSTREAM As DWORD
Type HPLUGIN As DWORD
Type HSAMPLE As DWORD
Type HMUSIC As DWORD
Type QWORD As Longint

Type BASS_DEVICEINFO
   As Zstring Ptr Name, driver
   As DWORD flags
End Type

Type BASS_CHANNELINFO
   As DWORD freq, chans, flags, ctype, origres
   As HPLUGIN plugin
   As HSAMPLE sample
   As Zstring Ptr filename
End Type

Type BASS_INFO
   As DWORD flags, hwsize, hwfree, freesam, free3d, minrate, maxrate
   As BOOL eax
   As DWORD minbuf, dsver, latency, initflags, speakers, freq
end type

Type BASS_LEVELS
   As Single Left, Right
End Type

Type ID3v1
   As Ubyte id(3), title(30), artist(30), album(30), Year(4), comment(30), genre
End Type


Dim Shared BASS_Init As Function Stdcall(Byval As Long, Byval As DWORD, Byval As DWORD, Byval As HWND, Byval As GUID Ptr) As BOOL
Dim Shared BASS_GetDeviceInfo As Function Stdcall(As DWORD, As BASS_DEVICEINFO Ptr) As BOOL
Dim Shared BASS_GetInfo As Function Stdcall(As BASS_INFO) As BOOL
Dim Shared BASS_GetDevice As Function Stdcall() As DWORD
Dim Shared BASS_Free As Function Stdcall() As BOOL
Dim Shared BASS_Stop As Function Stdcall() As BOOL
Dim Shared BASS_SetVolume As Function Stdcall(Byval As Single) As BOOL
Dim Shared BASS_SetDevice As Function Stdcall(Byval As DWORD) As BOOL
Dim Shared BASS_SetConfig As Function Stdcall(Byval As DWORD, Byval As DWORD) As BOOL
Dim Shared BASS_ErrorGetCode As Function Stdcall() As Integer
Dim Shared BASS_StreamGetFilePosition As Function Stdcall(Byval As HSTREAM, As DWORD) As QWORD
Dim Shared BASS_StreamCreateFile As Function Stdcall(Byval As BOOL, Byval As Any Ptr, Byval As QWORD, Byval As QWORD, Byval As DWORD) As HSTREAM
Dim Shared BASS_StreamCreateURL As Function Stdcall(Byval As Any Ptr, Byval As DWORD, Byval As DWORD, Byval As Any Ptr, Byval As Any Ptr) As HSTREAM
Dim Shared BASS_StreamFree As Function Stdcall(Byval As HSTREAM) As BOOL
Dim Shared BASS_ChannelPlay As Function Stdcall(Byval As DWORD, Byval As BOOL) As BOOL
Dim Shared BASS_ChannelStop As Function Stdcall(Byval As DWORD) As BOOL
Dim Shared BASS_ChannelPause As Function Stdcall(Byval As DWORD) As BOOL
Dim Shared BASS_ChannelGetInfo As Function Stdcall(Byval As DWORD, Byval As BASS_CHANNELINFO) As BOOL
Dim Shared BASS_ChannelGetData As Function Stdcall(Byval As DWORD, Byval As Any Ptr, Byval As DWORD) As DWORD
Dim Shared BASS_ChannelGetLevel As Function Stdcall(Byval As DWORD) As DWORD
Dim Shared BASS_ChannelGetLevelEx As Function Stdcall(Byval As DWORD, Byval As Any Ptr, Byval As Single, Byval As DWORD) As BOOL
Dim Shared BASS_ChannelGetPosition As Function Stdcall(Byval As DWORD, Byval As DWORD) As DWORD
Dim Shared BASS_ChannelGetLength As Function Stdcall(Byval As DWORD, Byval As DWORD) As QWORD
Dim Shared BASS_ChannelGetTags As Function Stdcall(Byval As DWORD, Byval As DWORD) As Zstring Ptr
Dim Shared BASS_ChannelGetAttribute As Function Stdcall(Byval As DWORD, Byval As DWORD, Byval As Any Ptr) As BOOL
Dim Shared BASS_ChannelGetDevice As Function Stdcall(Byval As DWORD) As DWORD
Dim Shared BASS_ChannelBytes2Seconds As Function Stdcall(Byval As DWORD, Byval As QWORD) As Double
Dim Shared BASS_ChannelSetAttribute As Function Stdcall(Byval As DWORD, Byval As DWORD, Byval As Single) As BOOL
Dim Shared BASS_ChannelSetPosition As Function Stdcall(Byval As DWORD, Byval As QWORD, Byval As DWORD) As BOOL
Dim Shared BASS_ChannelSetDevice As Function Stdcall(Byval As DWORD, Byval As DWORD) As BOOL
Dim Shared BASS_MusicLoad As Function Stdcall(Byval As BOOL, Byval As Any Ptr, Byval As QWORD, Byval As DWORD, Byval As DWORD, Byval As DWORD) As HMUSIC
Dim Shared BASS_MusicFree As Function Stdcall(Byval As HMUSIC) As BOOL


Dim Shared As Any Ptr _g__hLib_Bass = 0
Dim Shared As BOOL _g__bSound = True

Function _Bass_Startup(sFolderDLL As String = Curdir) As BOOL
   #Ifdef __Fb_64bit__
      '? "Loading Bass64.dll"
      If Fileexists(sFolderDLL & "\Bass64.dll") = 0 Then
         _g__bSound = False
         Return False
      Else
         _g__hLib_Bass = Dylibload(sFolderDLL & "\Bass64.dll")
      Endif
   #Else
      '? "Loading Bass.dll"
      If Fileexists(sFolderDLL & "\Bass.dll") = 0 Then
         _g__bSound = False
         Return False
      Else
         _g__hLib_Bass = Dylibload(sFolderDLL & "\Bass.dll")
      Endif
   #Endif
   BASS_Init = Dylibsymbol(_g__hLib_Bass, "BASS_Init")
   If BASS_Init = 0 Then Return False
   BASS_Free = Dylibsymbol(_g__hLib_Bass, "BASS_Free")
   If BASS_Free = 0 Then Return False
   BASS_StreamCreateFile = Dylibsymbol(_g__hLib_Bass, "BASS_StreamCreateFile")
   If BASS_StreamCreateFile = 0 Then Return False
   BASS_StreamCreateURL = Dylibsymbol(_g__hLib_Bass, "BASS_StreamCreateURL")
   If BASS_StreamCreateURL = 0 Then Return False   
   BASS_StreamFree = Dylibsymbol(_g__hLib_Bass, "BASS_StreamFree")
   If BASS_StreamFree = 0 Then Return False
   BASS_ChannelPlay = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelPlay")
   If BASS_ChannelPlay = 0 Then Return False
   BASS_ChannelStop = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelStop")
   If BASS_ChannelStop = 0 Then Return False
   BASS_Stop = Dylibsymbol(_g__hLib_Bass, "BASS_Stop")
   If BASS_Stop = 0 Then Return False
   BASS_SetVolume = Dylibsymbol(_g__hLib_Bass, "BASS_SetVolume")
   If BASS_SetVolume = 0 Then Return False
   BASS_SetDevice = Dylibsymbol(_g__hLib_Bass, "BASS_SetDevice")
   If BASS_SetDevice = 0 Then Return False
   BASS_SetConfig = Dylibsymbol(_g__hLib_Bass, "BASS_SetConfig")
   If BASS_SetConfig = 0 Then Return False
   BASS_ErrorGetCode = Dylibsymbol(_g__hLib_Bass, "BASS_ErrorGetCode")
   If BASS_ErrorGetCode = 0 Then Return False
   BASS_GetDeviceInfo = Dylibsymbol(_g__hLib_Bass, "BASS_GetDeviceInfo")
   If BASS_GetDeviceInfo = 0 Then Return False
   BASS_GetDevice = Dylibsymbol(_g__hLib_Bass, "BASS_GetDevice")
   If BASS_GetDevice = 0 Then Return False   
   BASS_StreamGetFilePosition = Dylibsymbol(_g__hLib_Bass, "BASS_StreamGetFilePosition")
   If BASS_StreamGetFilePosition = 0 Then Return False
   BASS_GetInfo = Dylibsymbol(_g__hLib_Bass, "BASS_GetInfo")
   If BASS_GetInfo = 0 Then Return False
   BASS_ChannelGetInfo = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetInfo")
   If BASS_ChannelGetInfo = 0 Then Return False
   BASS_ChannelGetData = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetData")
   If BASS_ChannelGetData = 0 Then Return False
   BASS_ChannelGetLevel = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetLevel")
   If BASS_ChannelGetLevel = 0 Then Return False   
   BASS_ChannelGetLevelEx = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetLevelEx")
   If BASS_ChannelGetLevelEx = 0 Then Return False
   BASS_ChannelGetPosition = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetPosition")
   If BASS_ChannelGetPosition = 0 Then Return False
   BASS_ChannelPause = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelPause")
   If BASS_ChannelPause = 0 Then Return False
   BASS_ChannelGetLength = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetLength")
   If BASS_ChannelGetLength = 0 Then Return False      
   BASS_ChannelGetTags = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetTags")
   If BASS_ChannelGetTags = 0 Then Return False      
   BASS_ChannelGetAttribute = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetAttribute")
   If BASS_ChannelGetAttribute = 0 Then Return False
   BASS_ChannelGetDevice = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelGetDevice")
   If BASS_ChannelGetDevice = 0 Then Return False   
   BASS_ChannelBytes2Seconds = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelBytes2Seconds")
   If BASS_ChannelBytes2Seconds = 0 Then Return False
   BASS_ChannelSetAttribute = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelSetAttribute")
   If BASS_ChannelSetAttribute = 0 Then Return False   
   BASS_ChannelSetPosition = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelSetPosition")
   If BASS_ChannelSetPosition = 0 Then Return False
   BASS_ChannelSetDevice = Dylibsymbol(_g__hLib_Bass, "BASS_ChannelSetDevice")
   If BASS_ChannelSetDevice = 0 Then Return False
   BASS_MusicLoad = Dylibsymbol(_g__hLib_Bass, "BASS_MusicLoad")
   If BASS_MusicLoad = 0 Then Return False
   BASS_MusicFree = Dylibsymbol(_g__hLib_Bass, "BASS_MusicFree")
   If BASS_MusicFree = 0 Then Return False   
   Return True
End Function

Function _Bass_Shutdown() As BOOL
   If _g__hLib_Bass > 0 Then
      Dylibfree(_g__hLib_Bass)
      Return True
   End If
   Return False
 End Function

Function _BASS_ErrorGetCode() As String
   Select Case BASS_ErrorGetCode()
      Case 0 : Return "No Error."
      Case 1 : Return "There Is insufficient memory."
      Case 2 : Return "The file could Not be opened."
      Case 3 : Return "Cannot find a free sound driver."
      Case 4 : Return "The sample buffer was lost."
      Case 5 : Return "Invalid handle."
      Case 6 : Return "Unsupported sample Format."
      Case 7 : Return "Invalid position."
      Case 8 : Return "BASS_Init has Not been successfully called."
      Case 9 : Return "BASS_Start has Not been successfully called."
      Case 10 : Return "SSL/HTTPS support Is Not available."
      Case 14 : Return "Already initialized/paused/whatever."
      Case 17 : Return "The file does Not contain audio, Or it also contains video And videos are disabled."
      Case 18 : Return "Cannot Get a free channel."
      Case 19 : Return "An illegal Type was specified."
      Case 20 : Return "An illegal parameter was specified."
      Case 21 : Return "Could Not initialize 3D support."
      Case 22 : Return "No EAX support."
      Case 23 : Return "Illegal device number."
      Case 24 : Return "Not playing."
      Case 25 : Return "Illegal sample rate."
      Case 27 : Return "The stream Is Not a file stream."
      Case 29 : Return "No hardware voices available."
      Case 31 : Return "The Mod music has no sequence Data."
      Case 32 : Return "No internet connection could be opened."
      Case 33 : Return "Could Not create the file."
      Case 34 : Return "Effects are Not available."
      Case 37 : Return "Requested Data Is Not available."
      Case 38 : Return "The channel Is a decoding channel"
      Case 39 : Return "A sufficient DirectX version Is Not installed."
      Case 40 : Return "Connection timed Out."
      Case 41 : Return "The file's Format Is Not recognised/supported."
      Case 42 : Return "The specified SPEAKER flags are invalid."
      Case 43 : Return "The plugin requires a different BASS version."
      Case 44 : Return "Codec Is Not available/supported."
      Case 45 : Return "The channel/file has ended."
      Case 46 : Return "Something Else has exclusive use of the device."
      Case 47 : Return "The file cannot be streamed Using the buffered file System."
      Case -1 : Return "Some other mystery problem!"
   End Select
   Return "Hmmmm."
End Function

Function _Bass_Init(Device As DWORD = -1, Freq As Dword = 44100, Flags As Dword = 0, Win As HWND = Null, clsid As GUID Ptr = Null) As BOOL
   Return BASS_Init(Device, Freq, Flags, Win, clsid)
End Function

Function _Bass_Free() As BOOL
   Return BASS_Free()
End Function

Function _Bass_Stop() As BOOL
   Return BASS_Stop()
End Function

Function _BASS_SetVolume(Volume As Single) As BOOL
   Return BASS_SetVolume(Iif(Volume < 0, 0, Iif(Volume > 1.0, 1.0, Volume)))
End Function

Function _BASS_SetDevice(Device As DWORD) As BOOL
   Return BASS_SetDevice(Device)
End Function

Function _BASS_SetConfig(Device As DWORD, Value As DWORD) As BOOL
   Return BASS_SetConfig(Device, Value)
End Function

Function _BASS_GetInfo(bi As BASS_INFO) As BOOL
   Return BASS_GetInfo(bi)
End Function

Function _BASS_GetDevice() As DWORD
   Return BASS_GetDevice()
End Function

Function _BASS_GetDeviceInfo(Device As DWORD, Info As BASS_DEVICEINFO Ptr) As BOOL
   Return BASS_GetDeviceInfo(Device, Info)
End Function

Function _BASS_StreamFree(hStream As HSTREAM) As BOOL
   Return BASS_StreamFree(hStream)
End Function

Function _BASS_StreamCreateFile(File As String, Flags As Dword = 0, offset As QWORD = 0, Length As QWORD = 0, Mem As BOOL = False) As HSTREAM
   Return BASS_StreamCreateFile(Mem, Strptr(File), offset, Length, Flags)
End Function

Function _BASS_StreamCreateURL(URL As String, Offset As Dword = 0, Flags As Dword = 0, Proc As Any Ptr = 0, UsrProc As Any Ptr = 0) As HSTREAM
   Return BASS_StreamCreateURL(Strptr(URL), offset, Flags, Proc, UsrProc)
End Function

Function _BASS_StreamCreateMem(pMem As Any Ptr, Length As QWORD = 0, Flags As Dword = 0, offset As QWORD = 0, Mem As BOOL = True) As HSTREAM
   Return BASS_StreamCreateFile(Mem, pMem, offset, Length, Flags Or BASS_UNICODE)
End Function

Function _BASS_StreamGetFilePosition(hStream As HSTREAM, Mode As Dword) As QWORD
   Return BASS_StreamGetFilePosition(hStream, Mode)
End Function

Function _BASS_MusicLoad(File As String, Flags As DWORD = 0, Freq As DWORD = 0, offset As QWORD = 0, Length As DWORD = 0, Mem As BOOL = False) As HMUSIC
   Return BASS_MusicLoad(Mem, Strptr(File), offset, Length, Flags, Freq)
End Function

Function _BASS_MusicLoadMem(pMem As Any Ptr, Flags As DWORD = 0, Freq As DWORD = 0, offset As QWORD = 0, Length As DWORD = 0, Mem As BOOL = True) As HMUSIC
   Return BASS_MusicLoad(Mem, pMem, offset, Length, Flags, Freq)
End Function

Function _BASS_MusicFree(Handle As HMUSIC) As BOOL
   Return BASS_MusicFree(Handle)
End Function

Function _BASS_ChannelPlay(Handle As DWORD, Restart As BOOL = True) As BOOL
   Return BASS_ChannelPlay(Handle, Restart)
End Function

Function _BASS_ChannelStop(Handle As DWORD) As BOOL
   Return BASS_ChannelStop(Handle)
End Function

Function _BASS_ChannelPause(Handle As DWORD) As BOOL
   Return BASS_ChannelPause(Handle)
End Function

Function _BASS_ChannelGetInfo(Handle As DWORD, ChanInfo As BASS_CHANNELINFO) As BOOL
   Return BASS_ChannelGetInfo(Handle, ChanInfo)
End Function

Function _BASS_ChannelGetData(Handle As DWORD, Buffer As Any Ptr, Length As DWORD) As DWORD
   Return BASS_ChannelGetData(Handle, Buffer, Length)
End Function

Function _BASS_ChannelGetLevel(Handle As DWORD) As DWORD
   Return BASS_ChannelGetLevel(Handle)
End Function

Function _BASS_ChannelGetLevelEx(Handle As DWORD, Byref levels As BASS_LEVELS, length As Single = 0.05, Flags As DWORD = BASS_LEVEL_STEREO) As BOOL
   Return BASS_ChannelGetLevelEx(Handle, @levels, length, Flags)
End Function

Function _BASS_ChannelGetPosition(Handle As DWORD, Mode As DWORD) As QWORD
   Return BASS_ChannelGetPosition(Handle, Mode)
End Function

Function _BASS_ChannelGetLength(Handle As DWORD, Mode As DWORD = BASS_POS_BYTE) As QWORD
   Return BASS_ChannelGetLength(Handle, Mode)
End Function

Function _BASS_ChannelGetAttribute(Handle As DWORD, Byref Value As Single, Attrib As DWORD = BASS_ATTRIB_BITRATE) As BOOL
   Return BASS_ChannelGetAttribute(Handle, Attrib, @Value)
End Function

Function _BASS_ChannelBytes2Seconds(Handle As DWORD, Position As QWORD) As Double
   Return BASS_ChannelBytes2Seconds(Handle, Position)
End Function

Function _BASS_ChannelSetAttribute(Handle As DWORD, Attrib As DWORD, Value As Single) As BOOL
   Return BASS_ChannelSetAttribute(Handle, Attrib, Value)
End Function

Function _BASS_ChannelSetDevice(Handle As DWORD, Device As DWORD) As BOOL
   Return _BASS_ChannelSetDevice(Handle, Device)
End Function

Function _BASS_ChannelSetPosition(Handle As DWORD, Position As QWORD, Mode As DWORD) As BOOL
   Return BASS_ChannelSetPosition(Handle, Position, Mode)
End Function

Function _BASS_ChannelGetTags(Handle As DWORD, Tags As DWORD) As Any Ptr
   Return BASS_ChannelGetTags(Handle, Tags)
End Function


WinHTTP.bi

Code: Select all

'Ported from WinHTTP.au3 by trancexx to FB by UEZ
'Build 2021-03-22 Beta
'Windows 7 / Windows Server 2008 R2 / Server 2012 must enable TLS 1.1 and TLS 1.2 as default secure protocols in WinHTTP in Windows ->
'https://support.microsoft.com/en-us/topic/update-to-enable-tls-1-1-and-tls-1-2-as-default-secure-protocols-in-winhttp-in-windows-c4bd73d2-31d7-761e-0178-11268bb10392

#Include Once "windows.bi"

Type HINTERNET As LPVOID

#Ifndef CRLF
   #Define CRLF   Chr(10, 13)
#Endif

Const WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0, WINHTTP_ACCESS_TYPE_NO_PROXY = 1, WINHTTP_ACCESS_TYPE_NAMED_PROXY = 3, WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY = 4, WINHTTP_FLAG_ESCAPE_DISABLE = &h00000040, _
     INTERNET_DEFAULT_HTTPS_PORT = 443, INTERNET_DEFAULT_HTTP_PORT = 80, INTERNET_DEFAULT_PORT = 0, WINHTTP_NO_PROXY_NAME = "", WINHTTP_NO_PROXY_BYPASS = "", WINHTTP_NO_REFERER = "", _
     WINHTTP_DEFAULT_ACCEPT_TYPES = 0, WINHTTP_FLAG_SECURE = &h00800000, WINHTTP_NO_ADDITIONAL_HEADERS = "", WINHTTP_NO_REQUEST_DATA = 0, WINHTTP_CALLBACK_STATUS_REDIRECT = &h00004000

Dim Shared As Any Ptr __hWinHTTPLib = 0
Dim Shared WinHttpOpen As Function(sUserAgent As LPCWSTR, iAccessType As Long, sProxyName As LPCWSTR, sProxyBypass As LPCWSTR, iFlag As Long) As HINTERNET
Dim Shared WinHttpCloseHandle As Function(__hWinHTTPLib As Any Ptr) As Boolean
Dim Shared WinHttpConnect As Function(hSession As HINTERNET, sServerName As LPCWSTR, iServerPort As Long, Reserved As DWORD) As HINTERNET
Dim Shared WinHttpOpenRequest As Function(hConnect As HINTERNET, sVerb As LPCWSTR, sObjectName As LPCWSTR, sVersion As LPCWSTR, sReferrer As LPCWSTR, pAcceptTypes As Any Ptr, iFlags As Long) As HINTERNET
Dim Shared WinHttpSendRequest As Function(hInternet As HINTERNET, sHeader As LPCWSTR, iHeadersLength As Long, pOptionalBuff As HINTERNET, iOptionalLength As Long, iTotalLength As Long, pContext As DWORD_PTR) As Boolean
Dim Shared WinHttpReceiveResponse As Function(hInternet As HINTERNET, iReserved As LPVOID) As Boolean
Dim Shared WinHttpReadData As Function(hRequest As HINTERNET, pBuffer As LPVOID, iNumberOfBytesToRead As Long, pNumberOfBytesRead As LPDWORD) As Boolean
Dim Shared WinHttpQueryDataAvailable As Function(hRequest As HINTERNET, pNumberOfBytesAvailable As LPDWORD) As Boolean
Dim Shared WinHttpSetTimeouts As Function(hInternet As HINTERNET, iResolveTimeout As Integer, iConnectTimeout As Integer, iSendTimeout As Integer, iReceiveTimeout As Integer) As Boolean
Dim Shared WinHttpCheckPlatform As Function() As Boolean
Dim Shared WinHttpSetStatusCallback As Function(hConnect As HINTERNET, lpfnInternetCallback as Any Ptr, dwNotificationFlags as DWORD, dwReserved as DWORD_PTR) As any Ptr


Function _WinHttpStartup() As Boolean
   __hWinHTTPLib = Dylibload("Winhttp.dll")
   If __hWinHTTPLib = 0 Then Return False
   WinHttpOpen = Dylibsymbol(__hWinHTTPLib, "WinHttpOpen")
   WinHttpCloseHandle = Dylibsymbol(__hWinHTTPLib, "WinHttpCloseHandle")
   WinHttpConnect = Dylibsymbol(__hWinHTTPLib, "WinHttpConnect")
   WinHttpOpenRequest = Dylibsymbol(__hWinHTTPLib, "WinHttpOpenRequest")
   WinHttpSendRequest = Dylibsymbol(__hWinHTTPLib, "WinHttpSendRequest")
   WinHttpReceiveResponse = Dylibsymbol(__hWinHTTPLib, "WinHttpReceiveResponse")
   WinHttpReadData = Dylibsymbol(__hWinHTTPLib, "WinHttpReadData")
   WinHttpQueryDataAvailable = Dylibsymbol(__hWinHTTPLib, "WinHttpQueryDataAvailable")
   WinHttpSetTimeouts = Dylibsymbol(__hWinHTTPLib, "WinHttpSetTimeouts")
   WinHttpCheckPlatform = Dylibsymbol(__hWinHTTPLib, "WinHttpCheckPlatform")
   WinHttpSetStatusCallback = Dylibsymbol(__hWinHTTPLib, "WinHttpSetStatusCallback")
   Return WinHttpCheckPlatform()
End Function

Function _WinHttpShutdown() As Boolean
   If __hWinHTTPLib Then
      Dylibfree(__hWinHTTPLib)
      Return True
   Endif
   Return False
End Function

Function _WinHttpOpen(iAccessType As Long = WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY, sUserAgent As String = "FB_WinHTTP/1.0", sProxyName As String = WINHTTP_NO_PROXY_NAME, sProxyBypass As String = WINHTTP_NO_PROXY_BYPASS, iFlag As Long = 0) As HINTERNET
   If __hWinHTTPLib = 0 Then Return 0
   Return WinHttpOpen(Wstr(sUserAgent), iAccessType, Wstr(sProxyName), Wstr(sProxyBypass), iFlag)
End Function

Function _WinHttpCloseHandle(__hInternet As Any Ptr = __hWinHTTPLib) As Boolean
   If __hInternet = 0 Then Return False
   Return WinHttpCloseHandle(__hInternet)
End Function

Function _WinHttpConnect(hSession As HINTERNET, sServerName As String, iServerPort As Long = INTERNET_DEFAULT_PORT) As HINTERNET
   If hSession = 0 Then Return 0
   Return WinHttpConnect(hSession, Wstr(sServerName), iServerPort, 0)   
End Function

Function _WinHttpOpenRequest(hConnect As HINTERNET, sVerb As String = "GET", sObjectName As String = "", sVersion As String = "HTTP/1.1", sReferrer As String = WINHTTP_NO_REFERER, pAcceptTypes As Any Ptr = WINHTTP_DEFAULT_ACCEPT_TYPES, iFlags As Long = WINHTTP_FLAG_ESCAPE_DISABLE) As HINTERNET
   If hConnect = 0 Then Return 0
   Return WinHttpOpenRequest(hConnect, Wstr(Ucase(sVerb)), Wstr(sObjectName), Wstr(Ucase(sVersion)), Wstr(sReferrer), pAcceptTypes, iFlags)
End Function

Function _WinHttpQueryDataAvailable(hRequest As HINTERNET, Byref pNumberOfBytesAvailable As LPDWORD = NULL) As Ulong
   If hRequest = 0 Then Return 0
   Return WinHttpQueryDataAvailable(hRequest, pNumberOfBytesAvailable)
End Function

Function _WinHttpReadData(hRequest As HINTERNET, iNumberOfBytesToRead As Uinteger = 8192) As String
   If hRequest = 0 Then Return ""
   Dim As Ulong iNumberOfBytesRead = 0, i
   Dim As Ubyte aBuffer(iNumberOfBytesToRead)
   WinHttpReadData(hRequest, @aBuffer(0), iNumberOfBytesToRead, @iNumberOfBytesRead)
   If iNumberOfBytesRead = 0 Then Return ""
   Dim As String sHTML
   For i = 0 To iNumberOfBytesRead
      sHTML &= Chr(aBuffer(i))
   Next
   Return sHTML
End Function

Function _WinHttpReceiveResponse(hRequest As HINTERNET) As Boolean
   If hRequest = 0 Then Return False
   Dim as Boolean iResult = WinHttpReceiveResponse(hRequest, 0)
   If iResult = False Then ? "Error " & GetLastError() & " in function _WinHttpReceiveResponse!"
   Return iResult
End Function

Function _WinHttpSendRequest(hRequest As HINTERNET, sHeaders As String = WINHTTP_NO_ADDITIONAL_HEADERS, pOptional As LPVOID = WINHTTP_NO_REQUEST_DATA, iOptionalLength as DWORD = 0, iTotalLength As DWORD = 0, pContext As DWORD_PTR = 0) As Boolean
   If hRequest = 0 Then Return False
'   Dim As Ulong iOptionalLength = Len(sOptional), i
'   Dim As Ubyte aOptional(Len(sOptional) - 1)
'   If iOptionalLength > 0 Then
'      For i = 0 To iOptionalLength - 1
'         aOptional(i) = Asc(Mid(sOptional, i + 1, 1))
'      Next
'   End If
'   If iTotalLength = 0 Or iTotalLength < iOptionalLength Then iTotalLength += iOptionalLength
   Dim as Boolean iResult = WinHttpSendRequest(hRequest, Wstr(sHeaders), 0, pOptional, iOptionalLength, iTotalLength, pContext)
   If iResult = False Then ? "Error " & GetLastError() & " in function _WinHttpSendRequest!"
   Return iResult
End Function

Function _WinHttpSimpleReadData(hRequest As HINTERNET) As String
   If hRequest = 0 Then Return ""
   If _WinHttpQueryDataAvailable(hRequest) > 0 Then
      Dim As String sData, d
      Do
         d = _WinHttpReadData(hRequest)
         If d = "" Then Exit Do
         sData &= d
      Loop Until False
      Return sData
   End If
   Return ""
End Function

Function _WinHttpSimpleSendRequest(hConnect As HINTERNET, sPath As String = "", sType As String = "GET", sReferrer As String = WINHTTP_NO_REFERER, pData As LPVOID = WINHTTP_NO_REQUEST_DATA, sHeader As String = WINHTTP_NO_ADDITIONAL_HEADERS) As HINTERNET
   If hConnect = 0 Then Return 0
   Dim As HINTERNET hRequest = _WinHttpOpenRequest(hConnect, Ucase(sType), sPath, "HTTP/1.1", sReferrer)
   If hRequest = 0 Then Return 0
   If sType = Ucase("POST") And sHeader = WINHTTP_NO_ADDITIONAL_HEADERS Then sHeader = "Content-Type: application/x-www-form-urlencoded" & CRLF
   If _WinHttpSendRequest(hRequest, sHeader, pData) = False Then Return 0
   If _WinHttpReceiveResponse(hRequest) = False Then Return 0
   Return hRequest
End Function

Function _WinHttpSetStatusCallback(hConnect As HINTERNET, pCallback as Any Ptr, NotificationFlags as Dword) as Any Ptr
   If hConnect = 0 Then Return False
   Return WinHttpSetStatusCallback(hConnect, pCallback, NotificationFlags, 0)
End function


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.50 build 2021-04-21 beta.zip (552 kb)

Happy listening Image
Last edited by UEZ on Apr 21, 2021 9:42, edited 27 times in total.
UEZ
Posts: 708
Joined: May 05, 2017 19:59
Location: Germany

Re: Radio Stations v0.35 build 2021-03-13 beta [Windows only]

Postby UEZ » Mar 14, 2021 18:47

I need help: it seems that the executables are not running properly on other's computer. On my notebook everything runs properly and it is hard to debug a running program.

I thought it has something to do with PCRE and removed it but it seems still to run as I expected.

If it doesn't run on your pc, can you try to figure out where the problem is?

Thx!!!
UEZ
Posts: 708
Joined: May 05, 2017 19:59
Location: Germany

Re: Radio Stations v0.35 build 2021-03-13 beta [Windows only]

Postby UEZ » Mar 15, 2021 16:27

Found the issue with Windows 7

TLS 1.1 and TLS 1.2 must be enabled to run this program (WinHTTP) properly (see Update to enable TLS 1.1 and TLS 1.2 as default secure protocols in WinHTTP in Windows)

Thanks for the German Autoit community for helping me to troubleshoot this proggy. Image
dodicat
Posts: 6888
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Radio Stations v0.35 build 2021-03-13 beta [Windows only]

Postby dodicat » Mar 17, 2021 10:16

Hi UEZ.
I am having difficulty in getting libpcre.a.
I have googled around without much luck.
UEZ
Posts: 708
Joined: May 05, 2017 19:59
Location: Germany

Re: Radio Stations v0.35 build 2021-03-13 beta [Windows only]

Postby UEZ » Mar 17, 2021 10:42

dodicat wrote:Hi UEZ.
I am having difficulty in getting libpcre.a.
I have googled around without much luck.

Thanks for testing but pcre is not required anymore. Anyhow, here you can download it -> viewtopic.php?f=17&t=19095&start=495#p278794

For running PCRE as x86 you need additionally libpcre-1.dll, x64 has no dependencies. Maybe St_W can have a look and compile it accordingly.
UEZ
Posts: 708
Joined: May 05, 2017 19:59
Location: Germany

Re: Radio Stations v0.45 build 2021-03-25 beta [Windows only]

Postby UEZ » Mar 25, 2021 20:34

Update to v0.45: beside some internal changes I added the feature to download current song by pressing 'd' key.

Check out my 1st post for download / source code.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 9 guests