原理很简单,就是两条连路,一条正在播放一条准备,播完立刻开始播放下一条连路，这样反复应用.
网络图了简单,用了WMF.
开发的DS,两个接受Filter
unit RenderFilter;
interface
uses
Directshow9, DSUtil, BaseClass, ActiveX, Windows, Log, Sample, PushManager, SysUtils, WMF9;
type
TPlayerVideoRenderFilter = class( TBCBaseRenderer )//视频
private
public
function DoRenderSample(MediaSample: IMediaSample): HResult;override;
function CheckMediaType(MediaType: PAMMediaType): HResult;override;
procedure OnReceiveFirstSample(MediaSample: IMediaSample);override;
end;
TPlayerAudioRenderFilter = class( TBCBaseRenderer )
private
public
function DoRenderSample(MediaSample: IMediaSample): HResult;override;
function CheckMediaType(MediaType: PAMMediaType): HResult;override;
procedure OnReceiveFirstSample(MediaSample: IMediaSample);override;
end;
implementation
{ TPlayerRenderFilter }
function TPlayerVideoRenderFilter.CheckMediaType(
MediaType: PAMMediaType): HResult;
begin
result := E_FAIL;
if IsEqualGUID(MediaType.majortype,MediaType_Video)=false then
exit;
if IsEqualGUID(MediaType.subtype,CommonType.VideoCommonType.SubType)=false then
exit;
if IsEqualGUID(MediaType.formattype,CommonType.VideoCommonType.FormatType)=FALSE then
exit;
result := S_OK;
end;
function TPlayerVideoRenderFilter.DoRenderSample(
MediaSample: IMediaSample): HResult;
var
Len : integer;
Starttime,EndTime : int64;
Des,Src : pbyte;
flags : DWord;
begin
Src := nil;
des := nil;
flags := 0;
Len := MediaSample.GetActualDataLength(); //视频SAMPLE大小是可变的，音频则不是 ,GetSize方法是获得所有大小，而此方法是获得有效数据的大小
PushSampleManager.AllocSample(Len,true);
PushSampleManager.VideoSample.SetLength(Len);
MediaSample.GetPointer(src);
PushSampleManager.VideoSample.GetBuffer(des);
Move(Src^,Des^,Len);
//MediaSample.GetMediaTime(Starttime,Endtime);
MediaSample.GetTime(Starttime,Endtime); //这里才得到了真正的时间戳
if MediaSample.IsSyncPoint=S_OK then
begin
Flags:=Flags or WM_SF_CLEANPOINT;
end;
if MediaSample.IsDiscontinuity=S_OK then
begin
Flags:= Flags or WM_SF_DISCONTINUITY;
end;
//LogFile.Write('Video Start time : '+inttostr(Starttime)+#9#9#9);
PushMgr.WriteBuffer( Starttime,Endtime, flags,true );
result := NOERROR;
end;
procedure TPlayerVideoRenderFilter.OnReceiveFirstSample(
MediaSample: IMediaSample);
begin
end;
{ TPlayerAudioRenderFilter }
function TPlayerAudioRenderFilter.CheckMediaType(
MediaType: PAMMediaType): HResult;
begin
result := E_FAIL;
if IsEqualGUID(MediaType.majortype,MediaType_Audio)=false then
exit;
// Logfile.Write('Common Audio Subtype:'+GuidToString(CommonType.AudioCommonType.SubType)+' Common Audio FormatType:'+GuidToString(CommonType.AudioCommonType.FormatType)+#13#10#13#10);
// Logfile.Write('check : SubType: '+guidtostring(MediaType.subtype)+' FormatType:'+guidtostring(MediaType.formattype));
if IsEqualGUID(MediaType.subtype, CommonType.AudioCommonType.SubType )=false then
exit;
// Logfile.Write('Audio Check Ok!1');
if IsEqualGUID(MediaType.formattype,CommonType.AudioCommonType.FormatType)= false then
exit;
// Logfile.Write('Audio Check Ok!2');
result := S_OK;
end;
function TPlayerAudioRenderFilter.DoRenderSample(
MediaSample: IMediaSample): HResult;
var
Len : integer;
Starttime,EndTime : int64;
Des,Src : pbyte;
flags : DWord;
begin
Src := nil;
des := nil;
flags := 0;
Len := MediaSample.GetActualDataLength(); //视频SAMPLE大小是可变的，音频则不是 ,GetSize方法是获得所有大小，而此方法是获得有效数据的大小
PushSampleManager.AllocSample(Len,false);
PushSampleManager.AudioSample.SetLength(Len);
MediaSample.GetPointer(src);
PushSampleManager.AudioSample.GetBuffer(des);
Move(Src^,Des^,Len);
//MediaSample.GetMediaTime(Starttime,Endtime);
MediaSample.GetTime(Starttime,Endtime);//这才能得到真正的时间戳
if MediaSample.IsSyncPoint=S_OK then
begin
Flags:=Flags or WM_SF_CLEANPOINT;
end;
if MediaSample.IsDiscontinuity=S_OK then
begin
Flags:= Flags or WM_SF_DISCONTINUITY;
end;
//LogFile.Write('Audio Start time : '+inttostr(Starttime)+' End time : '+inttostr(Endtime));
PushMgr.WriteBuffer( Starttime,Endtime ,flags,false );
result := NOERROR;
end;
procedure TPlayerAudioRenderFilter.OnReceiveFirstSample(
MediaSample: IMediaSample);
begin
end;
end.
unit Sample; //自己写的Sample类，用来实现从Directshow传递数据给生成器 ,Sample由Sample管理器来管理
interface
uses
WMF9, DSUtil, SysUtils, Log, DirectShow9;
type
TCommonType = packed Record
SubType : TGUID;
FormatType : TGUID;
end;
TMediaCommonType = packed Record
VideoCommonType : TCommonType;
AudioCommonType : TCommonType;
end;
TPushSample = class(TInterfacedObject, INSSBuffer)
Private
Length : LongWord;//SAMPLE中有效数据大小
MaxLength : LongWord;
Buffer : PByte;
public
//从接口继承过来的方法
function GetLength(out pdwLength: LongWord): HRESULT; stdcall;
function SetLength(dwLength: LongWord): HRESULT; stdcall;
function GetMaxLength(out pdwLength: LongWord): HRESULT; stdcall;
function GetBuffer(out ppdwBuffer: PBYTE): HRESULT; stdcall;
function GetBufferAndLength(out ppdwBuffer: PBYTE; out pdwLength: LongWord): HRESULT; stdcall;
Procedure AllocSample(const RequestLen : LongWord);//实际的分配功能，RequestLen为请求大小
constructor Create();
Destructor Destroy(); override;
end;
TPushSampleManager = class ( TObject )//Sample的管理器,暂时里面只设置两种Sample一种存放视频一种存放音频
private
Samples : array[0..1] of INSSBuffer; //0 存放视频 1 存放音频
PushSamples : array[0..1] of TPushSample ;
public
property VideoSample : INSSBuffer read Samples[0];
property AudioSample : INSSBuffer read Samples[1];
Property VideoPushSample : TPushSample read PushSamples[0];
Property AudioPushSample : TPushSample read PushSamples[1];
procedure AllocSample(const RequestLen : LongWord; const IsVideoSample : boolean=false);
Constructor Create();
Destructor Destroy();override;
end;
var
PushSampleManager : TPushSampleManager;
CommonType : TMediaCommonType ;
implementation
{ TPushSample }
procedure TPushSample.AllocSample(const RequestLen: LongWord);
begin
// LogFile.Write('AllocMem:'+inttostr(RequestLen));
// Logfile.Write('Length:'+inttostr(Length));
// Logfile.Write('No Change :'+inttostr(MaxLength));
if RequestLen > MaxLength then
begin
if Assigned(Buffer) then
begin
Freemem(Buffer, MaxLength);
Buffer:=nil;
end;
Buffer:=Allocmem(RequestLen);
MaxLength := RequestLen;
Length := 0;//有效数据为0
end;
end;
constructor TPushSample.Create;
begin
Buffer := nil;
Length := 0;
MaxLength := 0;
// LogFile.Write(inttostr(MaxLength));
end;
destructor TPushSample.Destroy;
begin
if Assigned( Buffer ) then
begin
FreeMem( Buffer,MaxLength);
end;
inherited;
end;
function TPushSample.GetBuffer(out ppdwBuffer: PBYTE): HRESULT;
begin
ppdwBuffer := Buffer;
Result := S_OK;
end;
function TPushSample.GetBufferAndLength(out ppdwBuffer: PBYTE;
out pdwLength: LongWord): HRESULT;
begin
ppdwBuffer := Buffer;
pdwLength := Length;
Result := S_OK;
end;
function TPushSample.GetLength(out pdwLength: LongWord): HRESULT;
begin
pdwLength := Length;
result := S_OK;
end;
function TPushSample.GetMaxLength(out pdwLength: LongWord): HRESULT;
begin
pdwLength := MaxLength ;
result := s_ok;
end;
function TPushSample.SetLength(dwLength: LongWord): HRESULT;
begin
Length := dwLength;
//只好加入强制部分了
result := s_ok;
end;
{ TPushSampleManager }
procedure TPushSampleManager.AllocSample(const RequestLen: LongWord;
const IsVideoSample: boolean);
begin
if IsVideoSample then
begin
self.PushSamples[0].AllocSample(RequestLen);
end
else
begin
self.PushSamples[1].AllocSample(RequestLen);
end;
end;
constructor TPushSampleManager.Create;
begin
Samples[0] := nil;
Samples[1] := nil;
PushSamples[0]:=TPushSample.Create;
PushSamples[1]:=TPushSample.Create;
Samples[0] := PushSamples[0] as INSSBuffer;
Samples[1] := PushSamples[1] as INSSBuffer;
end;
destructor TPushSampleManager.Destroy;
begin
Samples[0] := nil;
Samples[1] := nil;
inherited;
end;
initialization
CommonType.VideoCommonType.SubType :=MEDIASUBTYPE_RGB24;
CommonType.VideoCommonType.FormatType :=KSDATAFORMAT_SPECIFIER_VIDEOINFO;
CommonType.AudioCommonType.SubType := KSDATAFORMAT_SUBTYPE_PCM;
CommonType.AudioCommonType.FormatType := KSDATAFORMAT_SPECIFIER_WAVEFORMATEX ;
//LogFile.Write('Config Video SubType:'+GuidTostring(CommonType.VideoCommonType.SubType)+#9#9+'Config Video FormatType:'+GuidToString(CommonType.VideoCommonType.FormatType)+#13#10#13#10);
PushSampleManager := TPushSampleManager.Create;
finalization
if Assigned( PushSampleManager ) then
begin
PushSampleManager.Free;
PushSampleManager := nil;
end;
end.
unit PushManager;
interface
uses
DirectShow9, WMF9, DSUtil, Windows, Forms, MMSystem, SysUtils, Classes, Config, Messages, Sample, Dialogs, Log;
type
TPushState = ( Push_LOCATING,Push_Connecting,Push_Opened,Push_ERROR,Push_Closed );
TPushManager = class( TInterfacedObject ,IWMStatusCallback) //用来管理生成器，并将SAMPLE推向流媒体服务器
private
Writer : IWMWriter;//WMF 的 生成器
PushSink : IWMWriterPushSink;//网络推接受器
NetSink : IWMWriterNetWorkSink; //网络广播接受器
WriterAdv : IWMWriterAdvanced;
FState : TPushState;
Videoindex, AudioIndex : integer;//视频流索引编号，音频流索引编号
Videotime,Audiotime,dVideotime,dAudiotime : int64;
IsBeginWrite : boolean;
procedure CreateNet();//创建网络环境
procedure FreeNet();//撤消网络环境
procedure CreateWMF();
procedure FreeWMF();
procedure GetInformatFromProfile(const Profile : IWMProfile);
procedure GetInformatFromWriter();//从读取器上获得信息
procedure FindVideoInputFormat(const subtype : TGUID;const FormatType:TGUID;var prop : IWMInputMediaProps);
procedure FindAudioInputFormat(const Subtype: TGUID;const FormatType:TGUID;var prop : IWMInputMediaProps);
procedure ConfigVideoInput(); //把输入的配置信息发给生成器
procedure ConfigAudioInput();
public
VideoAddtime,AudioAddtime : int64;
property State : TPushState read FState;
procedure EndofStream();//流结束
procedure Run( );//可能以后需要有个参数
procedure Stop();
//从接口中继承过来的函数
function OnStatus(Status: TWMTStatus; hr: HRESULT; dwType: TWMTAttrDataType;
pValue: PBYTE; pvContext: Pointer): HRESULT; stdcall;
procedure WriteBuffer(const Sampletime : int64;const EndTime : int64;const Flags: DWord;const IsVideo : Boolean=false );
Constructor Create;
Destructor Destroy;override;
end;
var
PushMgr : TPushManager;
implementation
uses
Main,WinSock;
{ TPushManager }
function LocalIP : string; //获得本机IP
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
constructor TPushManager.Create;
begin
FreeWMF;
end;
procedure TPushManager.CreateNet;
var
RegCallback : IWMRegisterCallback;
UrlStr : WideString;
Port : Cardinal;
maxclient : Cardinal;
begin
Case Configfile.sinktype of
0:begin //0 表示广播
if Failed(WMCreateWriterNetWorkSink( NetSink )) then //创建网络广播器
begin
Logfile.Write('NetSink Create Error!');
end;
//NetSink.QueryInterface(IID_IWMRegisterCallback,RegCallback);
//RegCallback.Advise(self,nil);
//获得本机IP
if Failed(NetSink.SetNetworkProtocol(WMT_PROTOCOL_HTTP)) then
begin
Logfile.Write('NetSink SetNetworkProtocol Error!');
end;
Port := Configfile.Port;
if Failed(NetSink.Open(Port)) then
begin
Logfile.Write('NetSink Open Error!');
end;
maxclient := Configfile.MaxClient;
if Failed(NetSink.SetMaximumClients(maxclient)) then
begin
Logfile.Write('Set Max Clients Error!');
end;;
if Failed(WriterAdv.AddSink(NetSink)) then
begin
Logfile.Write('NetSink AddSink Error!');
end;
end;
1:begin
if Failed(WMCreateWriterPushSink( PushSink )) then
begin
Logfile.Write('Push Sink Create Error!');
end;
if Assigned( PushSink ) then
begin
try
//创建 接受器成功
PushSink.QueryInterface( IID_IWMRegisterCallback, RegCallback );
RegCallback.Advise( self, nil );
UrlStr := 'http://'+Configfile.Ip+':'+inttostr(Configfile.Port)+'/'+Configfile.Name;
if Failed(PushSink.Connect(pWidechar(UrlStr),nil,true)) then //其实都是异步的
begin
Logfile.Write('Push Sink Connect Error!');
end;
finally
RegCallback := nil;
end;
end;
end;
end;
end;
procedure TPushManager.CreateWMF; //创建PUSH 环境并根据配置连接到流媒体服务器
var
ProfileManager : IWMProfileManager;//Profile 管理器
ProFileName : string;
ProStrings : TStringList;
ProString : WideString;
Profile : IWMProfile;
begin
WMCreateWriter( nil , Writer);
Writer.QueryInterface( IID_IWMWriterAdvanced,WriterAdv );
ProfileManager := nil;
Profile := nil;
NetSink := nil;
try
WMCreateProfileManager( ProfileManager );
//打开文件 ,暂时使用固定死的Profile文件
//配置部分
ProFileName := Extractfiledir( Application.ExeName ) + '/Config/Profile/PushProfile.prx';
ProStrings := TStringList.Create;
ProStrings.LoadFromFile( ProFileName );
ProString := ProStrings.Text;
// showmessage(prostring);
ProfileManager.LoadProfileByData(PWideChar( ProString ),Profile);
//查找Profile中的流编号对应的视频和音频编号
Writer.SetProfile( Profile );
//获得生成器上视频STREAM编号和音频STREAM编号
// GetInformatFromProfile( Profile );
GetInformatFromWriter();
ConfigVideoInput();
ConfigAudioInput();
//增加接受器，配置网络环境
CreateNet();
finally
SetLength( ProString,0 );
if Assigned( ProStrings ) then
begin
ProStrings.Free;
ProStrings := nil;
end;
Profile := nil;
ProfileManager := nil;
end;
end;
destructor TPushManager.Destroy;
begin
FreeWMF;
inherited;
end;
procedure TPushManager.GetInformatFromProfile(const Profile : IWMProfile);
var
StreamCount : Cardinal;
index : integer;
StreamConfig : IWMStreamConfig;
GUID : TGUID;
begin
//先找到索引再说
if not Assigned( Profile ) then exit;
StreamCount := 0;
profile.GetStreamCount( StreamCount );//必须大于两个的
if StreamCount<>2 then //暂时只支持 为 2的输出
raise Exception.Create('配置Prx文件只允许为2个Stream');
StreamConfig := nil;
for index :=0 to StreamCount - 1 do
begin
try
Profile.GetStream( index, StreamConfig);
StreamConfig.GetStreamType( GUID );
// StreamConfig.GetBitrate()
if IsEqualGUID(guid,MEDIATYPE_Video) then
begin
VideoIndex := index + 1;
Continue;
end;
if IsEqualGUID(guid,MEDIATYPE_Audio) then
begin
AudioIndex := index;
Continue;
end;
finally
StreamConfig := nil;
end;
end;
end;
procedure TPushManager.FreeNet;
var
RegCallback : IWMRegisterCallback;
begin
if IsBeginWrite then
begin
Writer.Flush;
Writer.EndWriting;
end;
Case Configfile.sinktype of
0:begin
if Assigned( NetSink ) then
begin
WriterAdv.RemoveSink( NetSink );
//NetSink.QueryInterface( IID_IWMRegisterCallback, RegCallback );
NetSink.OnEndWriting;
NetSink.Disconnect;
NetSink.Close;
IsBeginWrite := false;
// RegCallback.Unadvise(self,nil);
end;
end;
1:begin
if Assigned( PushSink ) then
begin
//创建 接受器成功
try
PushSink.QueryInterface( IID_IWMRegisterCallback, RegCallback );
PushSink.EndSession;
PushSink.Disconnect;//断开网络
RegCallback.Unadvise(self,nil);
IsBeginWrite := false;
finally
RegCallback := nil;
end;
end;
end;
end;
end;
procedure TPushManager.FreeWMF;
begin
FreeNet;
PushSink := nil;
NetSink := nil;
WriterAdv := nil;
Writer := nil;
Videoindex := -1;
Audioindex := -1;
Videotime := 0;
Audiotime := 0;
VideoAddtime := 0;
AudioAddtime :=0;
dVideotime := 0;
dAudiotime := 0;
IsBeginWrite := false;
FState := Push_Closed;
end;
function TPushManager.OnStatus(Status: TWMTStatus; hr: HRESULT;
dwType: TWMTAttrDataType; pValue: PBYTE; pvContext: Pointer): HRESULT;
begin
case Status of
WMT_LOCATING:
Begin
FState := Push_LOCATING;
SendMessage( Main.MainFrm.Handle,WM_USER+1983,Integer( FState ),0);
end;
WMT_CONNECTING:
begin
FState := Push_CONNECTING;
SendMessage( Main.MainFrm.Handle,WM_USER+1983,Integer( FState ),0);
end;
WMT_OPENED: //与服务器成功建立连接
begin
FState := Push_OPENED;
//将Sink连接到生成器上
WriterAdv.AddSink( pushSink );
SendMessage( Main.MainFrm.Handle,WM_USER+1983,Integer( FState ),0);
end;
WMT_ERROR:
begin
FState := Push_Error;
SendMessage( Main.MainFrm.Handle,WM_USER+1983,Integer( FState ),0);
end;
WMT_CLOSED: //与服务器成功断开连接
begin
FState := Push_Closed;
WriterAdv.RemoveSink(pushSink);
SendMessage( Main.MainFrm.Handle,WM_USER+1983,Integer( FState ),0);
end;
end;
result := s_ok;
end;
procedure TPushManager.Run;
begin
CreateWMF;
end;
procedure TPushManager.Stop;
begin
FreeWMF;
end;
procedure TPushManager.WriteBuffer(const Sampletime : int64;const EndTime : int64;const Flags : DWord;const IsVideo : Boolean=false);
begin
if IsBeginWrite = false then
begin
Writer.BeginWriting;
IsBeginWrite := true;
end;
if IsVideo then
begin
// Videotime := Videotime + Sampletime;
// Logfile.Write('Write Vide Buffer!!');
Videotime := Sampletime {+ VideoAddtime};
//dVideoTime := Endtime - Sampletime;
//Logfile.Write('VideoTime: '+inttostr(VideoTime)+#13#10#13#10);
// WriterAdv.WriteStreamSample(VideoIndex,Videotime,0,15,Flags,PushSampleManager.VideoSample);//中间的两个 0 因为是WMF不用的所以设置为 0
Writer.WriteSample(VideoIndex,Videotime,Flags,PushSampleManager.VideoSample); //存在访问冲突
end
else
begin
// Audiotime := Audiotime +Sampletime;
// Logfile.Write('Write Audio Buffer!!');
Audiotime := Sampletime {+ AudioAddtime};
//dAudiotime := Endtime - Sampletime;
//Logfile.Write('AudioTime:'+inttostr(AudioTime)+#13#10#13#10);
// WriterAdv.WriteStreamSample(AudioIndex,Audiotime,0,15,Flags,PushSampleManager.AudioSample);
Writer.WriteSample(AudioIndex,Audiotime,Flags,pushSampleManager.AudioSample);
end;
end;
procedure TPushManager.GetInformatFromWriter; //从读取器上获得信息
var
InputCount : Cardinal;
index : Cardinal;
MediaProps : IWMInputMediaProps;
pType : PWMMediaType;
pcbType : Cardinal;
begin
Writer.GetInputCount( InputCount );
MediaProps := nil;
pType := nil;
pcbType := 0;
for index := 0 to InputCount - 1 do
begin
try
Writer.GetInputProps( index , MediaProps);
PcbType := 0;
MediaProps.GetMediaType(nil,pcbType);
if pcbType = 0 then Continue;//说明是输出口
try
pType:=Allocmem(pcbType);
MediaProps.GetMediaType(pType,pcbType);
if IsEqualGUID(pType.majortype,MEDIATYPE_Video) then
begin
VideoIndex := index;
Continue;
end;
if IsEqualGUID(pType.majortype,MEDIATYPE_Audio) then
begin
AudioIndex := index;
Continue;
end;
finally
FreeMem( ptype,pcbType);
end;
finally
MediaProps := nil;
end;
end;
end;
procedure TPushManager.ConfigVideoInput();
var
prop : IWMInputMediaProps;
begin
try
FindVideoInputFormat(CommonType.VideoCommonType.SubType,CommonType.VideoCommonType.FormatType,prop);
if not Assigned( prop ) then
begin
Logfile.Write('Can''t find Equal input Video Format!');
//Raise Exception.Create('Video 无法查找到匹配的输入!');
exit;
end;
Writer.SetInputProps(VideoIndex,prop); //设置输入的非压缩流格式
finally
prop := nil;
end;
end;
procedure TPushManager.FindVideoInputFormat(const subtype: TGUID;const FormatType : TGUID;
var prop: IWMInputMediaProps);
var
FormatCount : Cardinal;
index : Cardinal;
p : IWMInputMediaProps;
Size : Cardinal;
pType : PWMMediaType;
begin
Prop := nil;
if not Assigned( Writer ) then
begin
raise Exception.Create('Can''t findVideoInputFormat! Writer = NULL!');
exit;
end;
FormatCount := 0;
Writer.GetInputFormatCount(VideoIndex,FormatCount);
Logfile.Write('Video Input FormatCount:'+inttostr(FormatCount));
p := nil;
index := 0;
while( index < FormatCount ) do
begin
try
// Logfile.Write('Search Video index:'+inttostr(index));
Writer.GetInputFormat(VideoIndex,index,p);
Size := 0;
p.GetMediaType(nil,Size);
pType := Allocmem( size );
p.GetMediaType(pType,size);
// Logfile.Write('subType:'+GuidToString(pType.subtype)+#9#9+'FormatType:'+GuidToString(pType.formattype)+#13#10);
if (IsEqualGUID(pType.subtype,subType)) AND (IsEqualGuid(pType.formattype,FormatType)) then
begin
prop := p;
prop.SetMediaType(pType);
exit;
end;
inc( index );
finally
FreeMem( pType, size );
p:= nil;
end;
end;
end;
procedure TPushManager.ConfigAudioInput();
var
prop : IWMInputMediaProps;
begin
try
FindAudioInputFormat( CommonType.AudioCommonType.SubType,CommonType.AudioCommonType.FormatType,prop);
if not Assigned( prop ) then
begin
Logfile.Write('Can''t find Equal input Audio Format!');
//Raise Exception.Create('Audio 无法查找到匹配的输入!');
exit;
end;
Writer.SetInputProps(AudioIndex,prop);
finally
prop := nil;
end;
end;
procedure TPushManager.FindAudioInputFormat(const Subtype: TGUID;const FormatType : TGuid;
var prop: IWMInputMediaProps);
var
FormatCount : Cardinal;
Index : Cardinal;
p : IWMInputMediaProps;
size : Cardinal;
pType : PWMMediaType;
begin
if not Assigned( Writer ) then
raise Exception.Create('Can''t findAudioInputFormat! Writer = NULL!');
FormatCount := 0;
prop := nil;
Writer.GetInputFormatCount(AudioIndex,FormatCount);
LogFile.Write('Audio FormatCount:'+inttostr(FormatCount));
p := nil;
index := 0;
while(index<FormatCount) do
begin
try
// Logfile.Write('Search Audio Index:'+inttostr(index));
Writer.GetInputFormat(AudioIndex,index,p);
p.GetMediaType(0,size);
pType := Allocmem(size);
p.GetMediaType(pType,size);
// Logfile.Write('subType:'+GuidToString(pType.subtype)+#9#9+'FormatType:'+GuidToString(pType.formattype)+#13#10);
// Logfile.Write('Check Subtype:'+Guidtostring(ptype.subtype)+' Subtype:'+Guidtostring(Subtype));
if (IsEqualGuid(pType.subtype,Subtype)) and (IsEqualGuid(pType.formattype,FormatType)) then
begin
prop := p;
prop.SetMediaType(pType);
exit;
end;
inc(index);
finally
Freemem(pType,size);
p := nil;
end;
end;
end;
procedure TPushManager.EndofStream;
begin
// VideoAddtime := VideoTime+dVideoTime;
// AudioAddtime := AudioTime+dAudioTime;
Writer.EndWriting;
IsBeginWrite := false;
end;
initialization
PushMgr := TPushManager.Create;
finalization
if Assigned( PushMgr ) then
begin
PushMgr.Stop;
PushMgr := nil; //TPushManager也是COM对象啊
end;
end.
unit PlayerManager;
interface
uses
Directshow9, ActiveX, ComObj, Classes, Windows, Messages, DsUtil, RenderFilter, SysUtils, Log, PushManager;
Const
DirectShow_GraphEdit_Message = WM_USER + 1122;
type
TPlayerLinesManger = class;
TPlayerLineState = (Line_Ready , Line_play , Line_Stop , Line_Pause ,Line_NotReady) ;
TPlayerManager = class( TObject )
private
LinesManager : TPlayerLinesManger ;
MtvList : TStrings ;
NowItem : integer;//当前播放在LISTBOX中的索引
WinHandle : THandle;
procedure WinMessage(var Message: TMessage);
procedure SetMtv( const FileName : Widestring );
public
property Handle : THandle read WinHandle;
procedure Run(const List: TStrings);//服务启动
procedure Stop(); //服务关闭
Constructor Create();
Destructor Destroy(); override;
end;
TPlayerLine = class( TObject )
private
GraphBuilder : IGraphBuilder;
MediaControl : IMediaControl;
FFileName : WideString;
FState : TPlayerLineState;
DSDebug : integer;
VideoRenderFilter : IBaseFilter;
AudioRenderFilter : IBaseFilter;
FOwner : TPlayerLinesManger;
Event : IMediaEventEx;
procedure SetFileName( const f : widestring );
procedure FreeDirectshow;
procedure CreateDirectshow;
public
Property FileName : WideString read FFileName write SetFileName;
Property State : TPlayerLineState read FState;
//Property MediaEvent : IMediaEventEx read Event;
function Play() : boolean;
function Stop() : Boolean;
function Pause() : Boolean;
Constructor Create(const Owner : TPlayerLinesManger);
Destructor Destroy();override;
end;
TPlayerLinesManger = class ( TObject )
private
FPlayerLines : array of TPlayerLine;
FPlayerLineCount : integer;//播放流水线个数，默认为2,DEMO中暂时也是这样
ActiveIndex : integer;//当前激活的 PLAYERLINE 的索引
public
property LineCount : integer read FPlayerLineCount;
procedure Play();//播放当前激活的PLAYERLINE
procedure Stop();
procedure Pause();
procedure SetMtv( const filename : widestring ) ;
procedure changeLine(var MtvList : TStrings;var NowItem : integer);//换线对接
procedure Process();//用来检测状态的
Constructor Create();
Destructor Destroy();override;
end;
var
PlayerMgr : TPlayerManager;
implementation
{ TPlayerManager }
constructor TPlayerManager.Create();
begin
WinHandle := 0;
NowItem := -1;
WinHandle := classes.AllocateHWnd( WinMessage ) ;
LinesManager := TPlayerLinesManger.Create();
end;
destructor TPlayerManager.Destroy;
begin
if Assigned( LinesManager ) then
begin
LinesManager.Free;
LinesManager := nil;
end;
if WinHandle <> 0 then
begin
classes.DeallocateHWnd( WinHandle );
WinHandle := 0;
end;
inherited;
end;
procedure TPlayerManager.Run(const List : TStrings);
begin
if List.Count <=0 then exit;
NowItem := 0;//始终是从第一个开始播放的
if NowItem < 0 then exit;
MtvList := List;
self.LinesManager.SetMtv( MtvList[NowItem] );
if List.Count>=2 then
self.LinesManager.SetMtv(MtvList[NowItem+1]);
self.LinesManager.Play;
end;
procedure TPlayerManager.SetMtv(const FileName: Widestring);
begin
self.LinesManager.SetMtv( filename );
end;
procedure TPlayerManager.Stop;
begin
self.LinesManager.Stop;
end;
procedure TPlayerManager.WinMessage(var Message: TMessage);
var
Event : IMediaEventEx;
eventcode, eventParam1, eventParam2 : Longint;
begin
if Message.Msg <> DirectShow_GraphEdit_Message then exit;
// Logfile.Write('GraphEdit_Message call!!');
Event := IMediaEventEx(Message.LParam);
if Assigned( Event ) then
begin
While SUCCEEDED(Event.GetEvent(eventcode,eventparam1,eventparam2,0)) do
begin
event.FreeEventParams(eventcode,eventparam1,eventparam2);
case eventCode of
EC_COMPLETE:
begin
Logfile.Write('Directshow EC_COMPLETE!');
PushMgr.EndofStream;
self.LinesManager.FPlayerLines[self.LinesManager.ActiveIndex].Stop;
self.LinesManager.changeLine(self.MtvList,self.nowitem);
end;
end;
end;
end;
end;
{ TPlayerLinesManger }
procedure TPlayerLinesManger.changeLine(var MtvList : TStrings;var NowItem : integer);
begin
//换线对接
//先释放原来接口
if not Assigned(self.FPlayerLines[self.ActiveIndex]) then exit;
self.FPlayerLines[self.ActiveIndex].Free;
self.FPlayerLines[self.ActiveIndex] := nil;
if NowItem >= (MtvList.Count - 1) then exit;
if (NowItem + 2) < MtvList.Count then
begin
self.FPlayerLines[self.ActiveIndex] := TPlayerLine.Create(self);
self.FPlayerLines[self.ActiveIndex].FileName := MtvList[NowItem];
end;
if self.ActiveIndex = self.FPlayerLineCount then
self.ActiveIndex :=0
else
inc(self.ActiveIndex);
inc(NowItem);
self.FPlayerLines[NowItem].Play;
end;
constructor TPlayerLinesManger.Create( );
var
i : integer;
begin
FPlayerLineCount := 2;
ActiveIndex := -1; //没有可用的
SetLength( FPlayerLines, FPlayerLineCount );
for i := 0 to FPlayerLineCount - 1 do
begin
FPlayerLines[i] := TPlayerLine.Create(self);
end;
end;
destructor TPlayerLinesManger.Destroy;
var
i : integer;
begin
for i := 0 to FPlayerLineCount - 1 do
begin
if Assigned( FPlayerLines[i] ) then
begin
FPlayerLines[i].Free;
FPlayerLines[i] := nil;
end;
end;
SetLength( FPlayerLines, 0);
inherited;
end;
procedure TPlayerLinesManger.Pause;
begin
self.FPlayerLines[ ActiveIndex ].Pause;
end;
procedure TPlayerLinesManger.Play;
begin
if ActiveIndex = -1 then exit;
self.FPlayerLines[ ActiveIndex ].Play;
process();
end;
procedure TPlayerLinesManger.Process;
var
i : integer;
begin
//showmessage('ok') ;
for i := 0 to self.FPlayerLineCount - 1 do
begin
case self.FPlayerLines[i].State of
LINE_READY,LINE_PLAY,LINE_STOP,LINE_PAUSE:
BEGIN
ActiveIndex := i;
exit;
END;
LINE_NOTREADY:
begin
ActiveIndex := -1;
//showmessage('ok') ;
end;
end;
end;
end;
procedure TPlayerLinesManger.SetMtv(const filename: widestring);
var
i : integer;
begin
for i := 0 to self.FPlayerLineCount - 1 do
begin
if self.FPlayerLines[i].State <> Line_NotReady then continue;
self.FPlayerLines[i].SetFileName( filename );
break;
end;
Process();//检测状态确定ActiveIndex
end;
procedure TPlayerLinesManger.Stop;
begin
self.FPlayerLines[ ActiveIndex ].Stop;
process();
end;
{ TPlayerLine }
constructor TPlayerLine.Create( const Owner : TPlayerLinesManger );
begin
FreeDirectshow;
self.FOwner := Owner;
end;
procedure TPlayerLine.CreateDirectshow;
var
PlayerVideoRenderFilter : TPlayerVideoRenderFilter;
PlayerAudioRenderFilter : TPlayerAudioRenderFilter;
Guid1, Guid2 : TGUID;
begin
GraphBuilder := CreateComObject( CLSID_FilterGraph ) as IGraphBuilder;
//以后还要在这里先加上自己的RENDER FILTER
CreateGUID(Guid1);
CreateGUID(Guid2);
PlayerVideoRenderFilter := TPlayerVideoRenderFilter.Create(Guid1,'VideoPlayerRenderFilter',nil,S_OK);
PlayerAudioRenderFilter := TPlayerAudioRenderFilter.Create(Guid2,'AudioPlayerRenderFilter',nil,S_OK);
VideoRenderFilter := PlayerVideoRenderFilter as IBaseFilter;
AudioRenderFilter := PlayerAudioRenderFilter as IBaseFilter;
GraphBuilder.AddFilter( VideoRenderFilter,'VideoPlayerRenderFilter' );
GraphBuilder.AddFilter(AudioRenderFilter,'AudioPlayerRenderFilter');
GraphBuilder.RenderFile( PWideChar( FFileName ),nil);
AddGraphToRot( GraphBuilder,dsdebug);
GraphBuilder.QueryInterface( IID_IMediaControl,MediaControl );
//将通知加入到窗体中
GraphBuilder.QueryInterface( IID_IMediaEventEx, Event);
if Assigned(Event) then
begin
Event.SetNotifyWindow(OAHWND(PlayerMgr.Handle),DirectShow_GraphEdit_Message,Integer(Event));
end;
FState := LINE_READY;
end;
destructor TPlayerLine.Destroy;
begin
FreeDirectshow;
inherited;
end;
procedure TPlayerLine.FreeDirectshow;
begin
dsutil.RemoveGraphFromRot( dsdebug );
if Assigned(MediaControl) then
begin
MediaControl.Stop;
end;
VideoRenderFilter := nil;
AudioRenderFilter := nil;
Event := nil;
MediaControl := nil;
GraphBuilder := nil;
FSTATE := Line_NOTREADY;
end;
function TPlayerLine.Pause: Boolean;
begin
result := false;
if not Assigned( MediaControl ) then exit;
if FAILED( MediaControl.Pause ) then exit;
FSTATE := Line_PAUSE;
result := true;
end;
function TPlayerLine.Play : boolean;
begin
result := false;
if not Assigned( MediaControl ) then exit;
if FAILED( MediaControl.Run ) then exit;
FSTATE := Line_PLAY;
result := true;
end;
procedure TPlayerLine.SetFileName(const f: widestring);
begin
FreeDirectshow;
FFileName := f;
CreateDirectshow;
end;
function TPlayerLine.Stop: Boolean;
begin
result := false;
if not Assigned( MediaControl ) then exit;
if FAILED( MediaControl.Stop) then exit;
FSTATE := Line_STOP;
result := true;
end;
initialization
PlayerMgr := TPlayerManager.Create;
finalization
if Assigned(PlayerMgr) then
begin
PlayerMgr.Free;
PlayerMgr := nil;
end;
end.
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActnList, ToolWin, ActnMan, ActnCtrls, ActnMenus,
XPStyleActnCtrls, StdCtrls, RzLstBox, ExtCtrls, RzPanel, PlayerManager, PushManager,
RzStatus, Sample, WMPlayerManager;
type
TMainFrm = class(TForm)
ActionManager1: TActionManager;
ActionMainMenuBar1: TActionMainMenuBar;
OptionAct: TAction;
FileAct: TAction;
RzGroupBox1: TRzGroupBox;
MtvList: TRzListBox;
OpenMtvAct: TAction;
OpenMtvListAct: TAction;
OpenMtv: TOpenDialog;
SaveMtvListAct: TAction;
OpenMtvList: TOpenDialog;
SaveMtvList: TSaveDialog;
RunAct: TAction;
StopAct: TAction;
RzPanel1: TRzPanel;
RzClockStatus1: TRzClockStatus;
NetState: TRzStatusPane;
procedure OptionActExecute(Sender: TObject);
procedure FileActExecute(Sender: TObject);
procedure OpenMtvActExecute(Sender: TObject);
procedure OpenMtvListActExecute(Sender: TObject);
procedure SaveMtvListActExecute(Sender: TObject);
procedure RunActExecute(Sender: TObject);
procedure StopActExecute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WM1983(var msg : TMessage);Message WM_USER+1983;
end;
var
MainFrm: TMainFrm;
implementation
{$R *.dfm}
procedure TMainFrm.OptionActExecute(Sender: TObject);
begin
//
end;
procedure TMainFrm.FileActExecute(Sender: TObject);
begin
//
end;
procedure TMainFrm.OpenMtvActExecute(Sender: TObject);
var
i : integer;
begin
//
if OpenMtv.Execute then
begin
for i := 0 to OpenMtv.Files.Count - 1 do
begin
MtvList.Items.Add( OpenMtv.Files[i] );
end;
MtvList.ItemIndex := 0;
end;
end;
procedure TMainFrm.OpenMtvListActExecute(Sender: TObject);
var
Mtvstrings : TStringList;
begin
//
if OpenMtvList.Execute then
begin
try
Mtvstrings := TStringList.create;
Mtvstrings.LoadFromFile( OpenMtvList.FileName );
MtvList.Items.Clear;
MtvList.Items.Assign( MtvStrings );
finally
if Assigned( Mtvstrings ) then
begin
Mtvstrings.Free;
Mtvstrings := nil;
end;
end;
end;
end;
procedure TMainFrm.SaveMtvListActExecute(Sender: TObject);
begin
//
if SaveMtvList.Execute then
begin
end;
end;
procedure TMainFrm.RunActExecute(Sender: TObject);
begin
//
PlayerMgr.Run(self.MtvList.Items);
PushMgr.Run;
self.RunAct.Enabled := false;
self.StopAct.Enabled := true;
end;
procedure TMainFrm.WM1983(var msg: TMessage);
var
pushstate : TPushState;
begin
pushstate := TPushState( msg.WParam );
case pushstate of
Push_Closed, Push_Error:
begin
NetState.Caption := '未能连接服务器';
end;
Push_CONNECTING:
begin
NetState.Caption := '正在尝试连接服务器';
end;
Push_OPENED:
begin
NetState.Caption := '连接服务器成功';
end;
//......
end;
end;
procedure TMainFrm.StopActExecute(Sender: TObject);
begin
//
PlayerMgr.Stop;
PushMgr.Stop;
end;
initialization
finalization
end.
6215
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
