home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / vb / NetRadio / modNetRadio.bas < prev    next >
Encoding:
BASIC Source File  |  2005-09-21  |  6.7 KB  |  187 lines
  1. Attribute VB_Name = "modNetRadio"
  2. '/////////////////////////////////////////////////////////////////////////////////
  3. ' modNetRadio.bas - Copyright (c) 2002-2005 (: JOBnik! :) [Arthur Aminov, ISRAEL]
  4. '                                                         [http://www.jobnik.org]
  5. '                                                         [  jobnik@jobnik.org  ]
  6. '
  7. ' * Save local copy is added by: Peter Hebels @ http://www.phsoft.nl
  8. '                                             e-mail: info@phsoft.nl
  9. '
  10. ' Other sources: frmNetRadio.frm & clsFileIo.cls
  11. '
  12. ' BASS Internet radio example
  13. ' Originally translated from - netradio.c - Example of Ian Luck
  14. '/////////////////////////////////////////////////////////////////////////////////
  15.  
  16. Option Explicit
  17.  
  18. Public chan As Long
  19. Public url As Variant
  20. Public TmpNameHold As String
  21. Public TmpNameHold2 As String
  22.  
  23. 'SAVE LOCAL COPY
  24. Public WriteFile As clsFileIo
  25. Public FileIsOpen As Boolean, GotHeader As Boolean
  26. Public DownloadStarted As Boolean, DoDownload As Boolean
  27. Public DlOutput As String, SongNameUpdate As Boolean
  28.  
  29. 'THREADING
  30. Public cthread As Long
  31. Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
  32. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  33.  
  34. 'MESSAGE BOX
  35. Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
  36.  
  37. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  38.  
  39. 'display error message
  40. Public Sub Error_(ByVal es As String)
  41.     Call MessageBox(frmNetRadio.hwnd, es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, "Error", vbExclamation)
  42. End Sub
  43.  
  44. 'update stream title from metadata
  45. Sub DoMeta(ByVal meta As Long)
  46.     Dim p As String, tmpMeta As String
  47.     If meta = 0 Then Exit Sub
  48.     tmpMeta = VBStrFromAnsiPtr(meta)
  49.     If ((Mid(tmpMeta, 1, 13) = "StreamTitle='")) Then
  50.         p = Mid(tmpMeta, 14)
  51.         TmpNameHold = Mid(p, 1, InStr(p, ";") - 2)
  52.         frmNetRadio.lblSong.Caption = TmpNameHold
  53.         
  54.         If TmpNameHold = TmpNameHold2 Then
  55.             'do noting
  56.         Else
  57.             TmpNameHold2 = TmpNameHold
  58.             GotHeader = False
  59.             DownloadStarted = False
  60.         End If
  61.         
  62.         DlOutput = App.Path & "\" & RemoveSpecialChar(Mid(p, 1, InStr(p, ";") - 2)) & ".mp3"
  63.     End If
  64. End Sub
  65.  
  66. Sub MetaSync(ByVal handle As Long, ByVal channel As Long, ByVal data As Long, ByVal user As Long)
  67.     Call DoMeta(data)
  68. End Sub
  69.  
  70. Public Sub OpenURL(ByVal clkURL As Long)
  71.     With frmNetRadio
  72.         Call BASS_StreamFree(chan) 'close old stream
  73.         .lblName.Caption = "connecting..."
  74.         .lblBPS.Caption = ""
  75.         .lblSong.Caption = ""
  76.  
  77.         chan = BASS_StreamCreateURL(CStr(url((IIf(clkURL < 5, clkURL * 2, (clkURL * 2) - 9)))), 0, BASS_STREAM_STATUS, AddressOf SUBDOWNLOADPROC, 0)
  78.  
  79.         If chan = 0 Then
  80.             .lblName.Caption = "not playing"
  81.             Call Error_("Can't play the stream")
  82.         Else
  83.             Do
  84.                 Dim progress As Long, len_ As Long
  85.                 len_ = BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END)
  86.                 If (len_ = -1) Then GoTo done 'something's gone wrong! (eg. BASS_Free called)
  87.                 progress = (BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) _
  88.                     - BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT)) * 100 / len_ ' percentage of buffer filled
  89.                 If (progress > 75) Then Exit Do ' over 75% full, enough
  90.                 .lblName.Caption = "buffering... " & progress & "%"
  91.                 Call Sleep(50)
  92.             Loop While 1
  93.  
  94.             Dim icyPTR As Long  'a pointer where ICY info is stored
  95.             Dim tmpICY As String
  96.  
  97.             'get the broadcast name and bitrate
  98.             icyPTR = BASS_StreamGetTags(chan, BASS_TAG_ICY)
  99.  
  100.             If (icyPTR) Then
  101.                 Do
  102.                     tmpICY = VBStrFromAnsiPtr(icyPTR)
  103.                     icyPTR = icyPTR + Len(tmpICY) + 1
  104.                     .lblName.Caption = IIf(Mid(tmpICY, 1, 9) = "icy-name:", Mid(tmpICY, 10), .lblName.Caption)
  105.                     .lblBPS.Caption = IIf(Mid(tmpICY, 1, 7) = "icy-br:", "bitrate: " & Mid(tmpICY, 8), .lblBPS.Caption)
  106.  
  107.                     'NOTE: you can get more ICY info like: icy-genre:, icy-url:... :)
  108.                 Loop While (tmpICY <> "")
  109.             End If
  110.  
  111.             'get the stream title and set sync for subsequent titles
  112.             Call DoMeta(BASS_StreamGetTags(chan, BASS_TAG_META))
  113.             Call BASS_ChannelSetSync(chan, BASS_SYNC_META, 0, AddressOf MetaSync, 0)
  114.  
  115.             'play it!
  116.             Call BASS_ChannelPlay(chan, BASSFALSE)
  117.         End If
  118.     End With
  119.  
  120. done:
  121.     Call CloseHandle(cthread)   'close the thread
  122.     cthread = 0
  123. End Sub
  124.  
  125. 'The following functions where added by Peter Hebels
  126. Public Sub SUBDOWNLOADPROC(ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
  127.     If (buffer And length = 0) Then
  128.         frmNetRadio.lblBPS.Caption = VBStrFromAnsiPtr(buffer) 'display connection status
  129.         Exit Sub
  130.     End If
  131.  
  132.     If (Not DoDownload) Then
  133.         DownloadStarted = False
  134.         Call WriteFile.CloseFile
  135.         Exit Sub
  136.     End If
  137.  
  138.     If (Trim(DlOutput) = "") Then Exit Sub
  139.  
  140.     If (Not DownloadStarted) Then
  141.         DownloadStarted = True
  142.         Call WriteFile.CloseFile
  143.         If (WriteFile.OpenFile(DlOutput)) Then
  144.             SongNameUpdate = False
  145.         Else
  146.             
  147.             SongNameUpdate = True
  148.             
  149.             GotHeader = False
  150.         End If
  151.     End If
  152.  
  153.     If (Not SongNameUpdate) Then
  154.         If (length) Then
  155.             Call WriteFile.WriteBytes(buffer, length)
  156.         Else
  157.             Call WriteFile.CloseFile
  158.             GotHeader = False
  159.         End If
  160.     Else
  161.         DownloadStarted = False
  162.         Call WriteFile.CloseFile
  163.         GotHeader = False
  164.     End If
  165. End Sub
  166.  
  167. Public Function RemoveSpecialChar(strFileName As String)
  168.     Dim i As Byte
  169.     Dim SpecialChar As Boolean
  170.     Dim SelChar As String, OutFileName As String
  171.  
  172.     For i = 1 To Len(strFileName)
  173.         SelChar = Mid(strFileName, i, 1)
  174.         SpecialChar = InStr(":/\?*|<>" & Chr$(34), SelChar) > 0
  175.  
  176.         If (Not SpecialChar) Then
  177.             OutFileName = OutFileName & SelChar
  178.             SpecialChar = False
  179.         Else
  180.             OutFileName = OutFileName
  181.             SpecialChar = False
  182.         End If
  183.     Next i
  184.  
  185.     RemoveSpecialChar = OutFileName
  186. End Function
  187.