Duplicates not allowed

[Lena]

Hi.
I am trying to translate an example to the bass library from windows to android.
An example is called netradio from delphi windows folder bass library.

Code: Select all

procedure DoMeta();
var
  meta: MarshaledAString;
  p: Integer;
begin
  Form1.Text1.Text := '';
  meta := BASS_ChannelGetTags(str, BASS_TAG_META);
  if (meta <> nil) then
  begin
    p := Pos('StreamTitle=', meta);
    if (p = 0) then
    begin
      Form1.Text1.Text := 'No Name. Название не указано.';
      Exit;
    end;

    p := p + 13;
    //SendMessage(win, WM_INFO_UPDATE, 7, DWORD(PAnsiChar(AnsiString(Copy(meta, p, Pos(';', String(meta)) - p - 1)))));
    Copy(meta, p, Pos(';', meta - p - 1));
    Form1.Text1.Text := meta;
  end;
 end;

procedure MetaSync(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
begin
  DoMeta();
end;

procedure TForm1.Button1Click(Sender: TObject);

var
  check :boolean;
  Len, Progress: DWORD;
Begin

 check := CheckInet;

  If not check Then
  Begin
    ShowMessage('No internet connection.' + sLineBreak + 'Нет интернет соединения.');
    FloatAnimation1.Enabled := False;
    Viewport3D1.Visible := False;
    exit;
  End;
   progress := 0;
   BASS_StreamFree(str);
   Text1.Text := '';
   str := BASS_StreamCreateURL(PChar('http://91.199.194.34:8000'), 0, BASS_UNICODE, nil, nil);
   //ShowMessage(IntToStr(BASS_ErrorGetCode));

  If BASS_ErrorGetCode = 0 Then
  Begin

     // Progress
    repeat
      len := BASS_StreamGetFilePosition(str, BASS_FILEPOS_END);
      if (len = DW_Error) then
        break; // something's gone wrong! (eg. BASS_Free called)
      progress := BASS_StreamGetFilePosition(str, BASS_FILEPOS_BUFFER) * 100 div len;
      // percentage of buffer filled
      //SendMessage(win, WM_INFO_UPDATE, 2, progress); // show the Progess value in the label
    until
      (progress > 75) or (BASS_StreamGetFilePosition(str, BASS_FILEPOS_CONNECTED) = 0); // over 75% full (or end of download)


     DoMeta();
     BASS_ChannelSetSync(str, BASS_SYNC_META, 0, @MetaSync, nil);
     //BASS_SYNC_END BASS_SYNC_META
     BASS_ChannelPlay(str, FALSE);
     Viewport3D1.Visible := True;
     FloatAnimation1.Enabled := True;


   End;
End;

procedure TForm1.Button2Click(Sender: TObject);
begin
 BASS_ChannelStop(str);
 BASS_SampleFree (smp);
 Text1.Text := '';
 FloatAnimation1.Enabled := False;
 Viewport3D1.Visible := False;

end;

I got message Duplicates not allowed when second song start.
If comment line BASS_ChannelSetSync(str, BASS_SYNC_META, 0, @MetaSync, nil); no message.
How can this be fixed?

netradio.zip

(7.22 KiB) Downloaded 103 times

[Lena]

If commment in DoMeta() lines
Form1.Text1.Text := '';
Form1.Text1.Text := meta;
No Duplicates not allowed on Android.

[Lena]

It looks like it works:

Code: Select all

// uses System.Threading

procedure DoMeta();
var
  meta: MarshaledAString;
  p: Integer;
begin
  //Form1.Text1.Text := '';
  meta := BASS_ChannelGetTags(str, BASS_TAG_META);
  if (meta <> nil) then
  begin
    p := Pos('StreamTitle=', meta);
    if (p = 0) then
    begin
      TTask.Run(
       procedure
         begin
          TThread.Synchronize(TThread.CurrentThread,
	        procedure
	      begin
	       Form1.Text1.Text := 'No Name.';
         Exit;
	       end)
      end)
    end;

    //p := p + 13;
    //Copy(meta, p, Pos(';', meta - p - 1));
    //Copy(meta, Pos('=', meta)+2, Pos(';',meta)-Pos('=', meta)-3);

    TTask.Run(
       procedure
         begin
          TThread.Synchronize(TThread.CurrentThread,
	        procedure
	      begin
	       Form1.Text1.Text := meta;
	       end)
      end)

  end;
 end;

[Lena]

If the song contains Russian letters in the title, then I see unreadable characters.
Form1.Text1.Text := meta;
Please help fix it.
Delphi 10.3.3

[rlebeau]

BASS_ChannelGetTags() returns 8bit data. You need to convert that to Unicode before you process it. See my reply to your other post on that issue.

[Lena]

Thank you!
Delphi 10.3.3
I also found what UTF8String shows Russian letters. I've tested my new code throughout the day and everything looks good. I hear songs from the audio stream and see their titles Russian and English. My new code with comments below:

Code: Select all

var
  Form1: TForm1;

  smp: HSAMPLE;
  str: HSTREAM;

implementation

{$R *.fmx}

function CheckInet: boolean;
var
  aResp: IHTTPResponse;
  aHTTP: THTTPClient;
begin
  Result := false;
  aHTTP := THTTPClient.Create;
  try
    try
      aResp := aHTTP.Head('http://google.com');
      //Result := aResp.StatusCode < 400;
      Result := true;
    except
      Result := false;
    end;
  finally
    FreeAndNil(aHTTP);
  end;
end;


procedure DoMeta();
var
  meta: MarshaledAString;
  p: Integer;
  raw: UTF8String;
begin
  //Form1.Text1.Text := '';
  meta := BASS_ChannelGetTags(str, BASS_TAG_META);
  if (meta <> nil) then
  begin
    p := Pos('StreamTitle=', meta);
    if (p = 0) then
    begin
      TTask.Run(
       procedure
         begin
          TThread.Synchronize(TThread.CurrentThread,
	        procedure
	      begin
	       Form1.Text1.Text := 'No Name. Название не указано.';
         Exit;
	       end)
      end)
    end;

    //StreamTitle='Solomun - Kackvogel';StreamUrl='DNAS/streamart?sid=1;
    //remove 'StreamTitle=' and all 'StreamUrl=DNAS...'
    raw := Copy(meta, Pos('=', meta)+2, Pos(';',meta)-Pos('=', meta)-3);

    TTask.Run(
       procedure
          begin
          TThread.Synchronize(TThread.CurrentThread,
	        procedure
	           begin
	             Form1.Text1.Text := raw;
	           end)
      end)

  end;
 end;


procedure MetaSync(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
begin
  DoMeta();
end;


procedure TForm1.Button1Click(Sender: TObject);

var
  check :boolean;
  Len, progress: DWORD;
Begin

 check := CheckInet;

  If not check Then
  Begin
    ShowMessage('No internet connection.' + sLineBreak + 'Нет интернет соединения.');
    Text1.Text := '';
    FloatAnimation1.Enabled := False;
    Viewport3D1.Visible := False;
    exit;
  End;

   progress := 0;
   BASS_StreamFree(str);
   Text1.Text := '';
   str := BASS_StreamCreateURL(PChar('http://91.199.194.34:8000'), 0, BASS_UNICODE, nil, nil);
   //ShowMessage(IntToStr(BASS_ErrorGetCode));

   If BASS_ErrorGetCode = 40 Then
    Begin
     ShowMessage('Извините профилактические работы на сервере музыки.' + sLineBreak + 'Sorry maintenance work on the music server.');
     BASS_SampleFree (smp);
     Text1.Text := '';
     FloatAnimation1.Enabled := False;
     Viewport3D1.Visible := False;
     exit;
    End;


  If BASS_ErrorGetCode = 0 Then
  Begin

    //Progress
    repeat
      len := BASS_StreamGetFilePosition(str, BASS_FILEPOS_END);
      if (len = DW_Error) then
        break; //something's gone wrong! (eg. BASS_Free called)
      progress := BASS_StreamGetFilePosition(str, BASS_FILEPOS_BUFFER) * 100 div len;
    until
      (progress > 75) or (BASS_StreamGetFilePosition(str, BASS_FILEPOS_CONNECTED) = 0); // over 75% full (or end of download)

     DoMeta();//show title for song №1 

     //show title for every next song
     BASS_ChannelSetSync(str, BASS_SYNC_META, 0, @MetaSync, nil);

     BASS_ChannelPlay(str, FALSE);

     //Rotating sphere https://youtu.be/3VR9bAJxjN0
     Viewport3D1.Visible := True;
     FloatAnimation1.Enabled := True;

   End;
End;


procedure TForm1.Button2Click(Sender: TObject);
begin
 BASS_ChannelStop(str);
 BASS_SampleFree (smp);
 Text1.Text := '';
 FloatAnimation1.Enabled := False;
 Viewport3D1.Visible := False;
end;

p := Pos('StreamTitle=', meta);
[DCC Warning] UnitMain.pas(96): W1057 Implicit string cast from 'AnsiChar' to 'string'

raw := Copy(meta, Pos('=', meta)+2, Pos(';',meta)-Pos('=', meta)-3);
[DCC Warning] UnitMain.pas(113): W1057 Implicit string cast from 'AnsiChar' to 'string' <--- Four times +
[DCC Warning] UnitMain.pas(113): W1057 Implicit string cast from 'string' to 'UTF8String'

Form1.Text1.Text := raw;
[DCC Warning] UnitMain.pas(121): W1057 Implicit string cast from 'UTF8String' to 'string'

[DCC Hint] UnitMain.pas(153): H2077 Value assigned to 'progress' never used //Why?

I will try your recommendations to remove these Warnings.

[rlebeau]

p := Pos('StreamTitle=', meta);
[DCC Warning] UnitMain.pas(96): W1057 Implicit string cast from 'AnsiChar' to 'string'

raw := Copy(meta, Pos('=', meta)+2, Pos(';',meta)-Pos('=', meta)-3);
[DCC Warning] UnitMain.pas(113): W1057 Implicit string cast from 'AnsiChar' to 'string' <--- Four times +
[DCC Warning] UnitMain.pas(113): W1057 Implicit string cast from 'string' to 'UTF8String'

Form1.Text1.Text := raw;
[DCC Warning] UnitMain.pas(121): W1057 Implicit string cast from 'UTF8String' to 'string'

Again, as I already stated in my other reply, you need to convert the output of BASS_ChannelGetTags() from PAnsiChar/MarshaledAString to UnicodeString BEFORE you then search/manipulate the data. All of the functions you are calling take only UnicodeString as input, which is why you are getting warnings about implicit string casts.

[DCC Hint] UnitMain.pas(153): H2077 Value assigned to 'progress' never used //Why?

Because you really are assigning an unused value to your 'progress' variable. You are initializing 'progress' to 0, and then you don't use that value for anything before re-assigning 'progress' to the result of BASS_StreamGetFilePosition().

--------------------

Also, on a side note, using TTask.Run() just to call TThread.Synchronize() is a waste of a worker thread. You could just use TThread.ForceQueue() instead, assuming your MetaSync() callback is being called in the main UI thread (otherwise why would you be using TTask at all?), eg:

Code: Select all

procedure DoMeta();
var
  ...
begin
  ...
  TThread.ForceQueue(nil,
    procedure
    begin
      Form1.Text1.Text := ...;
    end
  );
  ...
end;

[Lena]

Thank you.
TThread.ForceQueue in DoMeta() working.
What do you think if I remove TThread.ForceQueue from DoMeta() and put in MetaSync?

Code: Select all

procedure MetaSync(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
begin
  TThread.ForceQueue(nil,
    procedure
    begin
      DoMeta();
    end)
end;

or is it better to leave TThread.ForceQueue in DoMeta()?
I do not know for sure MetaSync call from the main thread because the debugger does not work in this project.

deb.jpg (8.94 KiB) Viewed 2783 times

[rlebeau]

What do you think if I remove TThread.ForceQueue from DoMeta() and put in MetaSync?

That would cause the entire DoMeta() to execute at some indeterminate future time after MetaSync() has exited. I would suggest calling BASS_ChannelGetTags() directly in the context of MetaSync() so it gets called as soon as new metadata becomes available, not at some later time after the metadata may have already changed.

[Lena]

Thank you so much for your recommendations!