Delphi6 用DirectShow 枚举视频设备信息

想用Directshow 枚举视频设备信息，但是用的D6，从网上找到了Delphi 10的示例https://download.csdn.net/download/dbyoung/10025100

从中找出枚举函数，从DirectShow9.pas中找到一些const的参数值

unit UtUSBCamera;

interface

uses
     Windows, SysUtils, Classes, ActiveX;
type
  PVideoInputInfo  = ^TVideoInputInfo;
  PVideoFormatInfo = ^TVideoFormatInfo;
  { 视频输入设备 }
  TVideoInputInfo = record
    id: TGUID;
    strName: ShortString;
    index: Integer;
  end;

    { 视频支持格式 }
  TVideoFormatInfo = record
    id: TGUID;
    iWidth, iHeight: Integer;
    iMod: TGUID;
    Frame: Int64;
    format: ShortString;
  end;


  ICreateDevEnum = interface(IUnknown)
    ['{29840822-5B84-11D0-BD3B-00A0C911CE86}']
    (*** ICreateDevEnum methods ***)
    function CreateClassEnumerator(const clsidDeviceClass: TGUID;
        out ppEnumMoniker: IEnumMoniker; dwFlags: DWORD): HResult; stdcall;
  end;
                    
    { 枚举所有视频输入设备 }
  procedure EnumAllUSBCamera(strsList: TStrings);

implementation

const
  IID_IPropertyBag: TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';
    
  CLSID_SystemDeviceEnum: TGUID = (D1:$62BE5D10;D2:$60EB;D3:$11D0;D4:($BD,$3B,$00,$A0,$C9,$11,$CE,$86));
  {$EXTERNALSYM CLSID_SystemDeviceEnum}

  IID_ICreateDevEnum                  : TGUID = '{29840822-5B84-11D0-BD3B-00A0C911CE86}';
  {$EXTERNALSYM IID_ICreateDevEnum}

  CLSID_VideoInputDeviceCategory: TGUID = (D1:$860BB310;D2:$5D01;D3:$11D0;D4:($BD,$3B,$00,$A0,$C9,$11,$CE,$86));
  {$EXTERNALSYM CLSID_VideoInputDeviceCategory}


function GetMaxIndex(const strsList: TStrings; const strUSBCameraName: string): Integer;
var
  III, Count: Integer;
begin
  Result  := 0;
  Count   := strsList.Count;
  for III := 0 to Count - 1 do
  begin
    if CompareText(String(PVideoInputInfo(strsList.Objects[III])^.strName), strUSBCameraName) = 0 then
    begin
      Result := Result + 1;
    end;
  end;
end;

{ 枚举所有视频输入设备 }
procedure EnumAllUSBCamera(strsList: TStrings);
var
  SysDevEnum: ICreateDevEnum;
  EnumCat   : IEnumMoniker;
  hr        : Integer;
  Moniker   : IMoniker;
  Fetched   : ULONG;
  PropBag   : IPropertyBag;
  strName   : OleVariant;
  strGuid   : OleVariant;
  III       : Integer;
  puInfo    : PVideoInputInfo;
  intIndex  : Integer;
begin
  { 创建系统枚举器对象 }
  hr := CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum);
  if hr <> S_OK then
    Exit;

  { 用指定的 Filter 目录类型创建一个枚举器，并获得 IEnumMoniker 接口； }
  hr := SysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumCat, 0);
  if hr <> S_OK then
    Exit;

  try
    { 释放内存 }
    if strsList.Count > 0 then
    begin
      for III := 0 to strsList.Count - 1 do
      begin
        FreeMem(PVideoFormatInfo(strsList.Objects[III]));
      end;
    end;
    strsList.Clear;

    { 获取指定类型目录下所有设备标识 }
    while (EnumCat.Next(1, Moniker, @Fetched) = S_OK) do
    begin
      Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
      PropBag.Read('CLSID', strGuid, nil);
      PropBag.Read('FriendlyName', strName, nil);
      New(puInfo);
      puInfo^.id      := TGUID(strGuid);
      puInfo^.strName := ShortString(strName);
      puInfo^.index   := 0;
      if strsList.IndexOf(strName) = -1 then
      begin
        strsList.AddObject(strName, TObject(puInfo));
      end
      else
      begin
        { 相同名称的 USBCamera 相机，<有可能有多个名称重复的相机> }
        intIndex      := GetMaxIndex(strsList, strName);
        puInfo^.index := intIndex + 1;
        strsList.AddObject(strName + format('(%d)', [puInfo^.index]), TObject(puInfo));
      end;
      PropBag := nil;
      Moniker := nil;
    end;

  finally
    EnumCat    := nil;
    SysDevEnum := nil;
  end;
end;
end.

 测试

procedure TForm1.Button2Click(Sender: TObject);
var
  vdlist:TStringList;
  i: Integer;
begin
  vdlist := TStringList.Create;

  EnumAllUSBCamera(vdList);

  Memo1.Lines.Add('视频设备列表：');
  for i := 0 to vdlist.Count -1 do
  begin
    Memo1.Lines.Add(vdList.Strings[i]);
  end;
end;

视频设备列表：
AVerMedia SD Capture 1
AVerMedia HD Capture 1
USB 视频设备
 

结束！

PS：下载地址：https://download.csdn.net/download/fly_520/11874002