使用DirectShow开发视频采集程序

{******************************************************************
* 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.