184 lines
3.8 KiB
Plaintext
184 lines
3.8 KiB
Plaintext
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;
|
||
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('<27><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', FCurrentFile);
|
||
Exit;
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
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.
|