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.