如何播放内存流中的mp3音乐

pilicat 2009-05-09 11:20:03
请问各位大虾,Delphi中如何才能实现播放内存流中的mp3音乐?

mp3音乐是从数据库的字段中提取出来,放到内存流 (TMemoryStream) 中的,由于使用的频度非常高,不能存储到硬盘后再播放,需要直接从内存流中取数据播放?请问各位有办法解决吗?
...全文
2042 31 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
31 条回复
切换为时间正序
请发表友善的回复…
发表回复
PengDeGang 2010-08-27
  • 打赏
  • 举报
回复
dddddddddddddddd
pilicat 2010-03-10
  • 打赏
  • 举报
回复
放了10个多月的贴,今天才发现还没有结。至今我还没有找到解决的办法,谢谢各位了!
pengxuan 2009-12-14
  • 打赏
  • 举报
回复
MMTools组件包里有控件能实现楼主的功能,Demo里有简单例子
qzmp_sc 2009-12-09
  • 打赏
  • 举报
回复
mark
Frank.WU 2009-09-23
  • 打赏
  • 举报
回复
如果这样的话,我建议你存数据库的时候用 WAV 格式。
pilicat 2009-09-17
  • 打赏
  • 举报
回复
不好意思,前久这个项目搁浅了,也没有关注论坛。

我尝试过使用BASS库,但由于我每段声音的长度都非常短(只有0.1秒左右),效果非常差,听上去很不连续。

不知各位兄弟姐妹有什么高招?

Frank.WU 2009-06-19
  • 打赏
  • 举报
回复
BASS 库是当然首选!
不得闲 2009-06-17
  • 打赏
  • 举报
回复
很强大,留下了。
zhuojf 2009-06-14
  • 打赏
  • 举报
回复
推荐你用bass.dll声音引擎
genispan 2009-06-11
  • 打赏
  • 举报
回复
MARK
taixinltd 2009-06-10
  • 打赏
  • 举报
回复
方法1:
用ACM函数转换成WAV,然后再用WAVEOUT进行播放;

方法2:
编写流播放程序,需要使用FILTER技术;
siwuge 2009-06-08
  • 打赏
  • 举报
回复
学习一下。
qiglave 2009-05-30
  • 打赏
  • 举报
回复
学习一下。以后可能会用到
wz蝈蝈 2009-05-27
  • 打赏
  • 举报
回复
学习一下。以后可能会用到
laihongbo524 2009-05-24
  • 打赏
  • 举报
回复
Procedure TWMAudio.SetPosition(Value: Int64);
Begin
If Not FActive Then Exit;
If Not Ahattr.FSeekable Then Exit;
Start(Value);
End;

Procedure TWMAudio.LoadFromFile(FileName: String);
Begin
LoadFromURL(FileName);
End;

Procedure TWMAudio.LoadFromURL(URL: String);
Begin
Open(URL);
End;

Procedure TWMAudio.LoadFromStream(Stream: TStream);
Begin
If m_pReader = Nil Then Exit;
ResetEvent(m_hAsyncEvent);
Close;
SetStatus(WM_OPENING);
If FStream = Nil Then
FStream := TMemoryStream.Create;
FStream.clear;
FStream.LoadFromStream(Stream);
If Failed(m_pReader2.OpenStream(GetIStream(FStream), Self, Nil)) Then
Begin
//'Could not open the Stream';
Exit;
End;
WaitForEvent(m_hAsyncEvent);
If Failed(m_hrAsync) Then
Begin
//'Could not open the specified file';
Exit;
End;
Sleep(100);
GetHeaderAttrs;
If Ahattr.FDuration = 0 Then Exit;
If Not GetAudioOutput Then Exit;
End;

Procedure TWMAudio.LoadFromResourceName(Instance: THandle; Const ResName: String; ResType: PChar);
Var
Res: TResourceStream;
Begin
Res := TResourceStream.Create(Instance, ResName, ResType);
Try
Self.LoadFromStream(Res);
Finally
Res.Free;
End;
End;

