unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Bass;
type
TForm1 =
class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
GroupBox2: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Button2: TButton;
Button3: TButton;
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
cthread: DWORD;
chan: HSTREAM;
public
{ Public declarations }
end;
var
Form1: TForm1;
FileStream : TFileStream;
FileNeme :
String;
// <= C:\test.mp3
implementation
const
urls:
array[0..9]
of String = (
'
http://160.79.128.62:6038','
http://205.188.234.129:8024',
'
http://64.236.34.97/stream/1006','
http://206.98.167.99:8406',
'
http://160.79.1.141:8000/','
http://206.98.167.99:8006',
'
http://205.188.234.4:8016','
http://205.188.234.4:8014',
'
http://server2.somafm.com:8000','
http://server1.somafm.com:8082'
);
{$R *.dfm}
function Get_AppPath :
string;
begin
result:= ExtractFilePath( ParamStr( 0 ) );
end;
{ display error messages }
procedure Error(es:
String);
begin
MessageBox(Form1.Handle, PChar(es + #13#10 + '
(error code: ' + IntToStr(BASS_ErrorGetCode) + '
)'), '
Error', 0);
end;
{ update stream title from metadata }
procedure DoMeta(meta: PChar);
var
p: Integer;
begin
if (meta <>
nil)
then
begin
p := Pos('
StreamTitle=', meta);
if (p = 0)
then
Exit;
p := p + 13;
Form1.Label3.Caption := Copy(meta, p, Pos('
;', meta) - p - 1);
end;
end;
procedure MetaSync(
handle: HSYNC; channel, data, user: DWORD);
stdcall;
begin
DoMeta(PChar(data));
end;
procedure StatusProc(buffer: Pointer; len, user: DWORD);
stdcall;
begin
if (buffer <>
nil)
and (len = 0)
then
Form1.Label5.Caption := PChar(buffer);
// display connection status
if (FileNeme = '
')
then
exit;
if (FileStream =
nil)
then
FileStream:= TFileStream.Create(FileNeme, fmCreate);
// create the file
if (buffer =
nil)
then
FileStream.Free
// finished downloading
else
FileStream.
Write(buffer^, len);
end;
function OpenURL(
url: PChar): Integer;
var
icy: PChar;
begin
FileNeme:= Get_AppPath + '
test.mp3';
Result := 0;
BASS_StreamFree(Form1.chan);
// close old stream
Form1.Label4.Caption := '
connecting...';
Form1.Label3.Caption := '
';
Form1.Label5.Caption := '
';
form1.chan := 0;
//in der nächsten zeile kommt der fehler beim wiederaufbau des threads.
Form1.chan := BASS_StreamCreateURL(
url, 0, BASS_STREAM_META
or BASS_STREAM_STATUS, @StatusProc, 0);
if (Form1.chan = 0)
then
begin
Form1.Label4.Caption := '
not playing';
Error('
Can''
t play the stream');
end
else
begin
// get the broadcast name and bitrate
icy := BASS_StreamGetTags(Form1.chan, BASS_TAG_ICY);
if (icy <>
nil)
then
while (icy^ <> #0)
do
begin
if (Copy(icy, 1, 9) = '
icy-name:')
then
Form1.Label4.Caption := Copy(icy, 10, Length(icy) - 9)
else
if (Copy(icy, 1, 7) = '
icy-br:')
then
Form1.Label5.Caption := '
bitrate: ' + Copy(icy, 8, Length(icy) - 7);
icy := icy + Length(icy) + 1;
end;
// get the stream title and set sync for subsequent titles
DoMeta(BASS_StreamGetTags(Form1.chan,BASS_TAG_META));
BASS_ChannelSetSync(Form1.chan,BASS_SYNC_META,0,@MetaSync,0);
// play it!
BASS_ChannelPlay(Form1.chan,FALSE);
end;
Form1.cthread := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// check that BASS 2.1 was loaded
if (BASS_GetVersion <> DWORD(MAKELONG(2,1)))
then
begin
MessageBox(0,'
BASS version 2.1 was not loaded','
Incorrect BASS.DLL',0);
Halt;
end;
if (
not BASS_Init(1,44100,0,Form1.Handle,
NIL))
then
begin
Error('
Can''
t initialize device');
Halt;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadId: Cardinal;
begin
if (cthread <> 0)
then
MessageBeep(0)
else
cthread := BeginThread(
nil, 0, @OpenURL, PChar(urls[TButton(Sender).Tag]), 0, ThreadId);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
BASS_ChannelStop(form1.chan);
//ab hier versuche ich alles freizugeben um den thread neu starten zu können. es kommt auch erst der fehler wenn ich wieder versuche den thread zu starten...dan fliegt er bei obiger zeile form1.chan := BASS_StreamCreate raus!
BASS_StreamFree(form1.chan);
Filestream :=
nil;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
end;
end.