unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, bass, StdCtrls, Buttons, Gauges, ExtCtrls, LMDControl,
LMDBaseControl, LMDBaseGraphicControl, LMDGraphicControl, LMDBaseMeter,
LMDCustomProgress, LMDProgress, JvComponentBase, JvComputerInfoEx;
const
WM_INFO_UPDATE = WM_USER + 101;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
ListBox1: TListBox;
ComboBox1: TComboBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Image1: TImage;
Label1: TLabel;
StaticText1: TStaticText;
StaticText2: TStaticText;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
StaticText3: TStaticText;
StaticText4: TStaticText;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
StaticText5: TStaticText;
Label6: TLabel;
Gauge: TLMDProgress;
Label3: TLabel;
StaticText6: TStaticText;
Timer1: TTimer;
JvComputerInfoEx1: TJvComputerInfoEx;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure WndProc(var Msg: TMessage); override;
end;
var
Form1 : TForm1;
cthread: DWORD = 0;
chan : HSTREAM = 0;
win : hwnd;
URLS : String;
RFName : String;
implementation
uses Unit2;
{$R *.dfm}
procedure Error(es: string);
begin
MessageBox(win, PChar(es + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) +
')'), nil, 0);
end;
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;
SendMessage(win, WM_INFO_UPDATE, 7, DWORD(PChar(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
SendMessage(win, WM_INFO_UPDATE, 8, DWORD(PChar(buffer)));
end;
function OpenURL(
url: PChar): Integer;
var
icy: PChar;
Len, Progress: DWORD;
begin
Result := 0;
BASS_StreamFree(chan); // close old stream
progress := 0;
SendMessage(win, WM_INFO_UPDATE, 0, 0); // reset the Labels and trying connecting
chan := BASS_StreamCreateURL(
url, 0, BASS_STREAM_STATUS, @StatusProc, 0);
if (chan = 0) then
begin
SendMessage(win, WM_INFO_UPDATE, 1, 0); // Oops Error
end
else
begin
// Progress
repeat
len := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END);
if (len = DW_Error) then
break; // something's gone wrong! (eg. BASS_Free called)
progress := (BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) -
BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT)) * 100 div len;
// percentage of buffer filled
SendMessage(win, WM_INFO_UPDATE, 2, progress); // show the Progess value in the label
until
progress > 75;
form1.Gauge.maxValue:=75;
// get the broadcast name and bitrate
icy := BASS_ChannelGetTags(chan, BASS_TAG_ICY);
if (icy <> nil) then
while (icy^ <> #0) do
begin
if (Copy(icy, 1, 9) = 'icy-name:') then
SendMessage(win, WM_INFO_UPDATE, 3, DWORD(PChar(Copy(icy, 10, MaxInt))))
else if (Copy(icy, 1, 7) = 'icy-br:') then
SendMessage(win, WM_INFO_UPDATE, 4, DWORD(PChar('bitrate: ' + Copy(icy, 8, MaxInt))));
icy := icy + Length(icy) + 1;
end;
// get the stream title and set sync for subsequent titles
DoMeta(BASS_ChannelGetTags(chan, BASS_TAG_META));
BASS_ChannelSetSync(chan, BASS_SYNC_META, 0, @MetaSync, 0);
// play it!
BASS_ChannelPlay(chan, FALSE);
end;
cthread := 0;
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited;
if Msg.Msg = WM_INFO_UPDATE then
case msg.WParam of
0:
begin
Gauge.Caption := 'connecting...';
statictext2.Caption := '';
end;
1:
begin
Gauge.Caption := 'not playing';
Error('Can''t play the stream');
end;
2: Gauge.Position:=msg.LParam;
3: statictext1.Caption := PChar(msg.LParam);
4: Gauge.Caption := PChar(msg.LParam);
5: statictext2.Caption := PChar(msg.LParam);
6: statictext2.Caption := PChar(msg.LParam);
7: statictext2.Caption := PChar(msg.LParam);
8: statictext6.Caption := PChar(msg.LParam);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
try
statictext3.Caption:=inttostr(JvComputerInfoEx1.Memory.FreePhysicalMemory);
statictext4.Caption:=inttoStr(JvComputerInfoEx1.Memory.TotalPhysicalMemory);
statictext6.Caption:='OFF';
win :=
handle;
if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
begin
MessageBox(0, 'An incorrect version of BASS.DLL was loaded', nil, MB_ICONERROR);
Halt;
end;
if (not BASS_Init(-1, 44100, 0,
Handle, nil)) then
begin
Error('Can''t initialize device');
Halt;
end;
combobox1.Items.LoadFromFile('\HelixSoftware\NetRadio\Country\Default.dat');
combobox1.ItemIndex:=0;
listbox1.Items.LoadFromFile('\HelixSoftware\NetRadio\Sender\'+combobox1.Text+'.dat');
Except
ShowMessage('File Notfound Please RestInstall this Application');
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
RFName := Statictext2.Caption;
statictext5.Caption:='Recording Saved as: '+RFName+'.ogg';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_Free;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
ThreadId: Cardinal;
begin
URLS:= form2.ListBox1.Items[form1.ListBox1.ItemIndex];
if (cthread <> 0) then
MessageBeep(0)
else
cthread := BeginThread(nil, 0, @OpenURL, PChar(urls), 0, ThreadId);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
form2.listbox1.Items.LoadFromFile('\HelixSoftware\NetRadio\Sender\'+form1.ComboBox1.Text+'.hpls');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
application.ProcessMessages;
end;
end.