Procedure TWMAudio.LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: PChar);
Var
Res: TResourceStream;
Begin
Res := TResourceStream.CreateFromID(Instance, ResID, ResType);
Try
Self.LoadFromStream(Res);
Finally
Res.Free;
End;
End;

Procedure TWMAudio.Open(FileName: String);
Begin
If Not FActive Then Exit;
If m_pReader = Nil Then Exit;
ResetEvent(m_hAsyncEvent);
Close;
SetStatus(WM_OPENING); // StringToWideChar()
m_pReader2.SetPlayMode(WMT_PLAY_MODE_AUTOSELECT);
If Failed(m_pReader.Open(PWideChar(WideString(FileName)), Self, Nil)) Then
Begin
//'Could not open the specified file';
Exit;
End;
WaitForEvent(m_hAsyncEvent);
If Failed(m_hrAsync) Then
Begin
//'Could not open the specified file';
Exit;
End;
Sleep(100);
GetHeaderAttrs;
If Ahattr.FDuration = 0 Then Exit;
If Not GetAudioOutput Then Exit;
End;

Procedure TWMAudio.Close;
Begin
If Not FActive Then Exit;
//If (FStatus = WM_STARTED) Or (FStatus = WM_PAUSED) Then
Stop;
If m_pReader <> Nil Then
If Failed(m_pReader.Close) Then
Exit;
If m_hWaveOut <> 0 Then
Begin
If waveOutReset(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
If waveOutClose(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
WaitForEvent(m_hAsyncEvent);
m_hWaveOut := 0;
//SetStatus(WM_CLOSED);
FreeAndNil(FStream);
End;
End;

Procedure TWMAudio.Start(Const cnsStart: Int64 = 0);
Var
mmr: MMRESULT;
Begin
If m_pReader = Nil Then Exit;
If m_hWaveOut <> 0 Then
Begin
If waveOutReset(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
End
Else
Begin
mmr := waveOutOpen(@m_hWaveOut, WAVE_MAPPER, m_pWfx, DWORD(Addr(WaveProc)), DWORD(Self), CALLBACK_FUNCTION);
If mmr <> MMSYSERR_NOERROR Then Exit;
If hThread <> 0 Then CloseHandle(hThread);
hThread := CreateThread(Nil, 0, @OnWaveOutThread, @Self, 0, m_dwThreadID);
If hThread = 0 Then Exit;
End;
m_pReader.Start(cnsStart, 0, 1.0, Nil);
End;

Procedure TWMAudio.Play;
Begin
If Not FActive Then Exit;
Start(0);
End;

Procedure TWMAudio.Pause;
Begin
If Not FActive Then Exit;
If m_pReader = Nil Then Exit;
If m_hWaveOut <> 0 Then
Begin
If waveOutPause(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
m_pReader.Pause;
SetStatus(WM_PAUSED);
End;
End;

Procedure TWMAudio.Resume;
Begin
If Not FActive Then Exit;
If m_pReader = Nil Then Exit;
If FStatus <> WM_PAUSED Then Exit;
If m_hWaveOut <> 0 Then
Begin
If waveOutRestart(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
m_pReader.Resume;
SetStatus(WM_STARTED);
End;
End;

Procedure TWMAudio.Stop;
Begin
If Not FActive Then Exit;
If m_pReader = Nil Then Exit;
If (FStatus = WM_STARTED) Or (FStatus = WM_PAUSED) Then
Try
If Failed(m_pReader.Stop) Then
Exit;
Except
Exit;
End;
If m_hWaveOut <> 0 Then
Begin
If waveOutReset(m_hWaveOut) <> MMSYSERR_NOERROR Then Exit;
WaitForEvent(m_hAsyncEvent);
m_hWaveOut := 0;
CloseHandle(hThread);
hThread := 0;
End;
End;

Procedure TWMAudio.AboutBox;
Begin
MessageBox(0, PChar('WMAudio 1.00' + #13#10 + '作者:风铃夜思雨' + #13#10 + '网站:Http://Www.SkyGz.Com'), '关于', MB_ICONINFORMATION);
End;
End.
laihongbo524 2009-05-24
  • 打赏
  • 举报
回复
Procedure TWMAudio.GetHeaderAttrs;
Var
Value: Pbyte;
Begin
//取歌曲标题
GetHeaderAttribute(g_wszWMTitle, Value);
If Value = Nil Then
Ahattr.FTitle := ''
Else
Begin
WideCharToStrVar(PWideChar(Value), Ahattr.FTitle);
FreeMem(Value);
End;

//取艺术家
GetHeaderAttribute(g_wszWMAuthor, Value);
If Value = Nil Then
Ahattr.FAuthor := ''
Else
Begin
WideCharToStrVar(PWideChar(Value), Ahattr.FAuthor);
FreeMem(Value);
End;

//取版权
GetHeaderAttribute(g_wszWMCopyright, Value);
If Value = Nil Then
Ahattr.FCopyright := ''
Else
Begin
WideCharToStrVar(PWideChar(Value), Ahattr.FCopyright);
FreeMem(Value);
End;
{$IFDEF BYCOPYRIGHT}
Ahattr.FCopyright = ByCopyRight;
{$ENDIF}

//取注释
GetHeaderAttribute(g_wszWMDescription, Value);
If Value = Nil Then
Ahattr.FDescription := ''
Else
Begin
WideCharToStrVar(PWideChar(Value), Ahattr.FDescription);
FreeMem(Value);
End;

//取长度
GetHeaderAttribute(g_wszWMDuration, Value);
If Value = Nil Then
Ahattr.FDuration := 0
Else
Begin
Ahattr.FDuration := Int64(PPointerArray(Value)[0]);
FreeMem(Value);
End;
SetTime(0, Ahattr.FDuration);

//是否允许快进
GetHeaderAttribute(g_wszWMSeekable, Value);
If Value = Nil Then
Ahattr.FSeekable := false
Else
Begin
Ahattr.FSeekable := Boolean(PPointerArray(Value)[0]);
FreeMem(Value);
End;

// GetHeaderAttribute(g_wszWMBroadcast, Value);
// If Value = Nil Then
// m_bIsBroadcast := FALSE
// Else
// Begin
// m_bIsBroadcast := Boolean(Value);
// FreeMem(Value);
// End;
End;

Procedure TWMAudio.GetHeaderAttribute(Name: WideString; Var Value: Pbyte);
Var
StreamNum: Word;
wmtType: WMT_ATTR_DATATYPE;
Len: Word;
hr: HRESULT;
v: Pbyte;
Begin
If m_pHeaderInfo = Nil Then Exit;
StreamNum := 0;
Len := 0;
Value := Nil;
hr := m_pHeaderInfo.GetAttributeByName(StreamNum, PWideChar(Name), wmtType, Nil, Len);
If Failed(hr) Then Exit;
If hr = ASF_E_NOTFOUND Then Exit;
GetMem(v, Len);
If v = Nil Then Exit;
hr := m_pHeaderInfo.GetAttributeByName(StreamNum, PWideChar(Name), wmtType, v, Len);
If Failed(hr) Then Exit;
Value := v;
End;

Function TWMAudio.GetIStream(Stream: TStream): IStream;
Var
Adapt: TStreamAdapter;
tPos: Int64;
Begin
Adapt := TStreamAdapter.Create(FStream);
Adapt.Seek(0, 0, tPos);
Result := Adapt As IStream;
End;

Procedure TWMAudio.SetTime(TimeElapsed, FileDuration: Int64);
Function GetTimeText(Value: Int64): String;
Var
dwSeconds, nHours, nMins: Word;
Begin
dwSeconds := 0;
nHours := 0;
nMins := 0;
dwSeconds := Value Div 10000000;
nHours := dwSeconds Div 60 Div 60;
dwSeconds := dwSeconds Mod 3600;
nMins := dwSeconds Div 60;
dwSeconds := dwSeconds Mod 60;
If nHours <> 0 Then
Result := Format('%d:', [nHours]);
Result := Result + Format('%.2d:%.2d', [nMins, dwSeconds]);
End;

Var
ElapsedText, RemainingText, DurationText: String;
Begin
FPosition := TimeElapsed;
Ahattr.FDuration := FileDuration;
{$IFDEF TRIAL}
If TimeElapsed >= (FileDuration Div 2) Then
Begin

End;
{$ENDIF}
If Not Assigned(FOnPositionChange) Then Exit;

ElapsedText := GetTimeText(TimeElapsed);
RemainingText := GetTimeText(FileDuration - TimeElapsed);
DurationText := GetTimeText(FileDuration);
//If TimeElapsed = FileDuration Then Stop;
FOnPositionChange(Self, TimeElapsed, FileDuration, ElapsedText, RemainingText, DurationText);
End;

Constructor TWMAudio.Create;
Begin
Inherited Create;
m_hAsyncEvent := INVALID_HANDLE_VALUE;
m_hrAsync := S_OK;
m_pReader := Nil;
m_pReader2 := Nil;
m_pWfx := Nil;
m_hWaveOut := 0;
m_dwThreadID := 0;
hThread := 0;
m_dwAudioOutputNum := $FFFFFFFF;
Ahattr := TAudioHeaderAttribute.Create;
Ahattr.FDuration := 0;
FPosition := 0;
FStream := Nil;
FStatusText := '';
End;

Destructor TWMAudio.Destroy;
Begin
SetActive(false);
Ahattr.Free;
Inherited;
End;

Procedure TWMAudio.SetActive(Value: Boolean);
Begin
If FActive = Value Then Exit;
Case Value Of
true:
Begin
m_hAsyncEvent := CreateEvent(Nil, false, false, Nil);
If m_hAsyncEvent = INVALID_HANDLE_VALUE Then
Begin
//'Could not create the event';
Exit;
End;
If Failed(WMCreateReader(Nil, WMT_RIGHT_PLAYBACK, m_pReader)) Then
Begin
//'Could not create Reader';
Exit;
End;
If Failed(m_pReader.QueryInterface(IID_IWMReaderAdvanced2, m_pReader2)) Then
Begin
//'Could not QI for IWMReaderAdvanced2';
Exit;
End;
If Failed(m_pReader.QueryInterface(IID_IWMHeaderInfo, m_pHeaderInfo)) Then
Begin
//'Could not QI for IWMHeaderInfo';
Exit;
End;
FActive := true;
End;
false:
Begin
Close;
m_pHeaderInfo := Nil;
m_pReader2 := Nil;
m_pReader := Nil;
If hThread <> 0 Then
Begin
CloseHandle(hThread);
hThread := 0;
End;
If m_hWaveOut <> 0 Then
Begin
waveOutClose(m_hWaveOut);
m_hWaveOut := 0;
End;
If m_hAsyncEvent <> 0 Then
Begin
CloseHandle(m_hAsyncEvent);
m_hAsyncEvent := 0;
End;
If m_pWfx <> Nil Then
Begin
FreeMem(m_pWfx);
m_pWfx := Nil;
End;
If FStream <> Nil Then
FreeAndNil(FStream);
FActive := false;
End;
End;

End;

laihongbo524 2009-05-24
  • 打赏
  • 举报
回复
接着上

{$IFDEF TRIAL}
{$DEFINE BYCOPYRIGHT}
{$ENDIF}

{$IFDEF BYCOPYRIGHT}
Const
ByCopyRight = 'BY WWW.SKYGZ.COM';
{$ENDIF}

Function TWMAudio.QueryInterface(Const IID: TGUID;
Out Obj): Integer;
Begin
If GetInterface(IID, Obj) Then Result := S_OK
Else Result := E_NOINTERFACE;
End;

Function TWMAudio._AddRef: Integer;
Begin
Inc(FRefCount);
Result := FRefCount;
End;

Function TWMAudio._Release: Integer;
Begin
Dec(FRefCount);
Result := FRefCount;
End;

Function TWMAudio.OnSample(dwOutputNum: LongWord; cnsSampleTime, cnsSampleDuration: Int64;
dwFlags: LongWord; pSample: INSSBuffer; pvContext: Pointer): HRESULT;
Var
hr: HRESULT;
mmr: MMRESULT;
cbData: LongWord;
pData: Pbyte;
m_pWh: PWaveHdr;
Begin
If m_dwAudioOutputNum <> dwOutputNum Then
Begin
Result := S_OK;
Exit;
End;
hr := S_OK;
cbData := 0;
pData := Nil;
hr := pSample.GetBufferAndLength(pData, cbData);
If Failed(hr) Then
Begin
Result := hr;
Exit;
End;
GetMem(m_pWh, SizeOf(WAVEHDR) + cbData);
GetMem(m_pWh^.lpData, cbData);
m_pWh^.dwBufferLength := cbData;
m_pWh^.dwBytesRecorded := cbData;
m_pWh^.dwUser := cnsSampleTime;
m_pWh^.dwLoops := 0;
m_pWh^.dwFlags := 0;
m_pWh^.lpNext := Nil;
m_pWh^.reserved := 0;
CopyMemory(m_pWh^.lpData, pData, cbData);

While true Do
Begin
mmr := waveOutPrepareHeader(m_hWaveOut, m_pWh, SizeOf(WAVEHDR));
If mmr <> MMSYSERR_NOERROR Then Break;
hr := waveOutWrite(m_hWaveOut, m_pWh, SizeOf(WAVEHDR));
If hr <> MMSYSERR_NOERROR Then Break;
SetTime(cnsSampleTime, Ahattr.FDuration);
End;

pData := Nil;
If mmr <> MMSYSERR_NOERROR Then
Begin
Try
If m_pWh <> Nil Then
Begin
FreeMem(m_pWh^.lpData);
FreeMem(m_pWh);
m_pWh := Nil;
End;
Except
End;
Stop;
End;
Result := S_OK;
End;

Function TWMAudio.OnStatus(Status: TWMTStatus; hr: HRESULT; dwType: TWMTAttrDataType;
pValue: Pbyte; pvContext: Pointer): HRESULT;
Begin
Case Status Of
WMT_ERROR:
Begin
SetStatus(WM_ERROR);
SetAsyncEvent(hr);
End;
WMT_OPENED: {打开}
Begin
SetStatus(WM_OPENED);
SetAsyncEvent(0);
End;
WMT_STARTED: SetStatus(WM_STARTED); {播放}
WMT_CLOSED: {关闭}
Begin
SetStatus(WM_CLOSED);
SetAsyncEvent(0);
End;
WMT_STOPPED: {停止}
Begin
SetStatus(WM_STOPED);
SetAsyncEvent(0);
End;

WMT_ACQUIRE_LICENSE: SetStatus(WM_ACQUIRE_LICENSE);
WMT_INDIVIDUALIZE: SetStatus(WM_INDIVIDUALIZE);
WMT_SOURCE_SWITCH: SetStatus(WM_SOURCE_SWITCH);
WMT_MISSING_CODEC: SetStatus(WM_MISSING_CODEC);
WMT_BUFFERING_START: SetStatus(WM_BUFFERING_START);
WMT_BUFFERING_STOP: SetStatus(WM_BUFFERING_STOP);
WMT_SAVEAS_START: SetStatus(WM_SAVEAS_START);
WMT_SAVEAS_STOP: SetStatus(WM_SAVEAS_STOP);
WMT_LOCATING: SetStatus(WM_LOCATING);
WMT_CONNECTING: SetStatus(WM_CONNECTING);
WMT_END_OF_FILE:
Begin
SetStatus(WM_END_OF_FILE);
SetAsyncEvent(0);
Stop;
SetTime(Ahattr.FDuration, Ahattr.Duration);
SetStatus(WM_STOPED);
End;
WMT_END_OF_SEGMENT: SetStatus(WM_END_OF_SEGMENT);
WMT_END_OF_STREAMING:
Begin
SetStatus(WM_END_OF_STREAMING);
SetAsyncEvent(0);
End;
WMT_NEEDS_INDIVIDUALIZATION: SetStatus(WM_NEEDS_INDIVIDUALIZATION);
WMT_NO_RIGHTS: SetStatus(WM_NO_RIGHTS);
WMT_NO_RIGHTS_EX: SetStatus(WM_NO_RIGHTS_EX);
WMT_NEW_METADATA: SetStatus(WM_NEW_METADATA);
WMT_NEW_SOURCEFLAGS: SetStatus(WM_NEW_SOURCEFLAGS);
End;
Result := S_OK;
End;

Procedure TWMAudio.SetStatus(Status: TWM_Status);
Begin
FStatus := Status;
FStatusText := WM_StatusText[FStatus];
If Not Assigned(FOnStatus) Then Exit;
FOnStatus(Self, Status, FStatusText);
End;

Procedure WaveProc(hwo: HWAVEOUT; uMsg: Uint; DwInstance, DwParam1, DwParam2: DWORD); Stdcall;
Var
P: Pointer;
Begin
P := Pointer(DwInstance);
PostThreadMessage(TWMAudio(P).m_dwThreadID, uMsg, DwParam1, DwParam2);
End;

Function OnWaveOutThread(lpParameter: Pointer): LongInt; Stdcall;
Begin
TWMAudio(lpParameter).OnWaveOutMsg;
Result := 0;
End;

Procedure TWMAudio.OnWaveOutMsg;
Var
Msg: TMsg;
pwh: PWaveHdr;
mmr: MMRESULT;
Begin
pwh := Nil;
mmr := MMSYSERR_NOERROR;
PeekMessage(Msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
While GetMessage(Msg, 0, 0, 0) Do
Begin
Case Msg.message Of
MM_WOM_DONE:
Begin
pwh := PWaveHdr(Msg.wParam);
mmr := waveOutUnprepareHeader(m_hWaveOut, pwh, SizeOf(TWaveHdr));
Try
FreeMem(pwh^.lpData);
FreeMem(pwh);
pwh := Nil;
Except
End;
If mmr = MMSYSERR_NOERROR Then
Else If mmr = WHDR_ENDLOOP Then
SetEvent(m_hAsyncEvent)
//Else If mmr = MMSYSERR_INVALHANDLE Then
// SetEvent(m_hAsyncEvent)
//Else Stop;
End;
WOM_CLOSE: PostQuitMessage(0);
End;
End;
End;

Procedure TWMAudio.SetAsyncEvent(hrAsync: HRESULT);
Begin
m_hrAsync := hrAsync;
SetEvent(m_hAsyncEvent);
End;

Procedure TWMAudio.WaitForEvent(hEvent: THandle; Const msMaxWaitTime: DWORD);
Var
i: DWORD;
Msg: TMsg;
Begin
i := 0;
While i < msMaxWaitTime Do
Begin
If PeekMessage(Msg, 0, 0, 0, PM_REMOVE) Then
Begin
TranslateMessage(Msg);
DispatchMessage(Msg);
End;
If WaitForSingleObject(hEvent, 10) <> WAIT_TIMEOUT Then Break;
Inc(i, 10);
End;
End;

Function TWMAudio.GetAudioOutput: Boolean;
Var
cOutputs, cbType, i: LongWord;
pMediaType: PWMMediaType;
pProps: IWMOutputMediaProps;
Begin
Result := false;
cOutputs := 0;
cbType := 0;
pMediaType := Nil;
If m_pReader = Nil Then Exit;
If Failed(m_pReader.GetOutputCount(cOutputs)) Then
Begin
//'Could not get output count';
Exit;
End;

For i := 0 To cOutputs - 1 Do
Begin
pProps := Nil;
If pMediaType <> Nil Then
Begin
FreeMem(pMediaType);
pMediaType := Nil;
End;

If Failed(m_pReader.GetOutputProps(i, pProps)) Then
Begin
//'Could not get output props';
Exit;
End;
If Failed(pProps.GetMediaType(Nil, cbType)) Then
Begin
//'Could not query for the space needed for media type';
pProps := Nil;
Exit;
End;
GetMem(pMediaType, cbType);
If Failed(pProps.GetMediaType(pMediaType, cbType)) Then
Begin
//'Could not get media type';
pProps := Nil;
Exit;
End;
If IsEqualGUID(pMediaType^.majortype, WMMEDIATYPE_Audio) Then
Break;
End;

If cOutputs = i Then
Begin
//'Could not find an audio stream in the specified file';
Exit;
End;
m_dwAudioOutputNum := i;
If m_pWfx <> Nil Then
Begin
FreeMem(m_pWfx);
m_pWfx := Nil;
End;
GetMem(m_pWfx, pMediaType^.cbFormat);
CopyMemory(m_pWfx, pMediaType^.pbFormat, pMediaType^.cbFormat);

If pMediaType <> Nil Then
Begin
FreeMem(pMediaType);
pMediaType := Nil;
End;
pProps := Nil;
Result := true;
End;


laihongbo524 2009-05-24
  • 打赏
  • 举报
回复
我贴给你吧
支持mp3,wma,wav等等...,没有对其它音频测试
引用了WMF9.pas单元,该单元可从 DSPack 或 DirectX的pas版 取得

Unit WMAudio;
{.$DEFINE TRIAL}

Interface

Uses
SysUtils, Windows, Messages, Classes, WMF9, MMSystem, ActiveX

{TWMTRackBar}
{,Controls, ComCtrls};

Type
WM_Status = (WM_ERROR, WM_OPENING, WM_OPENED, WM_STARTED, WM_PAUSED, WM_STOPED, WM_CLOSED,
WM_BUFFERING_START, WM_BUFFERING_STOP, WM_END_OF_FILE, WM_END_OF_SEGMENT, WM_END_OF_STREAMING,
WM_SAVEAS_START, WM_SAVEAS_STOP, WM_LOCATING, WM_CONNECTING, WM_NO_RIGHTS, WM_NO_RIGHTS_EX,
WM_NEEDS_INDIVIDUALIZATION, WM_MISSING_CODEC, WM_ACQUIRE_LICENSE, WM_INDIVIDUALIZE,
WM_NEW_METADATA, WM_NEW_SOURCEFLAGS, WM_SOURCE_SWITCH);
TWM_Status = WM_Status;

Const
WM_StatusText: Array[TWM_Status] Of String = (
'An error occurred in reading the file.',
'The file has been opening for reading.',
'The file has been opened for reading.',
'The reader has started reading the file.',
'The reader has paused reading the file.',
'The reader has stoped reading the file.',
'The reader has closed the file.',
'The reader has started buffering data.',
'The reader has stoped buffering data.',
'The reader has reached the end of the file.',
'The end of a segment has been encountered.',
'The file has finished streaming.',
'The reader object has begun saving a file from a server.',
'The reader has stopped saving a file from a server.',
'The reader is locating a server.',
'The reader is connecting to a server.',
'The reader has tried to play back DRM version 1 content and the computer does not have an appropriate license to play it.',
'The reader has tried to play back DRM version 7 content and the computer does not have an appropriate license to play it.',
'The client needs a security update.',
'The reader does not have the appropriate codec to decompress this file.',
'The license acquisition process is complete.',
'The individualization process is in progress or has completed.',
'The metadata has changed for the current source.',
'There has been a change to the settings for the current source.',
'There has been a change in source file or stream.');

Type
TOnPositionChange = Procedure(Sender: TObject; lPos, lLen: Int64; ElapsedText, RemainingText, DurationText: String) Of Object;
TOnStatus = Procedure(Sender: TObject; Status: TWM_Status; StatusText: String) Of Object;

TAudioHeaderAttribute = Class(TPersistent)
Private
FDuration: Int64; //文件总长度
FTitle: String; //文件标题
FAuthor: String; //艺术家
FCopyright: String; //版权
FDescription: String; //注释
FSeekable: Boolean; //是否允许快进
Published
Property Duration: Int64 Read FDuration;
Property Title: String Read FTitle;
Property Author: String Read FAuthor;
Property Copyright: String Read FCopyright;
Property Description: String Read FDescription;
Property Seekable: Boolean Read FSeekable;
End;

TWMAudio = Class(TObject, IWMReaderCallback)
Private
FActive: Boolean;
m_hAsyncEvent: THandle;
m_hrAsync: HRESULT;
m_pReader: IWMReader;
m_pReader2: IWMReaderAdvanced2;
m_pHeaderInfo: IWMHeaderInfo;
m_hWaveOut: HWAVEOUT;
m_pWfx: PWaveFormatEx;
m_dwThreadID: DWORD; //线程ID
hThread: THandle; //线程句柄
m_dwAudioOutputNum: LongWord;
FStream: TMemoryStream;
Ahattr: TAudioHeaderAttribute;

FStatus: TWM_Status; //当前状态
FStatusText: String;
FPosition: Int64; //当前播放位置

FOnPositionChange: TOnPositionChange;
FOnStatus: TOnStatus;
Procedure SetActive(Value: Boolean);
Procedure SetPosition(Value: Int64);

Procedure SetStatus(Status: TWM_Status);
Procedure OnWaveOutMsg;
Procedure SetAsyncEvent(hrAsync: HRESULT);
Procedure WaitForEvent(hEvent: THandle; Const msMaxWaitTime: DWORD = INFINITE);
Function GetAudioOutput: Boolean;
Procedure GetHeaderAttrs;
Procedure GetHeaderAttribute(Name: WideString; Var Value: Pbyte);
Function GetIStream(Stream: TStream): IStream;
Procedure SetTime(TimeElapsed, FileDuration: Int64);
Procedure Start(Const cnsStart: Int64 = 0);
Protected
FRefCount: Integer;
//定义COM 接口中一个 IUnknown
Function QueryInterface(Const IID: TGUID; Out Obj): Integer; Stdcall;
Function _AddRef: Integer; Stdcall;
Function _Release: Integer; Stdcall;
Function OnSample(dwOutputNum: LongWord; cnsSampleTime, cnsSampleDuration: Int64;
dwFlags: LongWord; pSample: INSSBuffer; pvContext: Pointer): HRESULT; Stdcall;
Function OnStatus(Status: TWMTStatus; hr: HRESULT; dwType: TWMTAttrDataType;
pValue: Pbyte; pvContext: Pointer): HRESULT; Stdcall;
Public
Constructor Create;
Destructor Destroy; Override;
Procedure LoadFromFile(FileName: String);
Procedure LoadFromURL(URL: String);
Procedure LoadFromStream(Stream: TStream);
Procedure LoadFromResourceName(Instance: THandle; Const ResName: String; ResType: PChar);
Procedure LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: PChar);
Procedure Open(FileName: String);
Procedure Close;
Procedure Play;
Procedure Pause;
Procedure Resume;
Procedure Stop;
Procedure AboutBox;
Published

Property Active: Boolean Read FActive Write SetActive;
Property Status: TWM_Status Read FStatus;
Property StatusText: String Read FStatusText;
Property Position: Int64 Read FPosition Write SetPosition;
Property AudioHeaderAttrib: TAudioHeaderAttribute Read Ahattr;

Property OnPositionChange: TOnPositionChange Read FOnPositionChange Write FOnPositionChange;
Property OnStatusInfo: TOnStatus Read FOnStatus Write FOnStatus;
End;

Implementation
日总是我哥 2009-05-24
  • 打赏
  • 举报
回复
5.11日最后回复的帖子,竟然还出现在第1页~~~人气啊,简直就是气人
日总是我哥 2009-05-24
  • 打赏
  • 举报
回复
使用DirectShow,
Delphi有DSPack包,

具体做法参见DSPACK234\Demos\D6-D7\Filters\Async
这是一个soure filter, 可以自己修改一下代码,从Stream中读取。
加载更多回复(10)

1,185

社区成员

发帖
与我相关
我的任务
社区描述
Delphi GAME,图形处理/多媒体
社区管理员
  • GAME,图形处理/多媒体社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