ttw_fmx_v10/utils/uPlayerThread.pas

unit uPlayerThread;

interface

uses
  Classes, SysUtils, SyncObjs, Generics.Collections, bass_simple,
  System.IOUtils, Types;

type
  TOnError = procedure(const Msg, FileName: string) of object;
  TOnSkip = procedure(const FileName: string) of object;

  TPlayerThread = class(TThread)
  private
    b: tbasssimple;
    FFilesQueue: TList<string>;
    FQueueCS: TCriticalSection;
    FCurrentFile: string;
    FOnError: TOnError;
    FOnSkip: TOnSkip;
    FOnAddAd: TOnSkip;
    FMusicFolder: string;
    FIsPlaying: Boolean;
    procedure PlayCurrentFile;
    procedure ScanFolder;
    procedure OnPlayHandler(Sender: TObject);
    procedure OnStopHandler(Sender: TObject);
    procedure OnEndPlayHandler(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(var ab: tbasssimple; const aFolder: string);
    destructor Destroy; override;
    procedure Skip;
    property OnError: TOnError read FOnError write FOnError;
    property OnSkip: TOnSkip read FOnSkip write FOnSkip;
    property OnAddAd: TOnSkip read FOnAddAd write FOnAddAd;
  end;

implementation

constructor TPlayerThread.Create(var ab: tbasssimple; const aFolder: string);
begin
  inherited Create(True);
  b := ab;
  FMusicFolder := aFolder;
  FIsPlaying := False;
  b.OnPlay := OnPlayHandler;
  b.OnStop := OnStopHandler;
  b.OnEndPlay := OnEndPlayHandler;
  FFilesQueue := TList<string>.Create;
  FQueueCS := TCriticalSection.Create;
end;

destructor TPlayerThread.Destroy;
begin
  FQueueCS.Enter;
  try
    FFilesQueue.Free;
  finally
    FQueueCS.Leave;
  end;
  FreeAndNil(FQueueCS);

  inherited;
end;

procedure TPlayerThread.Execute;
begin
  while not Terminated do
  begin

      ScanFolder;
      if (not FIsPlaying) then
      begin
        FQueueCS.Enter;
        try
            if (FFilesQueue.Count > 0) then
            begin
              FCurrentFile := FFilesQueue[0];
              FFilesQueue.Delete(0);
            end;
        finally
          FQueueCS.Leave;
        end;
        PlayCurrentFile;
      end;

    Sleep(1000);
  end;
end;

procedure TPlayerThread.PlayCurrentFile;
begin
  if (FCurrentFile = '') or (not FileExists(FCurrentFile)) then
  begin
    if Assigned(FOnError) then
      FOnError('Ôàéë íå íàéäåí', FCurrentFile);
    Exit;
  end;

  // Ñîçäàåì íîâûé ïîòîê è íà÷èíàåì âîñïðîèçâåäåíèå
  TThread.Synchronize(nil,
    procedure
    begin
      b.Play(FCurrentFile);
    end);

  FIsPlaying := True;

end;

procedure TPlayerThread.ScanFolder;
var
  Files: TStringDynArray;
  FileName: string;
begin
  Files := TDirectory.GetFiles(FMusicFolder, '*.mp3');
  FQueueCS.Enter;
  try
    for FileName in Files do
      if FFilesQueue.IndexOf(FileName) = -1 then
      begin
        Sleep(5000);
        FFilesQueue.Add(FileName);
        if Assigned(FOnAddAd) then
          TThread.Synchronize(nil,
            procedure
            begin
              FOnAddAd(ExtractFileName(FileName));
            end);
      end;
  finally
    FQueueCS.Leave;
  end;
end;

procedure TPlayerThread.OnPlayHandler(Sender: TObject);
begin
  FIsPlaying := True;
end;

procedure TPlayerThread.OnStopHandler(Sender: TObject);
begin
  FIsPlaying := False;
end;

procedure TPlayerThread.OnEndPlayHandler(Sender: TObject);
begin
  try
    b.Stop;
    b.FreeStream;
    if FileExists(FCurrentFile) then
    begin
      DeleteFile(FCurrentFile);
      if Assigned(FOnSkip) then
        FOnSkip(ExtractFileName(FCurrentFile));
    end;
    FCurrentFile := '';
    FIsPlaying := False;
  except

  end;
end;

procedure TPlayerThread.Skip;
begin
  if FIsPlaying then
  begin
    b.Stop;
    b.FreeStream;
    if FileExists(FCurrentFile) then
    begin
      DeleteFile(FCurrentFile);
      if Assigned(FOnSkip) then
        FOnSkip(ExtractFileName(FCurrentFile));
    end;
    FCurrentFile := '';
    FIsPlaying := False;
  end;
end;

end.