DirectShow实现音视频分离(Delphi)

复制代码
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus,Directshow9,WMF9,StrUtils;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    MTVOpen: TOpenDialog;
    VisionSave: TSaveDialog;
    SoundSave: TSaveDialog;
    N4: TMenuItem;
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
    { Private declarations }
    id:integer;//调试用
     FilterGraph:IGraphBuilder;
     VisionFilter,SoundFilter:IBaseFilter;
     MediaControl:IMediaControl;
     procedure Freedirectshow();
     procedure Createdirectshow(Const Filename:widestring);
     procedure SetVisionConfig();
     function setVisionSaveFilename():string;
     procedure setVisionSave();
     function CheckDefaultWav():boolean;
     procedure SetSoundSave();
     function setSoundSaveFilename():string;
     procedure SetSoundConfig();
  public
    { Public declarations }
    function openfile(const filename:widestring):Boolean;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
Comobj,DSUtil,ActiveX;

procedure TForm1.N3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
if MTVOpen.Execute then
 begin
   if Openfile(MTVOpen.FileName)=false then
      Messagebox(handle,'打开文件出错!','错误',MB_ICONERROR or MB_DEFBUTTON1  or MB_APPLMODAL);
 end;
end;

procedure TForm1.Createdirectshow(Const Filename:widestring);
begin
   id:=0;
   FilterGraph:=Comobj.CreateComObject(CLSID_FilterGraph) as IGraphBuilder;
   DSUtil.AddGraphToRot(FilterGraph,ID);

 

       //视频部分
   VisionFilter:=CreateComObject(CLSID_WMAsfWriter) as IBaseFilter;
   setVisionSave;
   FilterGraph.AddFilter(VisionFilter,'视频分流');
   SetVisionConfig();

 


    //音频部分
   SoundFIlter:=CreateComObject(CLSID_WMAsfWriter) as IBaseFilter;
   setSoundSave();
   FilterGraph.AddFilter(SoundFilter,'音频分流');
   setSoundConfig();

 

 

 FilterGraph.RenderFile(PWideChar(Filename),nil);
 FilterGraph.QueryInterface(IID_IMediaControl,MediaControl);
end;

procedure TForm1.Freedirectshow;
begin
  if id<>0 then
   DSUtil.RemoveGraphFromRot(ID);
   VisionFilter:=nil;
   SoundFilter:=nil;
   MediaControl:=nil;
   FilterGraph:=nil;
end;

function TForm1.openfile(const filename: widestring): Boolean;
begin
  result:=false;
  try
    ID:=0;
    FreeDirectshow();
    CreateDirectshow(filename);
    result:=true;
  finally
    abort;
  end;
end;

procedure TForm1.SetVisionConfig;
var
  Config:IConfigAsfWriter;
begin
try
  if Assigned(VisionFilter) then
  begin
       if Failed(VisionFilter.QueryInterface(WMF9.IID_IConfigAsfWriter,Config)) then
          raise Exception.Create('获得视频分流Filter配置接口失败!');
      if Failed(Config.ConfigureFilterUsingProfileGuid(WMProfile_V80_56VideoOnly)) then
         raise Exception.Create('配置视频分流Filter失败!');
  end;
finally
  Config:=nil;
end;
end;

function TForm1.setVisionSaveFilename: string;
begin
    if VisionSave.Execute then
    begin
       if RightStr(trim(VisionSave.FileName),4)='.asf' then
       begin
         result:=VisionSave.FileName;
         exit;
       end;
       result:=VisionSave.FileName+'.asf';

    end;
end;

procedure TForm1.setVisionSave;
var
  savefilename:widestring;
  fileSinkFilter:IFileSinkFilter2;
  fmt:TAMMediaType;
begin

  savefilename:=setVisionSaveFilename;
  try
      if Failed(VisionFilter.QueryInterface(IID_IFileSinkFilter2,fileSinkFilter)) then
         raise Exception.Create('获得视频分流FileSinkFilter失败!');
     fileSinkFilter.SetMode(1);//AM_FILE_OVERWRITE
     fillchar(fmt,sizeof(fmt),#0);
     fmt.majortype:=MEDIATYPE_Video;
     fmt.subtype:=MEDIASUBTYPE_Asf;
     fmt.formattype:=FORMAT_VideoInfo;
     Filesinkfilter.SetFileName(pwidechar(savefilename),@fmt);
  finally
     fileSinkFilter:=nil;
  end;
end;

function TForm1.CheckDefaultWav: boolean;
begin
result:=false;

if FileExists(Extractfiledir(Application.ExeName)+'/Input/Default.asf') then
 begin
  result:=true;
 end;
end; 

procedure TForm1.SetSoundSave;
var
  savefilename:widestring;
  fileSinkFilter:IFileSinkFilter2;
  fmt:TAMMediaType;
begin

  savefilename:=setSoundSaveFilename;
  try
      if Failed(SoundFilter.QueryInterface(IID_IFileSinkFilter2,fileSinkFilter)) then
         raise Exception.Create('获得视频分流FileSinkFilter失败!');
       fileSinkFilter.SetMode(1);//AM_FILE_OVERWRITE
     fillchar(fmt,sizeof(fmt),#0);
     fmt.majortype:=MEDIATYPE_Audio;
     fmt.subtype:=MEDIASUBTYPE_Asf;
     fmt.formattype:=FORMAT_WaveFormatEx;
     Filesinkfilter.SetFileName(pwidechar(savefilename),@fmt);
  finally
     fileSinkFilter:=nil;
  end;
end;

function TForm1.setSoundSaveFilename: string;
begin
if SoundSave.Execute then
    begin
       if RightStr(trim(SoundSave.FileName),4)='.asf' then
       begin
         result:=SoundSave.FileName;
         exit;
       end;
       result:=SoundSave.FileName+'.asf';

    end;
end;

procedure TForm1.SetSoundConfig;
var
  Config:IConfigAsfWriter;
begin
try
  if Assigned(SoundFilter) then
  begin
       if Failed(SoundFilter.QueryInterface(WMF9.IID_IConfigAsfWriter,Config)) then
          raise Exception.Create('获得视频分流Filter配置接口失败!');
     if Failed(Config.ConfigureFilterUsingProfileGuid(WMProfile_V80_128StereoAudio)) then
        raise Exception.Create('配置视频分流Filter失败!');
  end;
finally
  Config:=nil;
end;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
if Assigned(MediaControl) then
  MediaControl.Run;
end;

end.
复制代码

 

posted on   癫狂编程  阅读(313)  评论(0编辑  收藏  举报

编辑推荐:
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
· 没有源码,如何修改代码逻辑?
· 一个奇形怪状的面试题:Bean中的CHM要不要加volatile?
· [.NET]调用本地 Deepseek 模型
· 一个费力不讨好的项目,让我损失了近一半的绩效!
阅读排行:
· 全网最简单!3分钟用满血DeepSeek R1开发一款AI智能客服,零代码轻松接入微信、公众号、小程
· .NET 10 首个预览版发布,跨平台开发与性能全面提升
· 《HelloGitHub》第 107 期
· 全程使用 AI 从 0 到 1 写了个小工具
· 从文本到图像:SSE 如何助力 AI 内容实时呈现?(Typescript篇)

导航

< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5
好的代码像粥一样,都是用时间熬出来的
点击右上角即可分享
微信分享提示