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; 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.Create; FQueueCS := TCriticalSection.Create; end; destructor TPlayerThread.Destroy; begin FQueueCS.Enter; try FFilesQueue.Free; finally FQueueCS.Leave; end; FQueueCS.Free; 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.