Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

BASS.DLL Internet Radio Example

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin BASS.DLL Internet Radio Example

    A PB9 (DDT) translation of the netradio.c example supplied with BASS.DLL

    Code:
    '
    ' PowerBASIC (DDT) translation of BASS internet radio example.
    ' Original example copyright (c) 2002-2011 Un4seen Developments Ltd.
    ' This public domain translation by Laurence Jackson, Jan 2012.
    ' The original netradio.c example is supplied as part of the
    ' BASS.DLL package, which also includes a compiled netradio.exe
    ' and other examples in C, VB, Delphi and MASM.
    '
    ' Requires:
    ' BASS.DLL version 2.4 from www.un4seen.com
    ' BASS.INC 20/07/2009 from
    ' www.jose.it-berater.org/smfforum/index.php?topic=1993
    '
    
    #dim all
    #compiler pbwin 9
    #compile exe "netradio.exe"
    #include "bass.inc"
    
    $APP_NAME = "BASS internet radio example"
    
    ' ---- Windows API declarations
    
    ' This section can be replaced by #include "Win32API.inc" if preferred.
    
    type LIST_ENTRY
      Flink as LIST_ENTRY ptr
      Blink as LIST_ENTRY ptr
    end type
    
    type RTL_CRITICAL_SECTION_DEBUG dword fill
      wType as word
      CreatorBackTraceIndex as word
      CriticalSection as RTL_CRITICAL_SECTION_DEBUG ptr
      ProcessLocksList as LIST_ENTRY
      EntryCount as dword
      ContentionCount as dword
      Spare(1) as dword
    end type
    
    type CRITICAL_SECTION dword
      DebugInfo as RTL_CRITICAL_SECTION_DEBUG ptr
      LockCount as long
      RecursionCount as long
      OwningThread as dword
      LockSemaphore as dword
      SpinCount as dword
    end type
    
    declare sub InitializeCriticalSection lib "KERNEL32.DLL" ______________________
    alias "InitializeCriticalSection" (byref lpCriticalSection as CRITICAL_SECTION)
    
    declare sub EnterCriticalSection lib "KERNEL32.DLL" ___________________________
         alias "EnterCriticalSection" (byref lpCriticalSection as CRITICAL_SECTION)
    
    declare sub LeaveCriticalSection lib "KERNEL32.DLL" ___________________________
         alias "LeaveCriticalSection" (byref lpCriticalSection as CRITICAL_SECTION)
    
    declare function KillTimer lib "USER32.DLL" ___________________________________
              alias "KillTimer"                     (byval hWnd as dword,         _
                                                 byval nIDEvent as long           _
                                                              ) as long
     
    declare function SetTimer lib "USER32.DLL" ____________________________________
              ALIAS "SetTimer"                      (byval hWnd as dword,         _
                                                 byval nIDEvent as long,          _
                                                  byval uElapse as dword,         _
                                              byval lpTimerFunc as long           _
                                                              ) as long
    
    ' ---- End of Windows API declarations
    
    
    global g_hDlg as dword              'dialog handle
    global g_tLock as CRITICAL_SECTION  'thread lock structure
    global g_dwRequest as dword         'request number/counter
    global g_hStream as dword           'stream handle
    global g_szProxy as asciiz*256      'proxy server
    global g_stURL() as string          'preset stream URLs
    
    
    sub ErrorMsg __________________________________________________________________
                                                         (stMsg as string)
    '------------------------------------------------------------------------------
    
    msgbox stMsg + $CRLF + "(error code: " + format$(BASS_ErrorGetCode()) + ")" _
    ,, $APP_NAME
    
    end sub
    
    
    sub DoMeta ____________________________________________________________________
                                                             ()
    '------------------------------------------------------------------------------
    '
    ' Update stream title from metadata
    '
    '------------------------------------------------------------------------------
    
    local pMeta as asciiz ptr
    local stMeta as string
    local lgPtr as long
    local stArtist as string
    local stTitle as string
    
    control set text g_hDlg, 30, ""
    pMeta = BASS_ChannelGetTags (g_hStream, %BASS_TAG_META)
    if pMeta then  'got Shoutcast metadata
      stMeta = @pMeta
      if left$(stMeta, 13) = "StreamTitle='" then
        stMeta = mid$(stMeta, 14)
        lgPtr = instr(stMeta, "';")
        if lgPtr then
          stMeta = left$(stMeta, lgPtr - 1)
          control set text g_hDlg, 30, stMeta
        end if
      end if
    else
      pMeta = BASS_ChannelGetTags(g_hStream, %BASS_TAG_OGG)
      if pMeta then 'got Icecast/OGG tags
        stMeta = @pMeta
        do until len(stMeta) = 0
          if lcase$(left$(stMeta, 7)) = "artist=" then
            stArtist = mid$(stMeta, 8)
          elseif lcase$(left$(stMeta, 6)) = "title=" then
            stTitle = mid$(stMeta, 7)
          end if
          pMeta = pMeta + len(stMeta) + 1
          stMeta = @pMeta
        loop
        if len(stArtist) and len(stTitle) then
          stMeta = stArtist + " - " + stTitle
        elseif len(stArtist) then
          stMeta = stArtist
        elseif len(stTitle) then
          stMeta = stTitle
        end if
        control set text g_hDlg, 30, stMeta
      end if
    end if
    
    end sub
    
    
    sub MetaSync __________________________________________________________________
                                                (byval lgHandle as long,          _
                                                byval lgChannel as long,          _
                                                   byval lgData as long,          _
                                                   byval lgUser as long)
    '------------------------------------------------------------------------------
    
    call DoMeta
    
    end sub
    
    
    sub EndSync ___________________________________________________________________
                                                (byval lgHandle as long,          _
                                                byval lgChannel as long,          _
                                                   byval lgData as long,          _
                                                   byval lgUser as long)
    '------------------------------------------------------------------------------
    
    control set text g_hDlg, 31, "not playing"
    control set text g_hDlg, 30, ""
    control set text g_hDlg, 32, ""
    
    end sub
    
    
    sub StatusProc ________________________________________________________________
                                                 (byval pBuffer as asciiz ptr,    _
                                                 byval dwLength as dword,         _
                                                   byval dwUser as dword)
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    
    local stStatus as string
    
    if pBuffer and (dwLength = 0) and (dwUser = g_dwRequest) then
      stStatus = @pBuffer
      control set text g_hDlg, 32, stStatus
    end if
    
    end sub
    
    
    thread function OpenURL _______________________________________________________
                                                    (byval pURL as asciiz ptr     _
                                                              ) as long
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    
    local hStream as dword
    local dwRequest as dword
    local szURL as asciiz*256
    
    szURL = @pURL
    
    EnterCriticalSection(g_tLock) 'Make sure only 1 thread at a time can do the following
    incr g_dwRequest 'Increment the request counter for this request
    dwRequest = g_dwRequest
    LeaveCriticalSection(g_tlock)
    
    KillTimer(g_hDlg, 0)  'stop prebuffer monitoring
    BASS_StreamFree(g_hStream) 'close old stream
    control set text g_hDlg, 31, "connecting..."
    control set text g_hDlg, 30, ""
    control set text g_hDlg, 32, ""
    
    hStream = BASS_StreamCreateURL (szURL, 0, %BASS_STREAM_BLOCK or %BASS_STREAM_STATUS or %BASS_STREAM_AUTOFREE, _
    codeptr(StatusProc), byval dwRequest) 'open URL
    
    EnterCriticalSection(g_tLock)
    
    if dwRequest <> g_dwRequest then 'there is a newer request, discard this stream
      LeaveCriticalSection(g_tLock)
      if hStream then BASS_StreamFree(hStream)
      exit function
    end if
    '
    g_hStream = hStream 'this is now the current stream
    LeaveCriticalSection(g_tLock)
    
    if g_hStream = 0 then 'failed to open
      control set text g_hDlg, 31, "not playing"
      ErrorMsg("Can't play the stream")
    else
      SetTimer(g_hDlg, 0, 50, 0) 'start prebuffer monitoring
    end if
    
    end function
    
    
    callback function DialogProc __________________________________________________
                                                             () as long
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    
    static szURL as asciiz*256
    local lgCheck as long
    local dwProgress as dword
    local pText as asciiz ptr
    local stText as string
    local hThread as dword
    
    select case cb.msg
    case %WM_TIMER
      'Get the percentage of the buffer filled
      dwProgress = BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_BUFFER) _
      * 100 / BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_END) 'Percentage of buffer filled
      'Over 75% full (or end of download)...
      if (dwProgress > 75) or (BASS_StreamGetFilePosition(g_hStream, %BASS_FILEPOS_CONNECTED) = 0) then
        KillTimer(cb.hndl, 0) 'Finished prebuffering, stop monitoring
        pText = BASS_ChannelGetTags(g_hStream, %BASS_TAG_ICY) 'Get the broadcast name and URL
        if pText = 0 then 'No ICY tags, try HTTP...
          pText = BASS_ChannelGetTags(g_hStream, %BASS_TAG_HTTP)
        end if
        if pText then
          stText = @pText
          do until len(stText) = 0
            if left$(stText, 9) = "icy-name:" then
              control set text cb.hndl, 31, mid$(stText, 10)
            elseif left$(stText, 8) = "icy-url:" then
              control set text cb.hndl, 32, mid$(stText, 9)
            end if
            pText = pText + len(stText) + 1
            stText = @pText
          loop
        end if
        'Get the stream title and set sync for subsequent titles
        DoMeta()
        BASS_ChannelSetSync(g_hStream, %BASS_SYNC_META, 0, codeptr(MetaSync), byval 0)
        BASS_ChannelSetSync(g_hStream, %BASS_SYNC_OGG_CHANGE, 0, codeptr(MetaSync), byval 0)
        BASS_ChannelSetSync(g_hStream ,%BASS_SYNC_END, 0, codeptr(EndSync), byval 0)
        BASS_ChannelPlay(g_hStream, 0) 'play it!
      else
        control set text cb.hndl, 31, "buffering... " + format$(dwProgress) + "%"
      end if
    case %WM_COMMAND
      select case cb.ctl
      case %IDCANCEL
        dialog end cb.hndl
      case 41 'Direct connection checkbox:
        control get check cb.hndl, 41 to lgCheck
        if lgCheck then
          BASS_SetConfigPtr(%BASS_CONFIG_NET_PROXY, byval 0) 'disable proxy
        else
          BASS_SetConfigPtr(%BASS_CONFIG_NET_PROXY, g_szProxy) 'enable proxy
        end if
      case else
        if ((cb.ctl >= 10) and (cb.ctl <= 19)) or (cb.ctl = 21) then
          control get text cb.hndl, 40 to g_szProxy
          if cb.ctl = 21 then
            control get text cb.hndl, 20 to szURL
          else
            szURL = g_stURL(cb.ctl - 10)
          end if
          thread create OpenURL(varptr(szURL)) to hThread
        end if
      end select
    case %WM_INITDIALOG
      if BASS_Init(-1, 44100, 0, cb.hndl, byval 0) = 0 then
        ErrorMsg "Can't initialize output device"
        dialog post cb.hndl, %WM_DESTROY, 0, 0
      end if
      BASS_SetConfig(%BASS_CONFIG_NET_PLAYLIST, 1)        'enable playlist processing
      BASS_SetConfig(%BASS_CONFIG_NET_PREBUF, 0)    'minimize automatic pre-buffering
      BASS_SetConfigPtr(%BASS_CONFIG_NET_PROXY, g_szProxy) 'setup proxy server location
      ' Automatic pre-buffering is minimized so we can do it (and display it) instead
      InitializeCriticalSection(g_tLock)
    case %WM_DESTROY
      BASS_Free()
      dialog end cb.hndl
    end select
    
    end function
    
    
    function pbmain _______________________________________________________________
                                                             () as long
    '------------------------------------------------------------------------------
    
    redim g_stURL(0 to 9)
    g_stURL(0) = "http://www.radioparadise.com/musiclinks/rp_128-9.m3u"
    g_stURL(1) = "http://www.radioparadise.com/musiclinks/rp_32.m3u"
    g_stURL(2) = "http://ogg2.as34763.net/vr160.ogg"
    g_stURL(3) = "http://ogg2.as34763.net/vr32.ogg"
    g_stURL(4) = "http://ogg2.as34763.net/a8160.ogg"
    g_stURL(5) = "http://ogg2.as34763.net/a832.ogg"
    g_stURL(6) = "http://somafm.com/secretagent.pls"
    g_stURL(7) = "http://somafm.com/secretagent24.pls"
    g_stURL(8) = "http://somafm.com/suburbsofgoa.pls"
    g_stURL(9) = "http://somafm.com/suburbsofgoa24.pls"
    
    if (hi(word, BASS_GetVersion()) <> %BASSVERSION) then
      msgbox "BASS.DLL version does not match the header version"
      exit function
    end if
    
    dialog new %HWND_DESKTOP,        _
      $APP_NAME,                     _
      , , 185, 185,                  _
      %WS_SYSMENU or %WS_CAPTION     _
      or %WS_POPUP or %DS_MODALFRAME _
      to g_hDlg
    
    control add frame, g_hDlg, -1, "Presets", 5, 2, 175, 45
    control add label, g_hDlg, -1, "Broadband", 10, 15, 36, 8
    control add label, g_hDlg, -1, "Modem", 10, 30, 24, 8
    control add button, g_hDlg, 10, "1", 50, 11, 20, 15
    control add button, g_hDlg, 11, "1", 50, 27, 20, 15
    control add button, g_hDlg, 12, "2", 76, 11, 20, 15
    control add button, g_hDlg, 13, "2", 76, 27, 20, 15
    control add button, g_hDlg, 14, "3", 102, 11, 20, 15
    control add button, g_hDlg, 15, "3", 102, 27, 20, 15
    control add button, g_hDlg, 16, "4", 128, 11, 20, 15
    control add button, g_hDlg, 17, "4", 128, 27, 20, 15
    control add button, g_hDlg, 18, "5", 154, 11, 20, 15
    control add button, g_hDlg, 19, "5", 154, 27, 20, 15
    control add frame, g_hDlg, -1, "Custom", 5, 50, 175, 28
    control add textbox, g_hDlg, 20, "", 10, 60, 135, 12
    control add button, g_hDlg, 21, "open", 150, 60, 25, 12
    control add frame, g_hDlg, -1, "Currently playing", 5, 81, 175, 57
    control add label, g_hDlg, 30, "", 10, 91, 165, 16, %SS_NOPREFIX or %SS_CENTER
    control add label, g_hDlg, 31, "not playing", 10, 109, 165, 16, %SS_NOPREFIX or %SS_CENTER
    control add label, g_hDlg, 32, "", 10, 127, 165, 8, %SS_NOPREFIX or %SS_CENTER
    control add frame, g_hDlg, -1, "Proxy server", 5, 141, 175, 40
    control add textbox, g_hDlg, 40, "", 10, 151, 165, 12
    control add label, g_hDlg, -1, "[user:[email protected]]server:port", 99, 165, 76, 8
    control add checkbox, g_hDlg, 41, "Direct connection", 15, 167, 72, 10
    
    dialog show modal g_hDlg, call DialogProc
    
    end function
    - LJ
Working...
X