本文共 23761 字，大约阅读时间需要 79 分钟。

{****************************************************************** * original by Microsoft * * CDSCapture class * * uses DirectShow and Windows Media + Vfw to capture from Hardware * * written by orthkon * www.mp3.com/orthkon * orthkon@mail.com ******************************************************************} unit DSCapture; interface uses Windows, DirectShow, ActiveX, DirectSound, Dialogs; const   IID_IPropertyBag : TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';   WM_FGNOTIFY = $0400 + 1; type    PVIDEOINFOHEADER = ^TVIDEOINFOHEADER;    TVIDEOINFOHEADER = record     rcSource : TRECT;     rcTarget : TRECT;     dwBitRate : Cardinal;         // 波特率     dwBitErrorRate : Cardinal;    // 误码率     AvgTimePerFrame : Int64;   // 帧平均速度(100ns units)     bmiHeader : BITMAPINFOHEADER;   end;   TCapDeviceInfo = record     szName : String;     moniker : IMoniker;   end;       CDSCapture = class   public     constructor Create( handle : HWND );     destructor Destroy; override;     function Init : Boolean;     function EnumVideoDevices : String;     function EnumAudioDevices : String;     procedure ChooseDevices( szVideo, szAudio : String ); overload;   private     procedure CleanUp;     procedure BuildDeviceList;     procedure ChooseDevices( nmVideo, nmAudio : IMoniker ); overload;     function MakeBuilder : Boolean;     function MakeGraph : Boolean;     function InitCapFilters : Boolean;     function ErrMsg( szMsg : String; hr : HRESULT = 0 ) : Boolean;     procedure ResizeWindow( w, h : Integer );     procedure FreeCapFilters;     procedure NukeDownstream( pf : IBaseFilter );     procedure TearDownGraph;     function BuildPreviewGraph : Boolean;     function StartPreview : Boolean;     function StopPreview : Boolean;   end; implementation var   Graph : IGraphBuilder;   Builder : ICaptureGraphBuilder2;   VideoWindow : IVideoWindow;   MediaEvent : IMediaEventEx;   DroppedFrames : IAMDroppedFrames;   VideoCompression : IAMVideoCompression;   CaptureDialogs : IAMVfwCaptureDialogs;   AStreamConf : IAMStreamConfig;      // for audio cap   VStreamConf : IAMStreamConfig;      // for video cap   Render : IBaseFilter;   VCap : IBaseFilter;   ACap : IBaseFilter;   Sink : IFileSinkFilter;   ConfigAviMux : IConfigAviMux;   wachFriendlyName : String;   fCapAudioIsRelevant : Boolean = False;   fCapAudio : Boolean = False;   fCCAvail : Boolean = False;   fCapCC : Boolean = False;   fCaptureGraphBuilt : Boolean = False;   fPreviewGraphBuilt : Boolean = False;   fPreviewFaked : Boolean = False;   fCapturing : Boolean = False;   fPreviewing : Boolean = False;   fUseFrameRate : Boolean = False;   fWantPreview : Boolean = True;   FrameRate : double = 15;   hwOwner : HWND;   VideoDevices : array of TCapDeviceInfo;   AudioDevices : array of TCapDeviceInfo;   NumVD : Word = 0;    // 视频设备   NumAD : Word = 0;    // 音频设备   EnumVD : Word = 0;  // 当前视频设备   EnumAD : Word = 0;  // 当前音频设备   mVideo, mAudio : IMoniker;   gnRecurse : Integer; function CheckGUID( p1, p2 : TGUID ) : Boolean; var   i : Byte; begin   Result := False;   for i := 0 to 7 do if p1.D4[i] <> p2.D4[i] then Exit;   Result := ( p1.D1 = p2.D1 ) and ( p1.D2 = p2.D2 ) and ( p1.D3 = p2.D3 ); end; //  释放媒体类 (例如释放资源) procedure FreeMediaType( mt : TAM_MEDIA_TYPE ); begin   if mt.cbFormat <> 0 then begin     CoTaskMemFree( mt.pbFormat );     // Strictly unnecessary but tidier     mt.cbFormat := 0;     mt.pbFormat := nil;   end;   mt.pUnk := nil; end; procedure DeleteMediaType( pmt : PAM_MEDIA_TYPE ); begin   // 允许NULL   if pmt = nil then Exit;   FreeMediaType( pmt^ );   CoTaskMemFree( pmt ); end; // 创建采集 function CDSCapture.MakeBuilder : Boolean; begin   Result := True;   if Builder <> nil then Exit;   if CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,         IID_ICaptureGraphBuilder2, Builder ) <> NOERROR then Result := False; end; // 创建graph function CDSCapture.MakeGraph : Boolean; begin   Result := True;   if Graph <> nil then Exit;   if CoCreateInstance( CLSID_FilterGraph, nil, CLSCTX_INPROC, 			       IID_IGraphBuilder, Graph ) <> NOERROR then Result := False; end; function CDSCapture.InitCapFilters : Boolean; label   InitCapFiltersFail,   SkipAudio; var   PropBag : IPropertyBag;   hr : HRESULT;   varOle : OleVariant;   //tmt : TAM_MEDIA_TYPE;   pmt : PAM_MEDIA_TYPE;   pvih : PVIDEOINFOHEADER;   Pin : IPin;   pins : IEnumPins;   n : Cardinal;   pinInfo : TPIN_INFO;   Found : Boolean; 	Ks : IKsPropertySet; 	guid : TGUID; 	dw : DWORD; 	fMatch : Boolean; begin   hr := 0;   Result := MakeBuilder;   if Result = False then begin     ErrMsg( 'Cannot instantiate graph builder' );     Exit;   end;   VCap := nil;   if mVideo <> nil then begin     hr := mVideo.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );     if Succeeded( hr ) then begin       PropBag.Read( 'FriendlyName', varOle, nil );       if hr = NOERROR then wachFriendlyName := varOle;       PropBag := nil;     end;     hr := mVideo.BindToObject( nil, nil, IID_IBaseFilter, VCap );   end;   if VCap = nil then begin    ErrMsg( 'Error %x: Cannot create video capture filter', hr );    goto InitCapFiltersFail;   end;   //   // 创建filtergraph, 付给构造对象连接视频   // 采集Filter   //   Result := MakeGraph;   if Result = False then begin     ErrMsg( 'Cannot instantiate filtergraph' );     goto InitCapFiltersFail;   end;   hr := Builder.SetFiltergraph( Graph );   if hr <> NOERROR then begin    ErrMsg( 'Cannot give graph to builder' ); 	  goto InitCapFiltersFail;   end;   hr := Graph.AddFilter( VCap, nil );   if hr <> NOERROR then begin    ErrMsg( 'Error %x: Cannot add vidcap to filtergraph', hr ); 	  goto InitCapFiltersFail;   end;   // 调用FindInterface，确定流的源(如WDM TVTuners或Crossbars)   // 用于得到驱动程序名称，端口连接前此界面可能无效   //或根本无法调用   hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, 		    VCap, @IID_IAMVideoCompression, VideoCompression );   if hr <> S_OK then begin     Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, 		    VCap, @IID_IAMVideoCompression, VideoCompression );   end;    // 设置帧速率和采集尺寸   hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, 			VCap, @IID_IAMStreamConfig, VStreamConf );   if hr <> NOERROR then begin     hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,         VCap,	@IID_IAMStreamConfig, VStreamConf );     if hr <> NOERROR then begin 	    // this means we can't set frame rate (non-DV only) 	    ErrMsg( 'Error %x: Cannot find VCapture:IAMStreamConfig', hr );    end;   end;   fCapAudioIsRelevant := True;   // 缺省采集格式   if ( VStreamConf <> nil ) and ( VStreamConf.GetFormat( pmt ) = S_OK ) then begin     // DV capture 不使用VIDEOINFOHEADER    if CheckGUID( pmt^.formattype, FORMAT_VideoInfo ) then begin       // 窗口大小调整       gnRecurse := 0;       pvih := pmt.pbFormat;       ResizeWindow( pvih^.bmiHeader.biWidth, abs( pvih^.bmiHeader.biHeight ) ); 	  end; 	  if not CheckGUID( pmt^.majortype, MEDIATYPE_Video ) then begin 	    // 此采集filter 采集其他视频.       fCapAudioIsRelevant := False;       fCapAudio := False; 	  end;     DeleteMediaType( pmt );   end;   // 显示对话框   // NOTE:  仅VFW支持   Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,     VCap, @IID_IAMVfwCaptureDialogs, CaptureDialogs );   Found := False;   fMatch := False;   Pin := nil;   if Succeeded( VCap.EnumPins( pins ) ) then begin     while not Found and ( S_OK = pins.Next( 1, pin, n ) ) do begin       if S_OK = pin.QueryPinInfo( pinInfo ) then begin         if pinInfo.dir = PINDIR_INPUT then begin 			    // ANALOGVIDEOIN input pin?        if pin.QueryInterface( IID_IKsPropertySet, Ks ) = S_OK then begin          if Ks.Get( AMPROPSETID_Pin, 0, nil, 0,          @guid, sizeof( TGUID ), dw ) = S_OK then begin           if CheckGuid( guid, PIN_CATEGORY_ANALOGVIDEOIN ) then fMatch := True;             end; 			      Ks := nil;        end;        if fMatch then begin             Found := TRUE;        end;         end;         pinInfo.pFilter := nil;       end;       pin := nil;     end;     pins := nil;   end;   // there's no point making an audio capture filter   if fCapAudioIsRelevant = False then	goto SkipAudio;   // 创建音频采集filter, 尽管可能用不到   if mAudio = nil then begin    // 不采集音频 	  fCapAudio := FALSE; 	  goto SkipAudio;   end;   ACap := nil;   mAudio.BindToObject( nil, nil, IID_IBaseFilter, ACap );   if ACap = nil then begin    // 不采集音频 	  fCapAudio := FALSE; 	  ErrMsg( 'Cannot create audio capture filter' ); 	  goto SkipAudio;   end;   //   // 放置音频插件   //   hr := Graph.AddFilter( ACap, nil );   if hr <> NOERROR then begin     ErrMsg( 'Error %x: Cannot add audcap to filtergraph', hr );     goto InitCapFiltersFail;   end;   // Calling FindInterface below will result in building the upstream   // section of the capture graph (any WDM TVAudio's or Crossbars we might   // need).   // !!! What if this interface isn't supported?   // we use this interface to set the captured wave format   hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, 			ACap, @IID_IAMStreamConfig, AStreamConf );   if hr <> NOERROR then begin     ErrMsg( 'Cannot find ACapture:IAMStreamConfig' );   end; SkipAudio:   // Can this filter do closed captioning?   FillChar( guid, SizeOf( TGUID ), 0 );   hr := Builder.FindPin( VCap, PINDIR_OUTPUT, @PIN_CATEGORY_VBI, nil, FALSE, 0, Pin);   if hr <> S_OK then hr := Builder.FindPin( VCap, PINDIR_OUTPUT, @PIN_CATEGORY_CC,	nil, FALSE, 0, Pin );   if hr = S_OK then begin    Pin := nil;    fCCAvail := TRUE;   end else fCapCC := FALSE;	// can't capture it, then   // potential debug output - what the graph looks like   // DumpGraph(gcap.pFg, 1);   Result := TRUE;   Exit; InitCapFiltersFail:   FreeCapFilters;   Result := False;   Exit; end; // build the preview graph! // // !!! PLEASE NOTE !!!  Some new WDM devices have totally separate capture // and preview settings.  An application that wishes to preview and then // capture may have to set the preview pin format using IAMStreamConfig on the // preview pin, and then again on the capture pin to capture with that format. // In this sample app, there is a separate page to set the settings on the // capture pin and one for the preview pin.  To avoid the user // having to enter the same settings in 2 dialog boxes, an app can have its own // UI for choosing a format (the possible formats can be enumerated using // IAMStreamConfig) and then the app can programmatically call IAMStreamConfig // to set the format on both pins. // function CDSCapture.BuildPreviewGraph : Boolean; var   cy, cyBorder : Integer;   hr : HRESULT;   pmt : PAM_MEDIA_TYPE;   rc : TRect;   pvih : PVIDEOINFOHEADER; begin   // we have one already   if fPreviewGraphBuilt then begin     Result := True;     Exit;   end; 	Result := False;   // No rebuilding while we're running   if fCapturing or fPreviewing then Exit;   // We don't have the necessary capture filters   if VCap = nil then Exit;   if ( ACap = nil ) and fCapAudio then Exit;   // we already have another graph built... tear down the old one   if fCaptureGraphBuilt then TearDownGraph;   //   // Render the preview pin - even if there is not preview pin, the capture   // graph builder will use a smart tee filter and provide a preview.   //   // !!! what about latency/buffer issues?   // NOTE that we try to render the interleaved pin before the video pin, because   // if BOTH exist, it's a DV filter and the only way to get the audio is to use   // the interleaved pin.  Using the Video pin on a DV filter is only useful if   // you don't want the audio.   hr := Builder.RenderStream( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Interleaved, VCap, nil, nil );   if hr = VFW_S_NOPREVIEWPIN then begin    // preview was faked up for us using the (only) capture pin 	  fPreviewFaked := TRUE;   end else if hr <> S_OK then begin    // maybe it's DV?     hr := Builder.RenderStream( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, VCap, nil, nil );     if hr = VFW_S_NOPREVIEWPIN then begin 	    // preview was faked up for us using the (only) capture pin 	    fPreviewFaked := TRUE;     end else if hr <> S_OK then begin 	    ErrMsg( 'This graph cannot preview!' );     end;   end;   //   // Render the closed captioning pin? It could be a CC or a VBI category pin,   // depending on the capture driver   //   if fCapCC then begin    hr := Builder.RenderStream( @PIN_CATEGORY_CC, nil, VCap, nil, nil ); 	  if hr <> NOERROR then begin       hr := Builder.RenderStream( @PIN_CATEGORY_VBI, nil, VCap, nil, nil ); 	    if hr <> NOERROR then begin         ErrMsg( 'Cannot render closed captioning' );         // so what? goto SetupCaptureFail;       end;     end;   end;   //   // Get the preview window to be a child of our app's window   //   // This will find the IVideoWindow interface on the renderer.  It is   // important to ask the filtergraph for this interface... do NOT use   // ICaptureGraphBuilder2::FindInterface, because the filtergraph needs to   // know we own the window so it can give us display changed messages, etc.   hr := Graph.QueryInterface( IID_IVideoWindow, VideoWindow );   if hr <> NOERROR then begin    ErrMsg( 'This graph cannot preview properly' );   end else begin 	  VideoWindow.put_Owner( hwOwner );    // We own the window now    VideoWindow.put_WindowStyle( WS_CHILD );    // you are now a child 	  // give the preview window all our space but where the status bar is    GetClientRect( hwOwner, rc ); 	  cyBorder := GetSystemMetrics( SM_CYBORDER );    cy := cyBorder;// + statusGetHeight(); 	  rc.bottom := rc.bottom - cy;    VideoWindow.SetWindowPosition( 0, 0, rc.right, rc.bottom ); // be this big 	  VideoWindow.put_Visible( TRUE );   end;   // now tell it what frame rate to capture at.  Just find the format it   // is capturing with, and leave everything alone but change the frame rate   // No big deal if it fails.  It's just for preview   // !!! Should we then talk to the preview pin?   if ( VStreamConf <> nil ) and fUseFrameRate then begin    hr := VStreamConf.GetFormat( pmt ); 	  // DV capture does not use a VIDEOINFOHEADER     if hr = NOERROR then begin       if CheckGuid( pmt^.formattype, FORMAT_VideoInfo ) then begin         pvih := pmt^.pbFormat;        pvih^.AvgTimePerFrame := round( 10000000 / FrameRate ); 	      hr := VStreamConf.SetFormat( pmt^ ); 		    if hr <> NOERROR then ErrMsg( '%x: Cannot set frame rate for preview', hr );       end;       DeleteMediaType( pmt );    end;   end;   // make sure we process events while we're previewing!   hr := Graph.QueryInterface( IID_IMediaEventEx, MediaEvent );   if hr = NOERROR then begin     MediaEvent.SetNotifyWindow( hwOwner, WM_FGNOTIFY, 0 );   end;   // All done.   // potential debug output - what the graph looks like   // DumpGraph(gcap.pFg, 1);   fPreviewGraphBuilt := TRUE;   Result := True; end; // Start previewing // function CDSCapture.StartPreview : Boolean; var   MC : IMediaControl;   hr : HRESULT; begin   // way ahead of you   if fPreviewing then begin     Result := True;     Exit;   end;   Result := False;   if not fPreviewGraphBuilt then Exit;   // run the graph   hr := Graph.QueryInterface( IID_IMediaControl, MC );   if Succeeded( hr ) then begin    hr := MC.Run; 	  if FAILED( hr ) then begin 	    // stop parts that ran 	    MC.Stop;    end; 	  MC := nil;   end;   if FAILED( hr ) then begin 	  ErrMsg( 'Error %x: Cannot run preview graph', hr ); 	  Exit;   end;   fPreviewing := TRUE;   Result := True; end; // stop the preview graph // function CDSCapture.StopPreview : Boolean; var   MC : IMediaControl;   hr : HRESULT; begin   Result := False;   // way ahead of you   if not fPreviewing then Exit;   // stop the graph   MC := nil;   if Graph <> nil then begin     hr := Graph.QueryInterface( IID_IMediaControl, MC );     if SUCCEEDED( hr ) then begin      hr := MC.Stop; 	    MC := nil;     end;     if FAILED( hr ) then begin      ErrMsg( 'Error %x: Cannot stop preview graph', hr ); 	    Exit;     end;   end;   fPreviewing := FALSE;   // !!! get rid of menu garbage   InvalidateRect( hwOwner, nil, TRUE );   Result := TRUE; end; // Tear down everything downstream of a given filter procedure CDSCapture.NukeDownstream( pf : IBaseFilter ); var   pP, pTo : IPin;   u : Cardinal;   pins : IEnumPins;   pininfo : TPIN_INFO;   hr : HRESULT; begin   //DbgLog((LOG_TRACE,1,TEXT("Nuking...")));   pins := nil;   hr := pf.EnumPins( pins );   pins.Reset;   while hr = NOERROR do begin     hr := pins.Next( 1, pP, u );    if ( hr = S_OK ) and ( pP <> nil ) then begin 	    pP.ConnectedTo( pTo ); 	    if pTo <> nil then begin         hr := pTo.QueryPinInfo( pininfo );         if hr = NOERROR then begin         if pininfo.dir = PINDIR_INPUT then begin 		        NukeDownstream( pininfo.pFilter ); 		        Graph.Disconnect( pTo ); 		        Graph.Disconnect( pP );             Graph.RemoveFilter( pininfo.pFilter ); 		      end;           pininfo.pFilter := nil;         end;         pTo := nil;       end;       pP := nil;     end;   end;   pins := nil; end; // Tear down everything downstream of the capture filters, so we can build // a different capture graph.  Notice that we never destroy the capture filters // and WDM filters upstream of them, because then all the capture settings // we've set would be lost. // procedure CDSCapture.TearDownGraph; begin   Sink := nil;   ConfigAviMux := nil;   Render := nil;   if VideoWindow <> nil then begin    // stop drawing in our window, or we may get wierd repaint effects 	  VideoWindow.put_Owner( 0 );    VideoWindow.put_Visible( FALSE );   end;   VideoWindow := nil;   MediaEvent := nil;   DroppedFrames := nil;   // destroy the graph downstream of our capture filters   if VCap <> nil then NukeDownstream( VCap );   if ACap <> nil then	NukeDownstream( ACap );   // potential debug output - what the graph looks like   // if (gcap.pFg) DumpGraph(gcap.pFg, 1);   fCaptureGraphBuilt := FALSE;   fPreviewGraphBuilt := FALSE;   fPreviewFaked := FALSE; end; // all done with the capture filters and the graph builder // procedure CDSCapture.FreeCapFilters; begin   Graph := nil;   Builder := nil;   VCap := nil;   ACap := nil;   AStreamConf := nil;   VStreamConf := nil;   VideoCompression := nil;   CaptureDialogs := nil; end; // make sure the preview window inside our window is as big as the // dimensions of captured video, or some capture cards won't show a preview. // (Also, it helps people tell what size video they're capturing) // We will resize our app's window big enough so that once the status bar // is positioned at the bottom there will be enough room for the preview // window to be w x h // procedure CDSCapture.ResizeWindow( w, h : Integer ); var   rcW, rcC : TRECT;   cyBorder, xExtra, yExtra : Integer; begin     cyBorder := GetSystemMetrics( SM_CYBORDER );     gnRecurse := gnRecurse + 1;     GetWindowRect( hwOwner, rcW );     GetClientRect( hwOwner, rcC );     xExtra := rcW.right - rcW.left - rcC.right;     yExtra := rcW.bottom - rcW.top - rcC.bottom + cyBorder;// + statusGetHeight();     rcC.right := w;     rcC.bottom := h;     SetWindowPos( hwOwner, 0, 0, 0, rcC.right + xExtra, rcC.bottom + yExtra, SWP_NOZORDER or SWP_NOMOVE );     // we may need to recurse once.  But more than that means the window cannot     // be made the size we want, trying will just stack fault.     //     if gnRecurse = 1 then     if ( ( rcC.right + xExtra <> rcW.right - rcW.left ) and ( w > GetSystemMetrics( SM_CXMIN ) ) )     or ( rcC.bottom + yExtra <> rcW.bottom - rcW.top ) then ResizeWindow( w, h );     gnRecurse := gnRecurse - 1; end; function CDSCapture.EnumVideoDevices : String; begin   if EnumVD < NumVD then begin     Result := VideoDevices[EnumVD].szName;     EnumVD := EnumVD + 1;   end else begin     Result := ';     EnumVD := 0;   end; end; function CDSCapture.EnumAudioDevices : String; begin   if EnumAD < NumAD then begin     Result := AudioDevices[EnumAD].szName;     EnumAD := EnumAD + 1;   end else begin     Result := ';     EnumAD := 0;   end; end; procedure CDSCapture.ChooseDevices( nmVideo, nmAudio : IMoniker ); begin   if ( mVideo <> nmVideo ) or ( mAudio <> nmAudio ) then begin     if nmVideo <> nil then nmVideo._AddRef;     if nmAudio <> nil then nmAudio._AddRef;     mVideo := nil;     mAudio := nil;     mVideo := nmVideo;     mAudio := nmAudio;     if fCaptureGraphBuilt or fPreviewGraphBuilt then TearDownGraph;     FreeCapFilters;     InitCapFilters;     if fWantPreview then begin       BuildPreviewGraph;       StartPreview;     end;   end; end; procedure CDSCapture.ChooseDevices( szVideo, szAudio : String ); var   nmVideo, nmAudio : IMoniker;   i : Word; begin   nmVideo := nil;   nmAudio := nil;   if szVideo <> ' then if szVideo[1] = '&' then szVideo := Copy( szVideo, 2, Length( szVideo ) - 1 );   if szAudio <> ' then if szAudio[1] = '&' then szAudio := Copy( szAudio, 2, Length( szAudio ) - 1 );   i := 0;   while i < NumVD do begin     if VideoDevices[i].szName = szVideo then nmVideo := VideoDevices[i].moniker;     i := i + 1;   end;   i := 0;   while i < NumAD do begin     if AudioDevices[i].szName = szAudio then nmAudio := AudioDevices[i].moniker;     i := i + 1;   end;   ChooseDevices( nmVideo, nmAudio );   nmVideo := nil;   nmAudio := nil; end; procedure CDSCapture.BuildDeviceList; var   SysDevEnum : ICreateDevEnum;   EnumCat : IEnumMoniker;   Moniker : IMoniker;   cFetched : Longint;   PropBag : IPropertyBag;   varName : OleVariant; begin   SysDevEnum := nil;   CoCreateInstance( CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum );   //SysDevEnum.CreateClassEnumerator( CLSID_VideoCompressorCategory, EnumCat, 0 );   // enum available video capture devices   EnumCat := nil;   SysDevEnum.CreateClassEnumerator( CLSID_VideoInputDeviceCategory, EnumCat, 0 );   while EnumCat.Next( 1, Moniker, @cFetched ) = S_OK do begin     Moniker.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );     PropBag.Read( 'FriendlyName', varName, nil );     NumVD := NumVD + 1;     SetLength( VideoDevices, NumVD );     VideoDevices[NumVD-1].szName := varName;     VideoDevices[NumVD-1].moniker := Moniker;     PropBag := nil;     Moniker := nil;   end;   // enum available audio capture devices   EnumCat := nil;   SysDevEnum.CreateClassEnumerator( CLSID_AudioInputDeviceCategory, EnumCat, 0 );   while EnumCat.Next( 1, Moniker, @cFetched ) = S_OK do begin     Moniker.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );     PropBag.Read( 'FriendlyName', varName, nil );     NumAD := NumAD + 1;     SetLength( AudioDevices, NumAD );     AudioDevices[NumAD-1].szName := varName;     AudioDevices[NumAD-1].Moniker := Moniker;     PropBag := nil;     Moniker := nil;   end;   EnumCat := nil;   SysDevEnum := nil; end; function CDSCapture.Init : Boolean; begin   Result := False;   // Create the filter graph.   if CoCreateInstance( CLSID_FilterGraph, nil, CLSCTX_INPROC,     IID_IGraphBuilder, Graph ) <> S_OK then Exit;   // Create the capture graph builder.   if CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,     IID_ICaptureGraphBuilder2, Builder ) <> S_OK then Exit;   Builder.SetFiltergraph( Graph );   BuildDeviceList;   Result := ( NumVD > 0 ) or ( NumAd > 0 ); end; function CDSCapture.ErrMsg( szMsg : String; hr : HRESULT = 0 ) : Boolean; begin   MessageBox( GetForegroundWindow, PChar( szMsg ), 'DirectShow - Capture', MB_OK or MB_ICONSTOP );   Result := False; end; procedure CDSCapture.CleanUp; begin   Graph := nil;   Builder := nil;   VideoWindow := nil;   MediaEvent := nil;   DroppedFrames := nil;   VideoCompression := nil;   CaptureDialogs := nil;   AStreamConf := nil;   VStreamConf := nil;   Render := nil;   VCap := nil;   ACap := nil;   Sink := nil;   ConfigAviMux := nil; end; constructor CDSCapture.Create( handle : HWND ); begin   CleanUp;   hwOwner := handle; end; destructor CDSCapture.Destroy; begin   StopPreview;   CleanUp; end; end.

转载地址：http://lrsti.baihongyu.com/