Obsługa plików PLS przez odtwarzacz internetowy

0

Witam ponownie :-)
Mam kod programu stworzonego w BASS'ie:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BASS, BASS_AAC, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    RMF: TRadioButton;
    ZET: TRadioButton;
    RMF_serwer: TComboBox;
    ZET_serwer: TComboBox;
    Timer1: TTimer;
    StaticText1: TStaticText;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  radio: HSTREAM;
  mp3: bool=false;
  ID3: TAG_ID3;

implementation

{$R *.dfm}
function error(kod:Integer):PAnsiChar;
begin
  if kod=0 then error:='BASS_OK'
  else if kod=1 then error:='BASS_ERROR_MEM'
  else if kod=2 then error:='BASS_ERROR_FILEOPEN'
  else if kod=3 then error:='BASS_ERROR_DRIVER'
  else if kod=4 then error:='BASS_ERROR_BUFLOST'
  else if kod=5 then error:='BASS_ERROR_HANDLE'
  else if kod=6 then error:='BASS_ERROR_FORMAT'
  else if kod=7 then error:='BASS_ERROR_POSITION'
  else if kod=8 then error:='BASS_ERROR_INIT'
  else if kod=9 then error:='BASS_ERROR_START'
  else if kod=14 then error:='BASS_ERROR_ALREADY'
  else if kod=18 then error:='BASS_ERROR_NOCHAN'
  else if kod=19 then error:='BASS_ERROR_ILLTYPE'
  else if kod=20 then error:='BASS_ERROR_ILLPARAM'
  else if kod=21 then error:='BASS_ERROR_NO3D'
  else if kod=22 then error:='BASS_ERROR_NOEAX'
  else if kod=23 then error:='BASS_ERROR_DEVICE'
  else if kod=24 then error:='BASS_ERROR_NOPLAY'
  else if kod=25 then error:='BASS_ERROR_FREQ'
  else if kod=27 then error:='BASS_ERROR_NOTFILE'
  else if kod=29 then error:='BASS_ERROR_NOHW'
  else if kod=31 then error:='BASS_ERROR_EMPTY'
  else if kod=32 then error:='BASS_ERROR_NONET'
  else if kod=33 then error:='BASS_ERROR_CREATE'
  else if kod=34 then error:='BASS_ERROR_NOFX'
  else if kod=37 then error:='BASS_ERROR_NOTAVAIL'
  else if kod=38 then error:='BASS_ERROR_DECODE'
  else if kod=39 then error:='BASS_ERROR_DX'
  else if kod=40 then error:='BASS_ERROR_TIMEOUT'
  else if kod=41 then error:='BASS_ERROR_FILEFORM'
  else if kod=42 then error:='BASS_ERROR_SPEAKER'
  else if kod=43 then error:='BASS_ERROR_VERSION'
  else if kod=44 then error:='BASS_ERROR_CODEC'
  else if kod=45 then error:='BASS_ERROR_ENDED'
  else if kod=-1 then error:='BASS_ERROR_UNKNOWN';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  sciezka: PChar;
  info: BASS_CHANNELINFO;
  sc,pom: String;
begin
  mp3:=false;
  Timer1.Enabled:=false;
  StaticText1.Caption:='';
  BASS_StreamFree(radio);
  if RMF.Checked=true then
    sciezka:=PChar(RMF_serwer.Text)
  else if ZET.Checked=true then
    sciezka:=PChar(ZET_serwer.Text);
  if Edit1.Text='' then
  begin
    radio:=BASS_AAC_StreamCreateUrl(sciezka,0,0,nil,0);
    if radio=0 then
      MessageBox(0,error(BASS_ErrorGetCode),'Błąd',MB_OK or MB_ICONINFORMATION)
    else
    begin
      BASS_ChannelGetInfo(radio,info);
      BASS_ChannelPlay(radio,false);
      Timer1.Enabled:=true;
    end;
  end
  else
  begin
    sc:=Edit1.Text;
    pom:=Copy(sc,Length(sc)-2,3);
    if pom='mp3' then
      mp3:=true;
    radio:=BASS_AAC_StreamCreateUrl(PAnsiChar(Edit1.Text),0,0,nil,0);
    if radio=0 then
      radio:=BASS_StreamCreateUrl(PAnsiChar(Edit1.Text),0,0,nil,0);
    if radio=0 then
      MessageBox(0,error(BASS_ErrorGetCode),'Błąd',MB_OK or MB_ICONINFORMATION)
    else
    begin
      BASS_ChannelGetInfo(radio,info);
      BASS_ChannelPlay(radio,false);
      Timer1.Enabled:=true;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if BASS_Init(1,44100,0,0,0)=false then
  begin
    MessageBox(0,'Nie można zainicjalizować!','Błąd krytyczny',MB_OK or MB_ICONSTOP);
    Application.Terminate;
  end;
  BASS_Start();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_Stop();
  BASS_Free();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  sc,pom: AnsiString;
  pom2: Integer;
