Duplicates not allowed

This is the forum for miscellaneous technical/programming questions.

Moderator: 2ffat

Post Reply
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Duplicates not allowed

Post by 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 44 times
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by Lena »

If commment in DoMeta() lines
Form1.Text1.Text := '';
Form1.Text1.Text := meta;
No Duplicates not allowed on Android. :o
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by 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
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by 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
BCBJ Author
BCBJ Author
Posts: 1726
Joined: Wed Jun 01, 2005 3:21 am
Location: California, USA
Contact:

Re: Duplicates not allowed

Post by 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.
Remy Lebeau (TeamB)
Lebeau Software
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by 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
BCBJ Author
BCBJ Author
Posts: 1726
Joined: Wed Jun 01, 2005 3:21 am
Location: California, USA
Contact:

Re: Duplicates not allowed

Post by rlebeau »

Lena wrote: Tue Oct 20, 2020 2:22 am 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.
Lena wrote: Tue Oct 20, 2020 2:22 am [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;
Remy Lebeau (TeamB)
Lebeau Software
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by 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
deb.jpg (8.94 KiB) Viewed 985 times
rlebeau
BCBJ Author
BCBJ Author
Posts: 1726
Joined: Wed Jun 01, 2005 3:21 am
Location: California, USA
Contact:

Re: Duplicates not allowed

Post by rlebeau »

Lena wrote: Wed Oct 21, 2020 10:47 pm 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.
Remy Lebeau (TeamB)
Lebeau Software
Lena
BCBJ Master
BCBJ Master
Posts: 709
Joined: Sun Feb 06, 2011 1:28 pm

Re: Duplicates not allowed

Post by Lena »

Thank you so much for your recommendations!
Post Reply