home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / Delphi / netradio / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2005-10-03  |  3.9 KB  |  155 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Bass;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     GroupBox1: TGroupBox;
  12.     Label1: TLabel;
  13.     Label2: TLabel;
  14.     Button1: TButton;
  15.     Button2: TButton;
  16.     Button3: TButton;
  17.     Button4: TButton;
  18.     Button5: TButton;
  19.     Button6: TButton;
  20.     Button7: TButton;
  21.     Button8: TButton;
  22.     Button9: TButton;
  23.     Button10: TButton;
  24.     GroupBox2: TGroupBox;
  25.     Label3: TLabel;
  26.     Label4: TLabel;
  27.     Label5: TLabel;
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure FormDestroy(Sender: TObject);
  30.     procedure Button1Click(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.     cthread: DWORD;
  34.     chan: HSTREAM;
  35.   public
  36.     { Public declarations }
  37.   end;
  38.  
  39. var
  40.   Form1: TForm1;
  41.  
  42. implementation
  43.  
  44. const
  45.   urls: array[0..9] of String = (
  46.     'http://64.236.34.196/stream/1048','http://205.188.234.129:8024',
  47.     'http://64.236.34.97/stream/1006','http://206.98.167.99:8406',
  48.     'http://160.79.1.141:8000','http://streams.riverhosting.net:8012',
  49.     'http://205.188.234.4:8016','http://205.188.234.4:8014',
  50.     'http://207.200.96.225:8010','http://64.202.98.91:8082'
  51.   );
  52.  
  53. {$R *.dfm}
  54.  
  55. { display error messages }
  56. procedure Error(es: String);
  57. begin
  58.   MessageBox(Form1.Handle, PChar(es + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) + ')'), 'Error', 0);
  59. end;
  60.  
  61. { update stream title from metadata }
  62. procedure DoMeta(meta: PChar);
  63. var
  64.   p: Integer;
  65. begin
  66.   if (meta <> nil) then
  67.   begin
  68.     p := Pos('StreamTitle=', meta);
  69.     if (p = 0) then
  70.       Exit;
  71.     p := p + 13;
  72.     Form1.Label3.Caption := Copy(meta, p, Pos(';', meta) - p - 1);
  73.   end;
  74. end;
  75.  
  76. procedure MetaSync(handle: HSYNC; channel, data, user: DWORD); stdcall;
  77. begin
  78.   DoMeta(PChar(data));
  79. end;
  80.  
  81. procedure StatusProc(buffer: Pointer; len, user: DWORD); stdcall;
  82. begin
  83.   if (buffer <> nil) and (len = 0) then
  84.     Form1.Label5.Caption := PChar(buffer); // display connection status
  85. end;
  86.  
  87. function OpenURL(url: PChar): Integer;
  88. var
  89.   icy: PChar;
  90. begin
  91.   Result := 0;
  92.   BASS_StreamFree(Form1.chan); // close old stream
  93.   Form1.Label4.Caption := 'connecting...';
  94.   Form1.Label3.Caption := '';
  95.   Form1.Label5.Caption := '';
  96.   Form1.chan := BASS_StreamCreateURL(url, 0, BASS_STREAM_STATUS, @StatusProc, 0);
  97.   if (Form1.chan = 0) then
  98.   begin
  99.     Form1.Label4.Caption := 'not playing';
  100.     Error('Can''t play the stream');
  101.   end
  102.   else
  103.   begin
  104.     // get the broadcast name and bitrate
  105.     icy := BASS_StreamGetTags(Form1.chan, BASS_TAG_ICY);
  106.     if (icy <> nil) then
  107.       while (icy^ <> #0) do
  108.       begin
  109.         if (Copy(icy, 1, 9) = 'icy-name:') then
  110.           Form1.Label4.Caption := Copy(icy, 11, Length(icy) - 10)
  111.         else if (Copy(icy, 1, 7) = 'icy-br:') then
  112.           Form1.Label5.Caption := 'bitrate: ' + Copy(icy, 9, Length(icy) - 8);
  113.         icy := icy + Length(icy) + 1;
  114.       end;
  115.     // get the stream title and set sync for subsequent titles
  116.     DoMeta(BASS_StreamGetTags(Form1.chan,BASS_TAG_META));
  117.     BASS_ChannelSetSync(Form1.chan,BASS_SYNC_META,0,@MetaSync,0);
  118.     // play it!
  119.     BASS_ChannelPlay(Form1.chan,FALSE);
  120.   end;
  121.   Form1.cthread := 0;
  122. end;
  123.  
  124. procedure TForm1.FormCreate(Sender: TObject);
  125. begin
  126.   // check that BASS 2.2 was loaded
  127.   if (BASS_GetVersion <> DWORD(MAKELONG(2,2))) then
  128.   begin
  129.     MessageBox(0,'BASS version 2.2 was not loaded','Incorrect BASS.DLL',0);
  130.     Halt;
  131.   end;
  132.   if (not BASS_Init(-1,44100,0,Form1.Handle,NIL)) then
  133.   begin
  134.     Error('Can''t initialize device');
  135.     Halt;
  136.   end;
  137. end;
  138.  
  139. procedure TForm1.FormDestroy(Sender: TObject);
  140. begin
  141.   BASS_Free;
  142. end;
  143.  
  144. procedure TForm1.Button1Click(Sender: TObject);
  145. var
  146.   ThreadId: Cardinal;
  147. begin
  148.   if (cthread <> 0) then
  149.     MessageBeep(0)
  150.   else
  151.     cthread := BeginThread(nil, 0, @OpenURL, PChar(urls[TButton(Sender).Tag]), 0, ThreadId);
  152. end;
  153.  
  154. end.
  155.