begin
    sc:=BASS_ChannelGetTags(radio,BASS_TAG_META);
    if sc<>'' then
    begin
      pom:='';
      StaticText1.Caption:=sc;
      pom2:=Pos(';StreamUrl',sc);
      StaticText1.Caption:=Copy(sc,14,pom2-15)+#13+Copy(sc,pom2+12,Length(sc)-pom2);
    end
    else
    begin
      sc:=BASS_ChannelGetTags(radio,BASS_TAG_ID3);
      StaticText1.Caption:=ID3.title+#13+ID3.artist+#13+ID3.album+#13+ID3.year;    
    end;
{    Label1.Caption:='';
    Label2.Caption:='';
    Label2.Caption:=sc;
    Label1.Caption:=Copy(sc,14,pom2-15);
}
end;

end.

Jak dodać do niego obsługę plików PLS?
Program jest przystosowany do plików AAC, więc stacje typu: Radio ZET nie powinny stwarzać problemu :-)
Aktualnie, aby odtworzyć stację należy wpisać bezpośrednie IP serwera, które trzeba "wyciągnąć" z tego pliku :/ .

Z góry dziękuję za pomoc.

0

A w czym problem, bo nie rozumiem? Widziałeś plik *.pls? To zwykły plik INI, którego obsługa w Delphi jest
banalna. Jak coś masz opis na: Pliki INI a poniżej masz funkcję, z
napisanego kiedys przeze mnie programu sterującego w WinAmpie wtyczką StreamRipper. Sprawdza ona,
czy plik pls zawiera tylko wpisy adresów internetowych http, wtedy zwraca True, a jeżeli nie to zwraca False.

function Check_PLS_PlayList(FileName: string): boolean;
var
  I, TotalFiles : integer;
  Str, Http_Prefix : string;
  IniFile : TIniFIle;
begin
  Result := True;
  Str := '';
  Http_Prefix := 'http://';
  IniFIle := TIniFIle.Create(FileName);
  TotalFiles := InifIle.ReadInteger('playlist', 'NumberOfEntries', 1);

  for I := 1 to TotalFiles do
  begin
    Str := IniFile.ReadString('playlist', 'File' + IntToStr(I), '');
    if Str <> '' then
    begin
      if (AnsiLowerCase(Copy(Str, 1, Length(Http_Prefix))) <> Http_Prefix) then
      begin
        Result := False;
        IniFIle.Free;
        Exit;
      end;
    end
    else
    begin
      Result := False;
      IniFIle.Free;
      Exit;
    end;
  end;
  IniFIle.Free;
end;
0
paszfelk napisał(a)

Mam kod programu stworzonego w BASS'ie:

function error(kod:Integer):PAnsiChar;
begin
  if kod=0 then error:='BASS_OK'
  else if kod=1 then error:='BASS_ERROR_MEM'
  else if kod=2 then error:='BASS_ERROR_FILEOPEN'
  else if kod=3 then error:='BASS_ERROR_DRIVER'
  else if kod=4 then error:='BASS_ERROR_BUFLOST'
  else if kod=5 then error:='BASS_ERROR_HANDLE'
  else if kod=6 then error:='BASS_ERROR_FORMAT'
  else if kod=7 then error:='BASS_ERROR_POSITION'
  else if kod=8 then error:='BASS_ERROR_INIT'
  else if kod=9 then error:='BASS_ERROR_START'
  else if kod=14 then error:='BASS_ERROR_ALREADY'
  else if kod=18 then error:='BASS_ERROR_NOCHAN'
  else if kod=19 then error:='BASS_ERROR_ILLTYPE'
  else if kod=20 then error:='BASS_ERROR_ILLPARAM'
  else if kod=21 then error:='BASS_ERROR_NO3D'
  else if kod=22 then error:='BASS_ERROR_NOEAX'
  else if kod=23 then error:='BASS_ERROR_DEVICE'
  else if kod=24 then error:='BASS_ERROR_NOPLAY'
  else if kod=25 then error:='BASS_ERROR_FREQ'
  else if kod=27 then error:='BASS_ERROR_NOTFILE'
  else if kod=29 then error:='BASS_ERROR_NOHW'
  else if kod=31 then error:='BASS_ERROR_EMPTY'
  else if kod=32 then error:='BASS_ERROR_NONET'
  else if kod=33 then error:='BASS_ERROR_CREATE'
  else if kod=34 then error:='BASS_ERROR_NOFX'
  else if kod=37 then error:='BASS_ERROR_NOTAVAIL'
  else if kod=38 then error:='BASS_ERROR_DECODE'
  else if kod=39 then error:='BASS_ERROR_DX'
  else if kod=40 then error:='BASS_ERROR_TIMEOUT'
  else if kod=41 then error:='BASS_ERROR_FILEFORM'
  else if kod=42 then error:='BASS_ERROR_SPEAKER'
  else if kod=43 then error:='BASS_ERROR_VERSION'
  else if kod=44 then error:='BASS_ERROR_CODEC'
  else if kod=45 then error:='BASS_ERROR_ENDED'
  else if kod=-1 then error:='BASS_ERROR_UNKNOWN';
