357 lines
12 KiB
Text
357 lines
12 KiB
Text
VERSION 5.00
|
|
Begin VB.Form frmNetRadio
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "BASS internet radio tuner"
|
|
ClientHeight = 4215
|
|
ClientLeft = 45
|
|
ClientTop = 330
|
|
ClientWidth = 4215
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 4215
|
|
ScaleWidth = 4215
|
|
StartUpPosition = 2 'CenterScreen
|
|
Begin VB.Timer tmrNetRadio
|
|
Enabled = 0 'False
|
|
Interval = 50
|
|
Left = 3120
|
|
Top = 1320
|
|
End
|
|
Begin VB.Frame frameProxy
|
|
Caption = " Proxy server "
|
|
Height = 975
|
|
Left = 120
|
|
TabIndex = 18
|
|
Top = 3120
|
|
Width = 3975
|
|
Begin VB.CheckBox chkDirectConnect
|
|
Caption = "Direct connection"
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 20
|
|
Top = 600
|
|
Width = 1575
|
|
End
|
|
Begin VB.TextBox txtProxy
|
|
Height = 285
|
|
Left = 120
|
|
MaxLength = 100
|
|
TabIndex = 19
|
|
Top = 240
|
|
Width = 3735
|
|
End
|
|
Begin VB.Label lblUserPass
|
|
AutoSize = -1 'True
|
|
Caption = "[user:pass@]server:port"
|
|
Height = 195
|
|
Left = 2160
|
|
TabIndex = 21
|
|
Top = 600
|
|
Width = 1680
|
|
End
|
|
End
|
|
Begin VB.Frame framePresents
|
|
Caption = " Presents "
|
|
Height = 1455
|
|
Left = 120
|
|
TabIndex = 11
|
|
Top = 0
|
|
Width = 3975
|
|
Begin VB.CheckBox chkSave
|
|
Caption = "Save local copy"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 10
|
|
Top = 1080
|
|
Width = 3735
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "5"
|
|
Height = 350
|
|
Index = 9
|
|
Left = 3360
|
|
TabIndex = 9
|
|
Top = 630
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "4"
|
|
Height = 350
|
|
Index = 8
|
|
Left = 2790
|
|
TabIndex = 7
|
|
Top = 630
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "3"
|
|
Height = 350
|
|
Index = 7
|
|
Left = 2220
|
|
TabIndex = 5
|
|
Top = 630
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "2"
|
|
Height = 350
|
|
Index = 6
|
|
Left = 1650
|
|
TabIndex = 3
|
|
Top = 630
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "1"
|
|
Height = 350
|
|
Index = 5
|
|
Left = 1080
|
|
TabIndex = 1
|
|
Top = 630
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "5"
|
|
Height = 350
|
|
Index = 4
|
|
Left = 3360
|
|
TabIndex = 8
|
|
Top = 240
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "4"
|
|
Height = 350
|
|
Index = 3
|
|
Left = 2790
|
|
TabIndex = 6
|
|
Top = 240
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "3"
|
|
Height = 350
|
|
Index = 2
|
|
Left = 2220
|
|
TabIndex = 4
|
|
Top = 240
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "2"
|
|
Height = 350
|
|
Index = 1
|
|
Left = 1650
|
|
TabIndex = 2
|
|
Top = 240
|
|
Width = 450
|
|
End
|
|
Begin VB.CommandButton btnPresents
|
|
Caption = "1"
|
|
Height = 350
|
|
Index = 0
|
|
Left = 1080
|
|
TabIndex = 0
|
|
Top = 240
|
|
Width = 450
|
|
End
|
|
Begin VB.Label lblModem
|
|
AutoSize = -1 'True
|
|
Caption = "Modem"
|
|
Height = 195
|
|
Left = 120
|
|
TabIndex = 14
|
|
Top = 720
|
|
Width = 525
|
|
End
|
|
Begin VB.Label lblBroadband
|
|
AutoSize = -1 'True
|
|
Caption = "Broadband"
|
|
Height = 195
|
|
Left = 120
|
|
TabIndex = 13
|
|
Top = 240
|
|
Width = 780
|
|
End
|
|
End
|
|
Begin VB.Frame framePlaying
|
|
Caption = " Currently playing "
|
|
Height = 1455
|
|
Left = 120
|
|
TabIndex = 12
|
|
Top = 1560
|
|
Width = 3975
|
|
Begin VB.Label lblBPS
|
|
Alignment = 2 'Center
|
|
Height = 195
|
|
Left = 90
|
|
TabIndex = 17
|
|
Top = 1200
|
|
Width = 3795
|
|
WordWrap = -1 'True
|
|
End
|
|
Begin VB.Label lblName
|
|
Alignment = 2 'Center
|
|
Caption = "not playing"
|
|
Height = 375
|
|
Left = 105
|
|
TabIndex = 16
|
|
Top = 720
|
|
Width = 3765
|
|
WordWrap = -1 'True
|
|
End
|
|
Begin VB.Label lblSong
|
|
Alignment = 2 'Center
|
|
Height = 435
|
|
Left = 105
|
|
TabIndex = 15
|
|
Top = 240
|
|
Width = 3765
|
|
WordWrap = -1 'True
|
|
End
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmNetRadio"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
'/////////////////////////////////////////////////////////////////////////////////
|
|
' frmNetRadio.frm - Copyright (c) 2002-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
|
' [http://www.jobnik.org]
|
|
' [ jobnik@jobnik.org ]
|
|
'
|
|
' * Save local copy is added by: Peter Hebels @ http://www.phsoft.nl
|
|
' e-mail: info@phsoft.nl
|
|
'
|
|
' Other sources: modNetRadio.bas & clsFileIo.cls
|
|
'
|
|
' BASS Internet radio example
|
|
' Originally translated from - netradio.c - Example of Ian Luck
|
|
'/////////////////////////////////////////////////////////////////////////////////
|
|
|
|
Option Explicit
|
|
|
|
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
|
|
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
|
|
|
|
Private Sub Form_Load()
|
|
' change and set the current path, to prevent from VB not finding BASS.DLL
|
|
ChDrive App.Path
|
|
ChDir App.Path
|
|
|
|
' check the correct BASS was loaded
|
|
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
|
|
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
|
|
End
|
|
End If
|
|
|
|
' setup output device
|
|
If (BASS_Init(-1, 44100, 0, Me.hwnd, 0) = 0) Then
|
|
Call Error_("Can't initialize device")
|
|
End
|
|
End If
|
|
|
|
Call BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1) ' enable playlist processing
|
|
Call BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0) ' minimize automatic pre-buffering, so we can do it (and display it) instead
|
|
|
|
' preset stream URLs
|
|
url = Array("http://www.radioparadise.com/m3u/mp3-128.m3u", "http://www.radioparadise.com/m3u/mp3-32.m3u", _
|
|
"http://icecast.timlradio.co.uk/vr160.ogg", "http://icecast.timlradio.co.uk/vr32.ogg", _
|
|
"http://icecast.timlradio.co.uk/a8160.ogg", "http://icecast.timlradio.co.uk/a832.ogg", _
|
|
"http://somafm.com/secretagent.pls", "http://somafm.com/secretagent24.pls", _
|
|
"http://somafm.com/suburbsofgoa.pls", "http://somafm.com/suburbsofgoa24.pls")
|
|
|
|
Set WriteFile = New clsFileIo
|
|
cthread = 0
|
|
End Sub
|
|
|
|
' this function will check if you're running in IDE or EXE modes
|
|
' VB will crash if you're closing the app while (cthread<>0) in IDE,
|
|
' but won't crash if in EXE mode
|
|
Public Function isIDEmode() As Boolean
|
|
Dim sFileName As String, lCount As Long
|
|
|
|
sFileName = String(255, 0)
|
|
lCount = GetModuleFileName(App.hInstance, sFileName, 255)
|
|
sFileName = UCase(GetFileName(Mid(sFileName, 1, lCount)))
|
|
|
|
isIDEmode = (sFileName = "VB6.EXE")
|
|
End Function
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
If (isIDEmode And cthread) Then
|
|
' IDE Version
|
|
Cancel = True ' disable closing app to avoid crash
|
|
Else
|
|
' Compiled Version or (cthread = 0) close app is available
|
|
Call BASS_Free
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnPresents_Click(index As Integer)
|
|
If (cthread) Then ' already connecting
|
|
Call Beep
|
|
Else
|
|
If (chkDirectConnect.value) Then
|
|
Call BASS_SetConfigPtr(BASS_CONFIG_NET_PROXY, vbNullString) ' disable proxy
|
|
Else
|
|
Call BASS_SetConfigPtr(BASS_CONFIG_NET_PROXY, txtProxy.Text) ' set proxy server
|
|
End If
|
|
|
|
' open URL in a new thread (so that main thread is free)
|
|
Dim threadid As Long
|
|
cthread = CreateThread(ByVal 0&, 0, AddressOf OpenURL, index, 0, threadid) ' threadid param required on win9x
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkSave_Click()
|
|
If chkSave.value = vbChecked Then
|
|
DoDownload = True
|
|
Else
|
|
DoDownload = False
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub tmrNetRadio_Timer()
|
|
Dim progress As Long
|
|
progress = BASS_StreamGetFilePosition(chan, BASS_FILEPOS_BUFFER) * 100 / BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END) ' percentage of buffer filled
|
|
If (progress > 75 Or BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CONNECTED) = 0) Then ' over 75% full (or end of download)
|
|
tmrNetRadio.Enabled = False ' finished prebuffering, stop monitoring
|
|
' get the broadcast name and bitrate
|
|
Dim icyPtr As Long
|
|
icyPtr = BASS_ChannelGetTags(chan, BASS_TAG_ICY)
|
|
If (icyPtr = 0) Then icyPtr = BASS_ChannelGetTags(chan, BASS_TAG_HTTP) ' no ICY tags, try HTTP
|
|
If (icyPtr) Then
|
|
Dim icyStr As String
|
|
Do
|
|
icyStr = VBStrFromAnsiPtr(icyPtr)
|
|
icyPtr = icyPtr + Len(icyStr) + 1
|
|
lblName.Caption = IIf(Mid(icyStr, 1, 9) = "icy-name:", Mid(icyStr, 10), lblName.Caption)
|
|
lblBPS.Caption = IIf(Mid(icyStr, 1, 7) = "icy-br:", "bitrate: " & Mid(icyStr, 8), lblBPS.Caption)
|
|
|
|
' NOTE: you can get more ICY info like: icy-genre:, icy-url:... :)
|
|
Loop While (icyStr <> "")
|
|
End If
|
|
|
|
' get the stream title and set sync for subsequent titles
|
|
Call DoMeta
|
|
Call BASS_ChannelSetSync(chan, BASS_SYNC_META, 0, AddressOf MetaSync, 0)
|
|
' set sync for end of stream
|
|
Call BASS_ChannelSetSync(chan, BASS_SYNC_END, 0, AddressOf EndSync, 0)
|
|
' play it!
|
|
Call BASS_ChannelPlay(chan, BASSFALSE)
|
|
Else
|
|
lblName.Caption = "buffering... " & progress & "%"
|
|
End If
|
|
End Sub
|
|
|
|
'--------------------
|
|
' useful function :)
|
|
'--------------------
|
|
|
|
' get file name from file path
|
|
Public Function GetFileName(ByVal fp As String) As String
|
|
GetFileName = Mid(fp, InStrRev(fp, "\") + 1)
|
|
End Function
|