将windows media format的音频播放器例子改成了delphi版本,结果,实现到一半,第一次可以播放,第二次就不行了,同时发现对象释放不了了(调用不了Destroy)
跟踪了一下,发现在OnStatus函数中接收到状态为WMT_CLOSED时,就直接跳转到了Destroy函数,怪了,怎么会这么乱。Destroy函数的入口地址怎么跑那里去了!!!
大神们,有知道怎么回事吗?难道要我改用VC?
环境是win7+dxe2
unit AudioPlay;
interface
uses System.Sharemem,System.Classes,System.SysUtils,Winapi.WMF9,Winapi.MMSystem,
Winapi.Windows,Winapi.Messages;
type
PQWORD=^QWORD;
QWORD=UInt64;
RFileAttributes=record
Title:string;
Author:string;
CopyRight:string;
end;
TAudioPlay=class(TInterfacedObject,IWMReaderCallback)
private
FIsClosed:Boolean;
FIsSeekable:Boolean;
FIsBroadcast:Boolean;
FIsEof:Boolean;
FThreadId:DWORD;
FAudioOutputNum:DWORD;
FAsyncEvent:THandle;
FAsync:HRESULT;
FWaveOut:HWAVEOUT;
FReader:IWMReader;
FHeaderInfo:IWMHeaderInfo;
FHeadersLeft:LONG;
FFileUrl:string;
FFileDuration:QWORD;
FWfx:PWaveFormatEx;
FFileAttributes:RFileAttributes;
public
constructor Create;
destructor Destroy;override;
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; procedure CheckRet(hRet:HRESULT;strExcept:string);overload;
procedure CheckRet(hRet:Boolean;strExcept:string);overload;
procedure CheckRet(hRet:HRESULT);overload;
procedure CheckRet(hRet:Boolean);overload;
procedure MsgBox(msg:string);
procedure WaitForEvent(hEvent:THandle;maxWaitTime:DWORD=INFINITE);
procedure RetrieveAndDisplayAttributes;
function GetHeaderAttribute(name:string):PByte;
procedure GetAudioOutput; function InitObj:Boolean;
procedure UninitObj;
function OpenUrl(url:string):Boolean;
procedure CloseRec;
procedure SetAsyncEvent(h:HRESULT); //控制函数
procedure Start(cnsStart:QWORD=0);
procedure Stop;
procedure Pause;
procedure Resume; procedure OnWaveOutMsg; property IsSeekable:Boolean read FIsSeekable;
property IsBroadcast:Boolean read FIsBroadcast;
property FileDuration:QWORD read FFileDuration;
property FileAttributes:RFileAttributes read FFileAttributes;
property ThreadId:DWORD read FThreadId;
end;implementation
uses Winapi.ActiveX;procedure WaveProc(
hwo:HWAVEOUT;
uMsg:UINT;
dwInstance:DWORD_PTR;
dwParam1:DWORD;
dwParam2:DWORD );stdcall;
var
aPlay:TAudioPlay;
begin
aPlay:=TAudioPlay(dwInstance);
PostThreadMessage(aPlay.ThreadId,uMsg,dwParam1,dwParam2);
end; function OnWaveOutThread(lpParameter:Pointer):DWORD;stdcall;
var
aPlay:TAudioPlay;
begin
aPlay:=TAudioPlay(lpParameter);
aPlay.OnWaveOutMsg;
Result:=0;
end;{ TAudioPlay }procedure TAudioPlay.CheckRet(hRet: HRESULT; strExcept: string);
begin
if Failed(hRet) then raise Exception.Create(strExcept);
end;procedure TAudioPlay.CheckRet(hRet: HRESULT);
begin
if Failed(hRet) then raise Exception.Create(SysErrorMessage(GetLastError));
end;procedure TAudioPlay.CheckRet(hRet: Boolean);
begin
if not hRet then raise Exception.Create(SysErrorMessage(GetLastError));
end;procedure TAudioPlay.CloseRec;
begin
if FReader<>nil then
begin
//The Close method deletes all outputs on the reader and releases the file resources
if Failed(FReader.Close) then Exit;//这里会报错!!!,具体问题出在OnStatus中
//FReader.Close;
end;
WaitForEvent(FAsyncEvent);
if FWaveOut<>0 then
begin
if waveOutReset(FWaveOut)<>MMSYSERR_NOERROR then Exit;
if waveOutClose(FWaveOut)<>MMSYSERR_NOERROR then Exit;
end;
end;procedure TAudioPlay.CheckRet(hRet: Boolean; strExcept: string);
begin
if not hRet then raise Exception.Create(strExcept);
end;constructor TAudioPlay.Create;
begin
FIsClosed:=True;
FIsSeekable:=False;
FIsBroadcast:=False;
FIsEof:=False;
FAudioOutputNum:=$FFFFFFFF;
FThreadId:=0;
FAsyncEvent:=0;
FAsync:=S_OK;
FWaveOut:=0;
FReader:=nil;
FHeaderInfo:=nil;
FHeadersLeft:=0;
FFileUrl:='';
FFileDuration:=0;
FWfx:=nil;
end;destructor TAudioPlay.Destroy;
begin
UninitObj;
CoUninitialize;
inherited;
end;procedure TAudioPlay.GetAudioOutput;
var
outputCount,i,cbType:DWORD;
props:IWMOutputMediaProps;
typ:PWMMediaType;
begin
if FReader=nil then Exit;
CheckRet(FReader.GetOutputCount(outputCount),'无法得到输出通道数目!');
for i := 0 to outputCount-1 do
begin
props:=nil;
FreeMem(typ);
CheckRet(FReader.GetOutputProps(i,props),'无法获取输出通道属性!');
CheckRet(props.GetMediaType(nil,cbType),'无法获取输出通道媒体类型需要分配字节数!');
GetMem(typ,SizeOf(WM_MEDIA_TYPE)* cbType);
CheckRet(typ<>nil,'内存分配错误!');
CheckRet(props.GetMediaType(typ,cbType),'无法获取输出通道媒体类型!');
if typ^.majortype=WMMEDIATYPE_Audio then
begin
Break;
end;
end;
if i=outputCount then
raise Exception.Create('找不到音频输出通道!');
FAudioOutputNum:=i;
if FWfx<>nil then FreeMem(FWfx);
GetMem(FWfx,SizeOf(typ.cbFormat));//PWaveFormatEx
CheckRet(FWfx<>nil,'内存分配错误!');
CopyMemory(FWfx,typ.pbFormat,typ.cbFormat);
FreeMem(typ);
props:=nil;
end;function TAudioPlay.GetHeaderAttribute(name: string): PByte;
var
wmtType:WMT_ATTR_DATATYPE;
sNum,dataLen:Word;
begin
Result:=nil;
if FHeaderInfo=nil then Exit;
sNum:=0;
if Succeeded(FHeaderInfo.GetAttributeByName(sNum,PChar(name),wmtType,nil,dataLen)) then
begin
GetMem(Result,dataLen);
if Succeeded(FHeaderInfo.GetAttributeByName(sNum,PChar(name),wmtType,Result,dataLen)) then
begin end else//否则释放掉资源
begin
FreeMem(Result);
Result:=nil;
end;
end;
end;procedure TAudioPlay.UninitObj;
begin
FHeaderInfo:=nil;
FReader:=nil;
if FWaveOut<>0 then
begin
waveOutClose(FWaveOut);
FWaveOut:=0;
end;
if FAsyncEvent<>0 then
begin
CloseHandle(FAsyncEvent);
FAsyncEvent:=0;
end;
FFileUrl:='';
if FWfx<>nil then
begin
FreeMem(FWfx);//释放内存
FWfx:=nil;
end;
end;procedure TAudioPlay.WaitForEvent(hEvent: THandle; maxWaitTime: DWORD);
var
i:DWORD;
msg:tagMSG;
begin
i:=0;
while i<maxWaitTime do
begin
if PeekMessage(msg,0,0,0,PM_REMOVE) then
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
if WAIT_TIMEOUT<>WaitForSingleObject(hEvent,10) then
begin
Break;
end;
Inc(i,10);
end;
end;function TAudioPlay.InitObj:Boolean;
begin
Result:=False;
try
CheckRet(CoInitialize(nil),'COM初始化失败!');
FAsyncEvent:=CreateEvent(nil,False,False,nil);
CheckRet(FAsyncEvent<>0,'创建事件失败!');
CheckRet(WMCreateReader(nil,WMT_RIGHT_PLAYBACK,FReader),'创建Reader失败!');
Result:=True;
except
on ex:Exception do
begin
MsgBox(ex.Message);
UninitObj;
end;
end;
end;procedure TAudioPlay.MsgBox(msg: string);
begin
MessageBox(0,PChar(msg),'系统提示',MB_OK);
end;function TAudioPlay.OnSample(dwOutputNum: LongWord; cnsSampleTime,
cnsSampleDuration: Int64; dwFlags: LongWord; pSample: INSSBuffer;
pvContext: Pointer): HRESULT;
var
pData:PByte;
dataLen:DWORD;
pwh,p:PWaveHdr;
mmr:MMRESULT;
hr:HRESULT;
begin
Result:=S_OK;
if dwOutputNum<>FAudioOutputNum then Exit; //仅仅输出第一通道,其他通道数据不处理
hr:=pSample.GetBufferAndLength(pData,dataLen);
if Failed(hr) then
begin
Result:=hr;
Exit;
end;
GetMem(pwh,SizeOf(WAVEHDR)+dataLen);
if pwh=nil then
begin
Result:=GetLastError;
Exit;
end;
p:=pwh;
Inc(p);
pwh.lpData:=PAnsiChar(p);
pwh.dwBufferLength:=dataLen;
pwh.dwBytesRecorded:=dataLen;
pwh.dwUser:=DWORD(cnsSampleTime);
pwh.dwLoops:=0;
pwh.dwFlags:=0;
CopyMemory(pwh.lpData,pData,dataLen);
repeat
mmr:=waveOutPrepareHeader(FWaveOut,pwh,SizeOf(WAVEHDR));
if mmr<>MMSYSERR_NOERROR then Break;
hr:=waveOutWrite(FWaveOut,pwh,SizeOf(WAVEHDR));
if hr<>MMSYSERR_NOERROR then Break;
InterlockedIncrement(FHeadersLeft);
until True; if mmr<>MMSYSERR_NOERROR then
begin
FreeMem(pwh);
MsgBox('Wave function failed');
Stop;
end;
end;function TAudioPlay.OnStatus(Status: TWMTStatus; hr: HRESULT;
dwType: TWMTAttrDataType; pValue: PBYTE; pvContext: Pointer): HRESULT;
begin
Result:=S_OK;
case Status of
WMT_ERROR,
WMT_END_OF_FILE,//WMT_EOF
WMT_MISSING_CODEC:
begin
FIsEof:=True;
if FHeadersLeft=0 then
begin
end;
end;
WMT_OPENED:
begin
SetAsyncEvent(hr);
end;
WMT_BUFFERING_START:
begin
end;
WMT_BUFFERING_STOP:
begin
end; WMT_END_OF_SEGMENT: ;
WMT_END_OF_STREAMING: ;
WMT_LOCATING: ;
WMT_CONNECTING: ;
WMT_NO_RIGHTS: ; WMT_STARTED:
begin
FIsEof:=False;
end;
WMT_STOPPED:
begin
SetAsyncEvent(hr);
//停止状态
end;
WMT_CLOSED:
begin
SetAsyncEvent(hr);
{ TODO : 跳转到了Destroy }
end;
WMT_STRIDING:
begin
end;
end;
end;procedure TAudioPlay.OnWaveOutMsg;
var
msg:tagMSG;
pwh:PWaveHdr;
mmr:MMRESULT;
begin
PeekMessage(msg,0,WM_USER,WM_USER,PM_NOREMOVE);
while GetMessage(msg,0,0,0) do
begin
case msg.message of
WOM_DONE:
begin
pwh:=PWaveHdr(msg.wParam);
mmr:=waveOutUnprepareHeader(FWaveOut,pwh,SizeOf(WAVEHDR));
if mmr=MMSYSERR_NOERROR then
begin
InterlockedDecrement(FHeadersLeft);
end else if mmr=WHDR_ENDLOOP then
begin
SetEvent(FAsyncEvent);
end else
begin
Stop;
MsgBox('Wave function (waveOutUnprepareHeader) failed');
end;
if FIsEof and (FHeadersLeft=0) then
begin
end;
end;
WOM_CLOSE:
begin
PostQuitMessage(0);
end;
end;
end;
end;IWMReaderCallbackwindows media format
跟踪了一下,发现在OnStatus函数中接收到状态为WMT_CLOSED时,就直接跳转到了Destroy函数,怪了,怎么会这么乱。Destroy函数的入口地址怎么跑那里去了!!!
大神们,有知道怎么回事吗?难道要我改用VC?
环境是win7+dxe2
unit AudioPlay;
interface
uses System.Sharemem,System.Classes,System.SysUtils,Winapi.WMF9,Winapi.MMSystem,
Winapi.Windows,Winapi.Messages;
type
PQWORD=^QWORD;
QWORD=UInt64;
RFileAttributes=record
Title:string;
Author:string;
CopyRight:string;
end;
TAudioPlay=class(TInterfacedObject,IWMReaderCallback)
private
FIsClosed:Boolean;
FIsSeekable:Boolean;
FIsBroadcast:Boolean;
FIsEof:Boolean;
FThreadId:DWORD;
FAudioOutputNum:DWORD;
FAsyncEvent:THandle;
FAsync:HRESULT;
FWaveOut:HWAVEOUT;
FReader:IWMReader;
FHeaderInfo:IWMHeaderInfo;
FHeadersLeft:LONG;
FFileUrl:string;
FFileDuration:QWORD;
FWfx:PWaveFormatEx;
FFileAttributes:RFileAttributes;
public
constructor Create;
destructor Destroy;override;
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; procedure CheckRet(hRet:HRESULT;strExcept:string);overload;
procedure CheckRet(hRet:Boolean;strExcept:string);overload;
procedure CheckRet(hRet:HRESULT);overload;
procedure CheckRet(hRet:Boolean);overload;
procedure MsgBox(msg:string);
procedure WaitForEvent(hEvent:THandle;maxWaitTime:DWORD=INFINITE);
procedure RetrieveAndDisplayAttributes;
function GetHeaderAttribute(name:string):PByte;
procedure GetAudioOutput; function InitObj:Boolean;
procedure UninitObj;
function OpenUrl(url:string):Boolean;
procedure CloseRec;
procedure SetAsyncEvent(h:HRESULT); //控制函数
procedure Start(cnsStart:QWORD=0);
procedure Stop;
procedure Pause;
procedure Resume; procedure OnWaveOutMsg; property IsSeekable:Boolean read FIsSeekable;
property IsBroadcast:Boolean read FIsBroadcast;
property FileDuration:QWORD read FFileDuration;
property FileAttributes:RFileAttributes read FFileAttributes;
property ThreadId:DWORD read FThreadId;
end;implementation
uses Winapi.ActiveX;procedure WaveProc(
hwo:HWAVEOUT;
uMsg:UINT;
dwInstance:DWORD_PTR;
dwParam1:DWORD;
dwParam2:DWORD );stdcall;
var
aPlay:TAudioPlay;
begin
aPlay:=TAudioPlay(dwInstance);
PostThreadMessage(aPlay.ThreadId,uMsg,dwParam1,dwParam2);
end; function OnWaveOutThread(lpParameter:Pointer):DWORD;stdcall;
var
aPlay:TAudioPlay;
begin
aPlay:=TAudioPlay(lpParameter);
aPlay.OnWaveOutMsg;
Result:=0;
end;{ TAudioPlay }procedure TAudioPlay.CheckRet(hRet: HRESULT; strExcept: string);
begin
if Failed(hRet) then raise Exception.Create(strExcept);
end;procedure TAudioPlay.CheckRet(hRet: HRESULT);
begin
if Failed(hRet) then raise Exception.Create(SysErrorMessage(GetLastError));
end;procedure TAudioPlay.CheckRet(hRet: Boolean);
begin
if not hRet then raise Exception.Create(SysErrorMessage(GetLastError));
end;procedure TAudioPlay.CloseRec;
begin
if FReader<>nil then
begin
//The Close method deletes all outputs on the reader and releases the file resources
if Failed(FReader.Close) then Exit;//这里会报错!!!,具体问题出在OnStatus中
//FReader.Close;
end;
WaitForEvent(FAsyncEvent);
if FWaveOut<>0 then
begin
if waveOutReset(FWaveOut)<>MMSYSERR_NOERROR then Exit;
if waveOutClose(FWaveOut)<>MMSYSERR_NOERROR then Exit;
end;
end;procedure TAudioPlay.CheckRet(hRet: Boolean; strExcept: string);
begin
if not hRet then raise Exception.Create(strExcept);
end;constructor TAudioPlay.Create;
begin
FIsClosed:=True;
FIsSeekable:=False;
FIsBroadcast:=False;
FIsEof:=False;
FAudioOutputNum:=$FFFFFFFF;
FThreadId:=0;
FAsyncEvent:=0;
FAsync:=S_OK;
FWaveOut:=0;
FReader:=nil;
FHeaderInfo:=nil;
FHeadersLeft:=0;
FFileUrl:='';
FFileDuration:=0;
FWfx:=nil;
end;destructor TAudioPlay.Destroy;
begin
UninitObj;
CoUninitialize;
inherited;
end;procedure TAudioPlay.GetAudioOutput;
var
outputCount,i,cbType:DWORD;
props:IWMOutputMediaProps;
typ:PWMMediaType;
begin
if FReader=nil then Exit;
CheckRet(FReader.GetOutputCount(outputCount),'无法得到输出通道数目!');
for i := 0 to outputCount-1 do
begin
props:=nil;
FreeMem(typ);
CheckRet(FReader.GetOutputProps(i,props),'无法获取输出通道属性!');
CheckRet(props.GetMediaType(nil,cbType),'无法获取输出通道媒体类型需要分配字节数!');
GetMem(typ,SizeOf(WM_MEDIA_TYPE)* cbType);
CheckRet(typ<>nil,'内存分配错误!');
CheckRet(props.GetMediaType(typ,cbType),'无法获取输出通道媒体类型!');
if typ^.majortype=WMMEDIATYPE_Audio then
begin
Break;
end;
end;
if i=outputCount then
raise Exception.Create('找不到音频输出通道!');
FAudioOutputNum:=i;
if FWfx<>nil then FreeMem(FWfx);
GetMem(FWfx,SizeOf(typ.cbFormat));//PWaveFormatEx
CheckRet(FWfx<>nil,'内存分配错误!');
CopyMemory(FWfx,typ.pbFormat,typ.cbFormat);
FreeMem(typ);
props:=nil;
end;function TAudioPlay.GetHeaderAttribute(name: string): PByte;
var
wmtType:WMT_ATTR_DATATYPE;
sNum,dataLen:Word;
begin
Result:=nil;
if FHeaderInfo=nil then Exit;
sNum:=0;
if Succeeded(FHeaderInfo.GetAttributeByName(sNum,PChar(name),wmtType,nil,dataLen)) then
begin
GetMem(Result,dataLen);
if Succeeded(FHeaderInfo.GetAttributeByName(sNum,PChar(name),wmtType,Result,dataLen)) then
begin end else//否则释放掉资源
begin
FreeMem(Result);
Result:=nil;
end;
end;
end;procedure TAudioPlay.UninitObj;
begin
FHeaderInfo:=nil;
FReader:=nil;
if FWaveOut<>0 then
begin
waveOutClose(FWaveOut);
FWaveOut:=0;
end;
if FAsyncEvent<>0 then
begin
CloseHandle(FAsyncEvent);
FAsyncEvent:=0;
end;
FFileUrl:='';
if FWfx<>nil then
begin
FreeMem(FWfx);//释放内存
FWfx:=nil;
end;
end;procedure TAudioPlay.WaitForEvent(hEvent: THandle; maxWaitTime: DWORD);
var
i:DWORD;
msg:tagMSG;
begin
i:=0;
while i<maxWaitTime do
begin
if PeekMessage(msg,0,0,0,PM_REMOVE) then
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
if WAIT_TIMEOUT<>WaitForSingleObject(hEvent,10) then
begin
Break;
end;
Inc(i,10);
end;
end;function TAudioPlay.InitObj:Boolean;
begin
Result:=False;
try
CheckRet(CoInitialize(nil),'COM初始化失败!');
FAsyncEvent:=CreateEvent(nil,False,False,nil);
CheckRet(FAsyncEvent<>0,'创建事件失败!');
CheckRet(WMCreateReader(nil,WMT_RIGHT_PLAYBACK,FReader),'创建Reader失败!');
Result:=True;
except
on ex:Exception do
begin
MsgBox(ex.Message);
UninitObj;
end;
end;
end;procedure TAudioPlay.MsgBox(msg: string);
begin
MessageBox(0,PChar(msg),'系统提示',MB_OK);
end;function TAudioPlay.OnSample(dwOutputNum: LongWord; cnsSampleTime,
cnsSampleDuration: Int64; dwFlags: LongWord; pSample: INSSBuffer;
pvContext: Pointer): HRESULT;
var
pData:PByte;
dataLen:DWORD;
pwh,p:PWaveHdr;
mmr:MMRESULT;
hr:HRESULT;
begin
Result:=S_OK;
if dwOutputNum<>FAudioOutputNum then Exit; //仅仅输出第一通道,其他通道数据不处理
hr:=pSample.GetBufferAndLength(pData,dataLen);
if Failed(hr) then
begin
Result:=hr;
Exit;
end;
GetMem(pwh,SizeOf(WAVEHDR)+dataLen);
if pwh=nil then
begin
Result:=GetLastError;
Exit;
end;
p:=pwh;
Inc(p);
pwh.lpData:=PAnsiChar(p);
pwh.dwBufferLength:=dataLen;
pwh.dwBytesRecorded:=dataLen;
pwh.dwUser:=DWORD(cnsSampleTime);
pwh.dwLoops:=0;
pwh.dwFlags:=0;
CopyMemory(pwh.lpData,pData,dataLen);
repeat
mmr:=waveOutPrepareHeader(FWaveOut,pwh,SizeOf(WAVEHDR));
if mmr<>MMSYSERR_NOERROR then Break;
hr:=waveOutWrite(FWaveOut,pwh,SizeOf(WAVEHDR));
if hr<>MMSYSERR_NOERROR then Break;
InterlockedIncrement(FHeadersLeft);
until True; if mmr<>MMSYSERR_NOERROR then
begin
FreeMem(pwh);
MsgBox('Wave function failed');
Stop;
end;
end;function TAudioPlay.OnStatus(Status: TWMTStatus; hr: HRESULT;
dwType: TWMTAttrDataType; pValue: PBYTE; pvContext: Pointer): HRESULT;
begin
Result:=S_OK;
case Status of
WMT_ERROR,
WMT_END_OF_FILE,//WMT_EOF
WMT_MISSING_CODEC:
begin
FIsEof:=True;
if FHeadersLeft=0 then
begin
end;
end;
WMT_OPENED:
begin
SetAsyncEvent(hr);
end;
WMT_BUFFERING_START:
begin
end;
WMT_BUFFERING_STOP:
begin
end; WMT_END_OF_SEGMENT: ;
WMT_END_OF_STREAMING: ;
WMT_LOCATING: ;
WMT_CONNECTING: ;
WMT_NO_RIGHTS: ; WMT_STARTED:
begin
FIsEof:=False;
end;
WMT_STOPPED:
begin
SetAsyncEvent(hr);
//停止状态
end;
WMT_CLOSED:
begin
SetAsyncEvent(hr);
{ TODO : 跳转到了Destroy }
end;
WMT_STRIDING:
begin
end;
end;
end;procedure TAudioPlay.OnWaveOutMsg;
var
msg:tagMSG;
pwh:PWaveHdr;
mmr:MMRESULT;
begin
PeekMessage(msg,0,WM_USER,WM_USER,PM_NOREMOVE);
while GetMessage(msg,0,0,0) do
begin
case msg.message of
WOM_DONE:
begin
pwh:=PWaveHdr(msg.wParam);
mmr:=waveOutUnprepareHeader(FWaveOut,pwh,SizeOf(WAVEHDR));
if mmr=MMSYSERR_NOERROR then
begin
InterlockedDecrement(FHeadersLeft);
end else if mmr=WHDR_ENDLOOP then
begin
SetEvent(FAsyncEvent);
end else
begin
Stop;
MsgBox('Wave function (waveOutUnprepareHeader) failed');
end;
if FIsEof and (FHeadersLeft=0) then
begin
end;
end;
WOM_CLOSE:
begin
PostQuitMessage(0);
end;
end;
end;
end;IWMReaderCallbackwindows media format
解决方案 »
- Richedit 复制字串时如何保留格式信息?
- Delphi 现在用哪一个版本的比较多啊???
- 如何处理“主键重复”异常?
- IdHTTP如何自动填写用户名和密码登录上网页,把登录之后点的其它链接的内容GET回来?
- 怎么判断winexec执行的命令行是否已经执行完毕?
- 一个调用存储过程中的出错消息,请各位大哥指点迷津!!在线等!高分相送!
- 怎么搜索一个目录里的文件(非可视控件),并且创建写文件(创建时向文件里写行数据)。filewrite为什么写的数据是乱码?
- "c/s" come on!
- delphi中IS语句在C++BUILDER中用何命令代替??
- 如何规范我的代码?谁有DELPHI的快捷键的资料?
- ADOQuery打开突然变慢,出现‘超时已过期’报错,但,把SQL放在查询分析器中执行正常!
- sololie哥,上次写的DEMO,运行一个flash为什么好慢啊
var
hr:HRESULT;
strError:string;
begin
Result:=False;
if (url='') or (FReader=nil) then Exit;
hr:=S_OK;
repeat
ResetEvent(FAsyncEvent);
CloseRec;
FFileUrl:=url;
hr:=FReader.Open(PChar(FFileUrl),Self,nil);
if Failed(hr) then
begin
strError:='无法打开文件!';
Break;
end;
WaitForEvent(FAsyncEvent);
if Failed(FAsync) then
begin
hr:=FAsync;
strError:='无法打开文件!';
Break;
end;
FHeaderInfo:=nil;
hr:=FReader.QueryInterface(IID_IWMHeaderInfo,FHeaderInfo);
if Failed(hr) then
begin
strError:='无法获取文件头信息!';
Break;
end;
RetrieveAndDisplayAttributes();
GetAudioOutput();
Result:=True;
until True;
if Failed(hr) then
begin
CloseRec;
MsgBox(strError);
end;
end;procedure TAudioPlay.Pause;
begin
if FReader=nil then Exit;
if FWaveOut<>0 then
begin
if waveOutPause(FWaveOut)<>MMSYSERR_NOERROR then Exit;
end;
FReader.Pause;
end;procedure TAudioPlay.Resume;
begin
if FReader=nil then Exit;
if FWaveOut<>0 then
begin
if waveOutRestart(FWaveOut)<>MMSYSERR_NOERROR then Exit;
end;
FReader.Resume;
end;procedure TAudioPlay.RetrieveAndDisplayAttributes;
var
pData:PByte;
begin
pData:=GetHeaderAttribute('Title');//Author Copyright
if pData<>nil then
begin
FFileAttributes.Title:=string(pData);
FreeMem(pData);
end else
begin
FFileAttributes.Title:='没有数据';
end;
pData:=GetHeaderAttribute('Author');//Author Copyright
if pData<>nil then
begin
FFileAttributes.Author:=string(pData);
FreeMem(pData);
end else
begin
FFileAttributes.Author:='没有数据';
end;
pData:=GetHeaderAttribute('Copyright');//Author Copyright
if pData<>nil then
begin
FFileAttributes.Copyright:=string(pData);
FreeMem(pData);
end else
begin
FFileAttributes.Copyright:='没有数据';
end;
pData:=GetHeaderAttribute('Duration');
if pData<>nil then
begin
FFileDuration:=PQWORD(pData)^;
FreeMem(pData);//释放数据
end else
begin
FFileDuration:=0;
end; pData:=GetHeaderAttribute('Seekable');
if pData<>nil then
begin
FIsSeekable:=PBOOL(pData)^;
FreeMem(pData);
end else
begin
FIsSeekable:=False;
end; pData:=GetHeaderAttribute('Broadcast');
if pData<>nil then
begin
FIsBroadcast:=PBOOL(pData)^;
FreeMem(pData);
end else
begin
FIsBroadcast:=False;
end;
end;procedure TAudioPlay.SetAsyncEvent(h: HRESULT);
begin
FAsync:=h;
SetEvent(FAsyncEvent);
end;procedure TAudioPlay.Start(cnsStart:QWORD);
var
hThread:THandle;
begin
if FReader=nil then Exit;
if FWaveOut<>0 then
begin
if waveOutReset(FWaveOut)<>MMSYSERR_NOERROR then Exit;
end else
begin
{function waveOutOpen(lphWaveOut: PHWaveOut; uDeviceID: UINT;
lpFormat: PWaveFormatEx; dwCallback, dwInstance: DWORD_PTR; dwFlags: DWORD): MMRESULT; stdcall;}
CheckRet(waveOutOpen(@FWaveOut,WAVE_MAPPER,FWfx,DWORD_PTR(@WaveProc),DWORD_PTR(Self),CALLBACK_FUNCTION)
=MMSYSERR_NOERROR,'waveOutOpen失败!');
hThread:=CreateThread(nil,0,@OnWaveOutThread,Pointer(Self),0,FThreadId);
end;
CheckRet(hThread<>0);
CloseHandle(hThread);
CheckRet(FReader.Start(cnsStart,0,1.0,nil),'Start失败!');
end;procedure TAudioPlay.Stop;
begin
if FReader=nil then Exit;
if Failed(FReader.Stop) then Exit;
if FWaveOut<>0 then
begin
if waveOutReset(FWaveOut)<>MMSYSERR_NOERROR then Exit;
WaitForEvent(FAsyncEvent);
end;
end;end.