end;


  if RMF.Checked=true then
    sciezka:=PChar(RMF_serwer.Text)
  else if ZET.Checked=true then
    sciezka:=PChar(ZET_serwer.Text);


    if radio=0 then
      radio:=BASS_StreamCreateUrl(PAnsiChar(Edit1.Text),0,0,nil,0);

    if radio=0 then
      MessageBox(0,error(BASS_ErrorGetCode),'Błąd',MB_OK or MB_ICONINFORMATION)
    else
    begin
      BASS_ChannelGetInfo(radio,info);
      BASS_ChannelPlay(radio,false);
      Timer1.Enabled:=true;
    end;

Gratuluję wiedzy.... kod porażka.

0
Opi napisał(a)

Gratuluję wiedzy.... kod porażka.

Dlaczego porażka? :> Zrób lepszy :-[
olesio, dzięki za odpowiedź, wieczorem spróbuję, bo teraz jestem poza domem :-)

0
function error(kod:Integer):PAnsiChar;
begin
  if kod=0 then error:='BASS_OK'
  else if kod=1 then error:='BASS_ERROR_MEM'
  else if kod=2 then error:='BASS_ERROR_FILEOPEN'
  else if kod=3 then error:='BASS_ERROR_DRIVER'
  else if kod=4 then error:='BASS_ERROR_BUFLOST'
  else if kod=5 then error:='BASS_ERROR_HANDLE'
  else if kod=6 then error:='BASS_ERROR_FORMAT'
  else if kod=7 then error:='BASS_ERROR_POSITION'
  else if kod=8 then error:='BASS_ERROR_INIT'
  else if kod=9 then error:='BASS_ERROR_START'
  else if kod=14 then error:='BASS_ERROR_ALREADY'
  else if kod=18 then error:='BASS_ERROR_NOCHAN'
  else if kod=19 then error:='BASS_ERROR_ILLTYPE'
  else if kod=20 then error:='BASS_ERROR_ILLPARAM'
  else if kod=21 then error:='BASS_ERROR_NO3D'
  else if kod=22 then error:='BASS_ERROR_NOEAX'
  else if kod=23 then error:='BASS_ERROR_DEVICE'
  else if kod=24 then error:='BASS_ERROR_NOPLAY'
  else if kod=25 then error:='BASS_ERROR_FREQ'
  else if kod=27 then error:='BASS_ERROR_NOTFILE'
  else if kod=29 then error:='BASS_ERROR_NOHW'
  else if kod=31 then error:='BASS_ERROR_EMPTY'
  else if kod=32 then error:='BASS_ERROR_NONET'
  else if kod=33 then error:='BASS_ERROR_CREATE'
  else if kod=34 then error:='BASS_ERROR_NOFX'
  else if kod=37 then error:='BASS_ERROR_NOTAVAIL'
  else if kod=38 then error:='BASS_ERROR_DECODE'
  else if kod=39 then error:='BASS_ERROR_DX'
  else if kod=40 then error:='BASS_ERROR_TIMEOUT'
  else if kod=41 then error:='BASS_ERROR_FILEFORM'
  else if kod=42 then error:='BASS_ERROR_SPEAKER'
  else if kod=43 then error:='BASS_ERROR_VERSION'
  else if kod=44 then error:='BASS_ERROR_CODEC'
  else if kod=45 then error:='BASS_ERROR_ENDED'
  else if kod=-1 then error:='BASS_ERROR_UNKNOWN';
end;

do takich operacji jest case badz array

    if radio=0 then
      radio:=BASS_StreamCreateUrl(PAnsiChar(Edit1.Text),0,0,nil,0);

    if radio=0 then
      MessageBox(0,error(BASS_ErrorGetCode),'Błąd',MB_OK or MB_ICONINFORMATION)
    else
    begin
      BASS_ChannelGetInfo(radio,info);
      BASS_ChannelPlay(radio,false);
      Timer1.Enabled:=true;
    end;

to powinna byc razem czyli

    if radio=0 then
begin
      radio:=BASS_StreamCreateUrl(PAnsiChar(Edit1.Text),0,0,nil,0);
      MessageBox(0,error(BASS_ErrorGetCode),'Błąd',MB_OK or MB_ICONINFORMATION);
end
    else
    begin
      BASS_ChannelGetInfo(radio,info);
      BASS_ChannelPlay(radio,false);
      Timer1.Enabled:=true;
    end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1