Code:
unit aipmain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLIntf, LCLType,
LMessages, ExtCtrls, StdCtrls, Bass;
const
LM_INFO_UPDATE = LM_USER + 101;
URL: array[0..0] of AnsiString = ('https://hierkomtdestream/stream');
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
procedure WndProc(var Msg: TLMessage); override;
end;
var
Form1: TForm1;
cthread: DWORD = 0;
chan: HSTREAM = 0;
win: hwnd;
implementation
{$R *.lfm}
procedure Error(es: string);
begin
MessageBox(Win, PChar(es + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) + ')'), nil, 0);
end;
procedure DoMeta();
var
meta: PAnsiChar;
p: Integer;
begin
meta := BASS_ChannelGetTags(chan, BASS_TAG_META);
if (meta <> nil) then
begin
p := Pos('StreamTitle = ', String(AnsiString(meta)));
if (p = 0) then
exit;
p := p + 13;
SendMessage(Win, LM_INFO_UPDATE, 7, DWORD(PAnsiChar(AnsiString(Copy(Meta, p,
Pos(';', String(meta)) - p -1)))));
end;
end;
procedure MetaSync(Handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
begin
DoMeta();
end;
procedure StatusProc(buffer: Pointer; Len: DWORD; user: POINTER); stdcall;
begin
if (buffer <> nil) and (len = 0) then
SendMessage(win, LM_INFO_UPDATE, 8, DWORD(PAnsiChar(Buffer)));
end;
function OpenURL(URL: PAnsiChar): Integer;
var
icy: PChar;
Len, Progress: DWORD;
begin
Result := 0;
BASS_StreamFree(chan);
progress := 0;
SendMessage(win, LM_INFO_UPDATE, 0, 0);
chan := BASS_StreamCreateURL(PWideChar(url), 0, BASS_STREAM_BLOCK or BASS_STREAM_STATUS or BASS_STREAM_AUTOFREE, @StatusProc, nil);
if (chan = 0) then
begin
SendMessage(win, LM_INFO_UPDATE, 1, Bass_ErrorGetCode());
end else
begin
repeat
Len := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END);
if (len = DW_Error) then
break;
progress := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_BUFFER) * 100 div len;
SendMessage(win, LM_INFO_UPDATE, 2, Progress);
until
(progress > 75) or (BASS_StreamGetFilePosition(chan, BASS_FIlEPOS_CONNECTED) = 0);
icy := BASS_ChannelGetTags(chan, BASS_TAG_ICY);
if (icy = nil) then
icy := BASS_ChannelGetTags(chan, BASS_TAG_HTTP);
if (icy <> nil) then
while (icy^ <> #0) do
begin
if (Copy(icy, 1, 9) = 'icy-name: ') then SendMessage(Win, LM_INFO_UPDATE, 3, DWORD(PAnsiChar(Copy(icy, 10, MaxInt))))
else if (Copy(icy, 1, 7) = 'icy-br: ') then SendMessage(win, LM_INFO_UPDATE, 4, DWORD(PAnsiChar('bitrate: ' +
Copy(icy, 8, MaxInt))));
icy := icy + Length(icy) + 1;
end;
DoMeta();
BASS_ChannelSetSync(chan, BASS_SYNC_META, 0, @MetaSync, Nil);
BASS_ChannelPlay(chan, FALSE);
end;
cthread := 0;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
win := Handle;
if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
begin
MessageBox(0, 'Een verkeerde of onbrekende versie van BASS.DLL ontbreekt', nil, MB_ICONERROR);
halt;
end;
if (not BASS_Init(-1, 44100, 0, Handle, Nil)) then
begin
Error('Kan de geluidskaart initialiseren');
halt;
end;
BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
Form1.Caption := 'AllIn Player';
Button1.Caption := 'Luisteren!';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadId: Cardinal;
begin
if (cthread <> 0) then Beep() else
cthread := BeginThread(nil, 0, @OpenURL, PAnsiChar(url[TButton(Sender).Tag]), 0, ThreadId);
end;
procedure TForm1.WndProc(var Msg: TLMessage);
begin
inherited;
if Msg.msg = LM_INFO_UPDATE then case msg.wParam of 0:
begin
Label4.Caption := 'Zoekt verbinding...';
Label3.Caption := '';
Label5.Caption := '';
end;
1:
begin
Label4.Caption := 'Speelt niet af!';
Messagebox(win, PChar('Kan de stream niet afspelen'+ #13#10 + '(error code : ' + IntToStr(msg.LParam) + ')'), nil, 0);
end;
2: Label4.Caption := Format('Buffering...%d%%', [msg.lParam]);
3: Label4.Caption := String(PAnsiChar(msg.lParam));
4: Label5.Caption := String(PAnsiChar(msg.lParam));
5: Label5.Caption := String(PAnsiChar(msg.lParam));
6: Label3.Caption := String(PAnsiChar(msg.lParam));
7: Label3.Caption := String(PAnsiChar(msg.lParam));
8: Label3.Caption := String(PAnsiChar(msg.lParam));
end;
end;
end.
Wat doe ik hier in fout?
Bookmarks