unit DirectXMediaPlayer; interface uses Windows,Controls, Classes, directsound,dxCommon,mmsystem,sysutils,extctrls,msacm,mmreg,forms,activex,math,MP3Utils; const MP3BLOCKSIZE=1522; const EQBANDS = 10; const EQBANDWIDTH = 6; Type TDXMPNotifyValues = (nvSuccessful, nvSuperseded, nvAborted, nvFailure); TDXMPTimeFormats = (tfMilliseconds, tfHMS, tfMSF, tfFrames, tfSMPTE24, tfSMPTE25, tfSMPTE30, tfSMPTE30Drop, tfBytes, tfSamples, tfTMSF); type TParamEqDesc = record freq : integer; friendly : string; end; const EQBANDSDESC : array[1..EQBANDS] of TParamEqDesc = ((freq : 100;friendly : '100 Hz'), (freq : 200;friendly : '200 Hz'), (freq : 400;friendly : '400 Hz'), (freq : 600;friendly : '600 Hz'), (freq : 1000;friendly : '1000 Hz'), (freq : 3000;friendly : '3000 Hz'), (freq : 6000;friendly : '6000 Hz'), (freq : 12000;friendly : '12000 Hz'), (freq : 14000;friendly : '14000 Hz'), (freq : 14500;friendly : '15000 Hz')); type TDXMP = class (TThread) private ffilename : string; mp3fileinfo : TMP3FileInfo; dsound : IDirectSound8; dstempbuffer : IDirectSoundBuffer; dsbuf8 : IDirectSoundBuffer8; dsnotify : IDirectSoundNotify; dseffect : array[1..EQBANDS+1] of TDSEffectDesc; bufdesc : TDSBufferDesc_DX8; WaveFormat : tWAVEFORMATEX; fs : TFileStream; //debugfs : TFileStream; mp3buffer : pointer; pcmbuffer : pointer; tempbuffer : pointer; flength : longint; Event_Firstpos, Event_Secondpos : thandle; Event_Play : THandle; StopPlaying : boolean; PCMChunkRemainder : pointer; PCMChunkRemainderSize : dword; pcmbuffersize : DWORD; acmstream : HACMSTREAM; streamheader : TACMSTREAMHEADER; initialbufferready : BOOLEAN; Mp3BufferSize : dword; eqs : array [1..EQBANDS] of IDirectSoundFXParamEQ8; compressor : IDirectSoundFXCompressor8; fsetupcompressor : boolean; fsetupequalizer : boolean; fhavedata : TNotifyEvent; fnotify : boolean; fNotifyValue : TDXMPNotifyValues; fErrorValue : Longint; fDeviceID : Word; fEndPos : LongInt; fTimeFormats : TDXMPTimeFormats; procedure DoHaveData; procedure fsetEqualizer(e : boolean); procedure fsetCompressor(e : boolean); function getpos : dword; procedure setpos(i : dword); function getlength : dword; procedure Execute;override;function GetPCMChunk() : dword; procedure SetupFX; function PCMChunktoBuffer(half : byte) : integer; function getvolume : longint; procedure setvolume(v : longint); protected public constructor Create (hand : hwnd); destructor Destroy; procedure seteqparam(band : byte;gain : shortint); function Open: integer; procedure Play; procedure Stop; procedure Pause; property filename : string read ffilename write ffilename; property position : dword read getpos write setpos; property length : dword read getlength; property IncludeEqualizerinSetup : boolean read fsetupequalizer write fsetEqualizer; property IncludeCompressorinSetup : boolean read fsetupCompressor write fsetCompressor; property volume : longint read getvolume write setvolume; procedure setcompressor(gain : integer; Threshold : integer;Ratio : integer;Attack : integer;Release : Integer); procedure zeroEqualizer; procedure zeroCompressor; procedure Close; property OnHaveData : TNotifyEvent read fhavedata write fhavedata; property PCMData : pointer read pcmbuffer; property PCMSize : dword read pcmbuffersize; property Notify : boolean read fnotify write fnotify; property NotifyValue : TDXMPNotifyValues read fNotifyValue; property Error : Longint read fErrorValue; property DeviceID : word read fDeviceID; property EndPos : Longint read fEndPos write fEndPos; property TimeFormat : TDXMPTimeFormats read fTimeFormats write fTimeformats; published end; implementation constructor TDXMP.Create (hand : hwnd); var p : tguid; res : HResult; result : string; event_sa : SECURITY_ATTRIBUTES; begin inherited Create (true); //self.Priority:=tpHighest; //getplaydevices; //PCMChunkRemainderSize:=0; initialbufferready:=false; getDeviceID(@DSDEVID_DefaultPlayback,@p); CoInitialize(nil); res:=directsoundcreate8(@p,dsound,nil); if res<>DS_OK then begin result:='Unknown error'; if res=DSERR_ALLOCATED then result:='Device already in use. This program only works on full duplex sound cards.'; if res=DSERR_INVALIDPARAM then result:='Internal error: Invalid Parameter'; if res=DSERR_NOAGGREGATION then result:='Internal error: No Agrgegation'; if res=DSERR_OUTOFMEMORY then result:='Insuficient Memory.'; messagebox(0,pchar(result),pchar(result),0); exit; end; res:=dsound.SetCooperativeLevel(hand,DSSCL_PRIORITY); if res<>DS_OK then begin result:='Unknown error'; if res=DSERR_ALLOCATED then result:='Device already in use. This program only works on full duplex sound cards.'; if res=DSERR_INVALIDPARAM then result:='Internal error: Invalid Parameter'; if res=DSERR_NOAGGREGATION then result:='Internal error: No Agrgegation'; if res=DSERR_OUTOFMEMORY then result:='Insuficient Memory.'; messagebox(0,pchar(result),pchar(result),0); exit; end; Event_sa.nLength:=sizeof(SECURITY_ATTRIBUTES); Event_sa.lpSecurityDescriptor:=nil; Event_sa.bInheritHandle:=false; Event_Play:=CreateEvent(@Event_sa,false,false,'LSDSPLAY'); fsetupequalizer:=true; fsetupcompressor:=true; end; function TDXMP.Open : integer; var res : dword; outputformat : tWAVEFORMATEX; inputformat : tMPEGLAYER3WAVEFORMAT; posnotify : array[0..1] of TDSBPOSITIONNOTIFY; event_sa : SECURITY_ATTRIBUTES; scrap : IUnknown; begin if fs<>nil then exit; mp3fileinfo:=TMP3FileInfo.Create(ffilename); flength:=round(mp3fileinfo.duration); if fs<>nil then fs.free; try fs:=TfileStream.Create(ffilename,fmOpenRead); except; result:=-2; exit; end; //fs.Position:=MP3FileInfo.StartFrameIsAt; //Setup ACM MP3 decoder inputformat.wfx.cbSize := MPEGLAYER3_WFX_EXTRA_BYTES; inputformat.wfx.wFormatTag := WAVE_FORMAT_MPEGLAYER3; inputformat.wfx.nChannels := mp3fileinfo.Channels; inputformat.wfx.nAvgBytesPerSec := 320*(1000 div 8); //(mp3fileinfo.header.BitRate)*(1024 div 8); //round((mp3fileinfo.header.BitRate/8)*1000); // not really used but must be one of 64, 96, 112, 128, 160kbps inputformat.wfx.wBitsPerSample := 0; // MUST BE ZERO inputformat.wfx.nBlockAlign := 1; // MUST BE ONE inputformat.wfx.nSamplesPerSec := mp3fileinfo.header.SampleRate;//; 44100;//mp3fileinfo.header.SampleRate; // 44.1kHz inputformat.fdwFlags := MPEGLAYER3_FLAG_PADDING_OFF; inputformat.nBlockSize := MP3FileInfo.FrameLength; // voodoo value #1 inputformat.nFramesPerBlock := 1; // MUST BE ONE inputformat.nCodecDelay := 1393; // voodoo value #2 inputformat.wID := MPEGLAYER3_ID_MPEG; outputformat.wFormatTag := WAVE_FORMAT_PCM; outputformat.nChannels := mp3fileinfo.Channels;; // stereo outputformat.nSamplesPerSec := mp3fileinfo.header.SampleRate; // 44.1kHz outputformat.wBitsPerSample := 16; // 16 bits outputformat.nBlockAlign := 2*mp3fileinfo.Channels; // 4 bytes of data at a time are useful (1 sample) outputformat.nAvgBytesPerSec := (mp3fileinfo.Channels*2) * mp3fileinfo.header.SampleRate; // byte-rate outputformat.cbSize := 0; // no more data to follow acmstream:=0; res := acmStreamOpen( @acmstream, // open an ACM conversion stream 0, // querying all ACM drivers PWAVEFORMATEX(@inputformat)^, // converting from MP3 outputformat, // to WAV nil, // with no filter 0, // or async callbacks 0, // (and no data for the callback) 0 // and no flags ); if res<>0 then begin messagebox(0,pchar(inttostr(res)),'streamOpen',0); result:=-3; exit; end; mp3buffersize:=10*1024;; res:=acmStreamSize( acmstream, mp3buffersize, pcmbuffersize,ACM_STREAMSIZEF_SOURCE ); res:=acmStreamSize( acmstream, pcmbuffersize, mp3buffersize, ACM_STREAMSIZEF_DESTINATION ); pcmbuffersize:=round(pcmbuffersize); if res<>0 then begin messagebox(0,pchar(inttostr(res)),'streamsize',0); result:=-4; exit; end; GetMem(pcmchunkRemainder,pcmbuffersize); GetMem(pcmbuffer,pcmbuffersize); GetMem(tempbuffer,mp3buffersize); GetMem(mp3buffer,mp3buffersize); //prep header ZeroMemory( @streamheader, sizeof(TACMSTREAMHEADER ) ); streamheader.cbStruct := sizeof(TACMSTREAMHEADER ); streamheader.pbSrc :=mp3buffer; streamheader.cbSrcLength := MP3BUFFERSIZE; streamheader.pbDst := pcmbuffer; streamHeader.cbDstLength := pcmbuffersize; res := acmStreamPrepareHeader( acmstream, streamheader, 0 ); if res<>0 then begin messagebox(0,pchar(inttostr(res)),'streamprepareheader',0); result:=-5; exit; end; zeromemory(@bufdesc,sizeof(TDSBufferDesc_DX8)); bufdesc.dwSize:=sizeof(TDSBufferDesc_DX8); bufdesc.dwFlags:=DSBCAPS_CTRLPOSITIONNOTIFY or DSBCAPS_GLOBALFOCUS or DSBCAPS_GETCURRENTPOSITION2 or DSBCAPS_CTRLVOLUME or DSBCAPS_CTRLFX; bufdesc.dwBufferBytes:=pcmbuffersize*2; with WaveFormat do begin WFormatTag := WAVE_FORMAT_PCM; wBitsPerSample :=16; NChannels:=mp3fileinfo.Channels; NSamplesPerSec:=mp3fileinfo.header.SampleRate; NBlockAlign:=(mp3fileinfo.Channels*wbitspersample) div 8; NAvgBytesPerSec:=((wBitsperSample) * nChannels * nSAmplesPerSec) div 8; end; bufdesc.lpwfxFormat:=@waveformat; res:=dsound.CreateSoundBuffer(bufdesc,dstempbuffer,scrap); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'trouble',0); result:=-6; exit; end; dstempbuffer.QueryInterface( IID_IDirectSoundBuffer8,dsbuf8 ); dstempbuffer._Release; Event_sa.nLength:=sizeof(SECURITY_ATTRIBUTES); Event_sa.lpSecurityDescriptor:=nil; Event_sa.bInheritHandle:=false; Event_Firstpos:=CreateEvent(@Event_sa,false,false,'DXFIRSTHALFREADY'); if Event_Firstpos=0 then begin messagebox(0,pchar(inttostr(Event_FirstPos)),'trouble creating firstpos event',0); result:=-7; exit; end; Event_Secondpos:=CreateEvent(@Event_sa,false,false,'DXSECONDHALFFREADY'); if Event_Secondpos=0 then begin messagebox(0,pchar(inttostr(Event_SecondPos)),'trouble creating secondpos event',0); result:=-8; exit; end; posnotify[0].dwOffset:=0; posnotify[0].hEventNotify:=Event_firstpos; posnotify[1].dwOffset:=pcmbuffersize; posnotify[1].hEventNotify:=Event_secondpos; res:=dsbuf8.QueryInterface(IDirectSoundNotify,dsnotify); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); result:=-9; exit; end; res:=dsnotify.SetNotificationPositions(2,@posnotify); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'setnotifcationpositions',0); result:=-10; exit; end; result:=0; SetupFX; end; function TDXMP.getPCMchunk() : dword; var res : integer; tempbuffercount : dword; rd : integer; begin //getmem(tempbuffer,pcmbuffersize); //move(PCMchunkremainder^,tempbuffer^,PCMchunkremaindersize); //tempbuffercount:=PCMchunkremaindersize; tempbuffercount:=0; streamheader.cbDstLengthUsed:=0; fillchar(mp3buffer,0,mp3buffersize); while(tempbuffercount<pcmbuffersize) do begin rd:=fs.Read(mp3buffer^,mp3buffersize); res:=acmStreamConvert( acmstream, streamheader, ACM_STREAMCONVERTF_BLOCKALIGN); if res<>0 then begin result:=0; exit; end; //move(tempbuffer^,ptr(dword(pcmbuffer)+tempbuffercount)^,streamheader.cbDstLengthUsed); // move(tempbuffer^,pcmbuffer^,streamheader.cbDstLengthUsed); tempbuffercount:=tempbuffercount+streamheader.cbDstLengthUsed; if rd>streamheader.cbSrcLengthUsed then begin fs.seek(0-(rd-streamheader.cbSrcLengthUsed),soFromCurrent); end; { if (streamheader.cbDstLengthUsed+tempbuffercount)<pcmbuffersize then begin move(pcmbuffer^,ptr(dword(tempbuffer)+tempbuffercount)^,streamheader.cbDstLengthUsed); tempbuffercount:=tempbuffercount+streamheader.cbDstLengthUsed; PCMchunkremaindersize:=0; end else begin move(pcmbuffer^,ptr(dword(tempbuffer)+tempbuffercount)^,pcmbuffersize-tempbuffercount); PCMchunkremaindersize:=streamheader.cbDstLengthUsed-(pcmbuffersize-tempbuffercount); move(ptr(dword(pcmbuffer)+(pcmbuffersize-tempbuffercount))^,PCMchunkremainder^,PCMChunkremaindersize); tempbuffercount:=tempbuffercount+(pcmbuffersize-tempbuffercount); end; } end; //move(tempbuffer^,pcmbuffer^,pcmbuffersize); result:=streamheader.cbDstLengthUsed; DoHaveData; end; function TDXMP.PCMChunktoBuffer(half : byte) : integer; var buf1,buf2 : pointer; buf1sz,buf2sz : dword; res : dword; sz : integer; begin result:=0; if (half=0) then sz:=0 else sz:=pcmbuffersize; res:=dsbuf8.Lock(sz,pcmbuffersize,buf1,buf1sz,buf2,buf2sz,0); if res<>DS_OK then begin result:=0; messagebox(0,pchar(dserrorstring(res)),'trouble',0); exit; end; if buf2<>nil then begin result:=0; messagebox(0,pchar(dserrorstring(res)),'trouble',0); end; move(pcmbuffer^,buf1^,buf1sz); res:=dsbuf8.Unlock( buf1,buf1sz,buf2,0); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'trouble',0); result:=-1; exit; end; end; procedure TDXMP.execute; var hds : array [0..1] of thandle; res : dword; begin hds[0]:=Event_Firstpos; hds[1]:=Event_Secondpos; while(true) do begin WaitForSingleObject(Event_Play,INFINITE); StopPlaying:=false; while(StopPlaying=false) do begin GetPCMChunk; res:=WaitForMultipleObjects(2,@hds,false,INFINITE); if res-WAIT_OBJECT_0=0 then PCMChunkToBuffer(1) else PCMChunkToBuffer(0); end; end; end; procedure TDXMP.Play; begin if fs=nil then exit; dsbuf8.SetCurrentPosition(0); dsbuf8.Play(0,0,DSBPLAY_LOOPING); resume; stopplaying:=false; SetEvent(Event_Play); end; procedure TDXMP.Stop; begin if fs=nil then exit; suspend; ResetEvent(Event_Play); StopPlaying:=true; fs.Position:=0; dsbuf8.Stop; fillchar(pcmbuffer^,pcmbuffersize,0); dsbuf8.SetCurrentPosition(0); PCMChunkToBuffer(0); PCMChunkToBuffer(1); acmStreamReset(acmstream,0); getpcmchunk; end; procedure TDXMP.Pause; begin ResetEvent(Event_Play); StopPlaying:=true; dsbuf8.Stop; // suspend; end; function TDXMP.getpos : dword; begin if suspended=true then exit; result:=round(mp3fileinfo.CalculatePositionFromFileSize(fs.Position)); end; procedure TDXMP.setpos(i: dword); begin dsbuf8.Stop; fs.position:=mp3fileinfo.CalculateFilePositionFromTime(i); getpcmchunk; dsbuf8.Play(0,0,DSBPLAY_LOOPING); end; function TDXMP.getlength : dword; begin //result:=fs.Size; result:=flength; end; destructor TDXMP.Destroy; begin CoUninitialize; end; procedure TDXMP.SetupFX; var n : integer; desc : TDSFXParamEq; res : dword; dwRes : array [0..EQBANDS] of Dword; sp : byte; ep : byte; stat : Dword; begin dsbuf8.GetStatus(stat); for n := 1 to EQBANDS do begin dwres[n]:=0; fillchar(dseffect[n],sizeof(TDSEffectDesc),0); dsEffect[n].dwSize := sizeof(TDSEffectDesc); dsEffect[n].dwFlags := 0; dsEffect[n].guidDSFXClass:=GUID_DSFX_STANDARD_PARAMEQ; end; n:=EQBANDS+1; dsEffect[n].dwSize := sizeof(TDSEffectDesc); dsEffect[n].dwFlags := 0; dsEffect[n].guidDSFXClass:=GUID_DSFX_STANDARD_COMPRESSOR; if fsetupequalizer=true then begin sp:=1; ep:=EQBANDS; end; if fsetupequalizer=false then begin sp:=EQBANDS; ep:=1; end; if (fsetupcompressor=true) and (fsetupequalizer=false) then begin sp:=EQBANDS+1; ep:=1; end; if (fsetupcompressor=true) and (fsetupequalizer=true) then begin sp:=1; ep:=EQBANDS+1; end; if (stat and DSBSTATUS_PLAYING)>0 then begin stopplaying:=true; dsbuf8.Stop; end; if (fsetupequalizer=false) and (fsetupcompressor=false) then begin res:=dsbuf8.setFX(0,nil,nil); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); // exit; end; end else begin res:=dsbuf8.setFX(ep,@dsEffect[sp],nil); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); // exit; end; end; if (stat and DSBSTATUS_PLAYING)>0 then begin play; end; if fsetupequalizer=true then begin for n := 1 to EQBANDS do begin res:= dsbuf8.GetObjectInPath(GUID_DSFX_STANDARD_PARAMEQ,n-1,IID_IDirectSoundFXParamEQ8,eqs[n]); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); // exit; end; desc.fCenter:=EQBANDSDESC[n].freq; desc.fgain:=0; desc.fBandwidth:=EQBANDWIDTH; res:=eqs[n].SetAllParameters(desc); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); // exit; end; end; end; if fsetupcompressor=true then begin res:= dsbuf8.GetObjectInPath(GUID_DSFX_STANDARD_COMPRESSOR,0,IID_IDirectSoundFXCompressor8,compressor); if res<>DS_OK then begin messagebox(0,pchar(dserrorstring(res)),'query interface for setnotification',0); // exit; end; end; end; procedure TDXMP.seteqparam(band: Byte; gain: Shortint); var desc : TDSFXParamEq; begin if fsetupequalizer=false then exit; desc.fCenter:=EQBANDSDESC[band].freq; desc.fgain:=gain; desc.fBandwidth:=EQBANDWIDTH; //dsbuf8.GetObjectInPath(GUID_DSFX_STANDARD_PARAMEQ,0,IID_IDirectSoundFXParamEQ8,eqs[band]); eqs[band].SetAllParameters(desc); end; function TDXMP.getvolume : longint; var v : longint; begin dsbuf8.GetVolume(v); end; procedure TDXMP.setvolume(v : longint); begin if (v<DSBVOLUME_MIN div 2) then v:=DSBVOLUME_MIN; if v>DSBVOLUME_MAX then v:=DSBVOLUME_MAX; dsbuf8.SetVolume(v); end; procedure TDXMP.setcompressor(gain : integer; Threshold : integer;Ratio : integer;Attack : Integer;Release : Integer); var compdesc : TDSFXCompressor; begin if fsetupcompressor=false then exit; { DSFXCOMPRESSOR_GAIN_MIN = -60.0; DSFXCOMPRESSOR_GAIN_MAX = 60.0; DSFXCOMPRESSOR_ATTACK_MIN = 0.01; DSFXCOMPRESSOR_ATTACK_MAX = 500.0; DSFXCOMPRESSOR_RELEASE_MIN = 50.0; DSFXCOMPRESSOR_RELEASE_MAX = 3000.0; DSFXCOMPRESSOR_THRESHOLD_MIN = -60.0; DSFXCOMPRESSOR_THRESHOLD_MAX = 0.0; DSFXCOMPRESSOR_RATIO_MIN = 1.0; DSFXCOMPRESSOR_RATIO_MAX = 100.0; DSFXCOMPRESSOR_PREDELAY_MIN = 0.0; DSFXCOMPRESSOR_PREDELAY_MAX = 4.0;} compdesc.fGain:=gain; compdesc.fAttack:=attack; compdesc.fThreshold:=threshold; compdesc.fRatio:=ratio; compdesc.fPredelay:=1; compdesc.frelease:=attack; compressor.SetAllParameters(compdesc); end; procedure TDXMP.fsetEqualizer(e : boolean); begin fsetupequalizer:=e; SetupFx; end; procedure TDXMP.fsetCompressor(e : boolean); begin fsetupcompressor:=e; SetupFx; end; procedure TDXMP.zeroEqualizer; var n : integer; begin for n := 1 to EQBANDS do seteqparam(n,0) end; procedure TDXMP.zeroCompressor; var compdesc : TDSFXCompressor; begin compdesc.fGain:=0; compdesc.fAttack:=0; compdesc.fThreshold:=0; compdesc.fRatio:=0; compdesc.fPredelay:=0; compdesc.fRelease:=0; compressor.SetAllParameters(compdesc); end; procedure TDXMP.DoHaveData; begin if assigned(fHaveData) then fHaveData(Self); end; procedure TDXMP.Close; begin stop; fs.Free; end; end.