对象实现IWMReaderCallback就调用不到Destroy了

[SilentVoidCan]

将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;

[SilentVoidCan]

function TAudioPlay.OpenUrl(url: string): Boolean; 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.

[SilentVoidCan]

算了，撤了，看看csdn论坛delphi这人气啊。