将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

解决方案 »

  1.   

    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.
      

  2.   

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