WebCam / cihaz listesi almak, doğru çalışıyor mu ?

[mrmarman]

Herkese merhaba...

- Ayrı bir başlık açtım, RTMP ile dolaylı yolla ilgili olduğundan @alyamus'un başlığında kirlilik olmasın istedim.

- Sistemde kurulu WebCam'leri aşağıdaki procedure ile alıyorum. bkz. bu linkteki projeyi indirip çalıştırarak da sonucu deneyebilirsiniz.

- Web üzerinde aradığınızda çok farklı şekillerde bu listeye ulaşılmış ama Delphi sürümünden sürümüne yeniden elden geçirilmesi gereken metodlar olduğundan onları beğenmedim. bkz.bir örneği burada.

- Verdiğim aşağıdaki örnek çalışıyorsa da bildirin -ne ala ki size özel bir örnek olsun-, çalışmıyorsa da bildirin ki sorunun nerede olduğunu beraber masaya yatıralım.

Teşekkürler.

Procedıure aşağıdaki şekilde :

Kod: Tümünü seç

procedure CihazListesi( slListe: TStrings );
Var
  REG      : TRegistry;
  slGecici, slAlt1, slAlt2 : TStringList;
  strFriendlyName   : String;
  i, j, k  : Integer;
begin
  slGecici := TStringList.Create;
  slAlt1   := TStringList.Create;
  slAlt2   := TStringList.Create;
  REG := TRegistry.Create;
  REG.RootKey := HKEY_LOCAL_MACHINE;
  // AlternatifVID : HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Enum\USB\VID_5986&PID_0315&MI_00\7&2e7922d7&0&0000
  // Audio         : HKEY_CURRENT_USER\Software\Microsoft\ActiveMovie\devenum\{33D9A762-90C8-11D0-BD43-00A0C911CE86}\Mikrofon (Realtek High Definiti
  if REG.OpenKey('\SYSTEM\ControlSet001\Control\DeviceClasses', False) then
  begin
    Reg.GetKeyNames( slGecici );
    for i := 0 to slGecici.Count - 1 do
    begin
      if Reg.OpenKey('\SYSTEM\ControlSet001\Control\DeviceClasses\'+ slGecici[i], False ) then
      begin
        Reg.GetKeyNames( slAlt1 );
        for j := 0 to slAlt1.Count - 1 do
        begin
          if Pos( 'VID', slAlt1[j] ) > 0 then
          begin
            if Reg.OpenKey('\SYSTEM\ControlSet001\Control\DeviceClasses\'+ slGecici[i] + '\' + slAlt1[j], False ) then
            begin
              Reg.GetKeyNames( slAlt2 );
              for k := 0 to slAlt2.Count - 1 do
              begin
                if Reg.OpenKey('\SYSTEM\ControlSet001\Control\DeviceClasses\'+ slGecici[i] + '\' + slAlt1[j] + '\' + slAlt2[k], False ) then
                begin
                  if Reg.OpenKey('\SYSTEM\ControlSet001\Control\DeviceClasses\'+ slGecici[i] + '\' + slAlt1[j] + '\' + slAlt2[k] + '\Device Parameters', False ) then
                  begin
                    strFriendlyName := Reg.ReadString( 'FriendlyName' );
                    if (strFriendlyName <> '') AND (slListe.IndexOf(strFriendlyName) < 0) then slListe.Add( strFriendlyName );
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  Reg.Free;
  slAlt2.Free;
  slAlt1.Free;
  slGecici.Free;
end;

Kullanımı ise şöyle : ( forma bir tane tComboBox koyup )

Kod: Tümünü seç

procedure TForm1.FormShow(Sender: TObject);
begin
  With ComboBox1 do begin
    CihazListesi( Items );
    Style := csDropDownList;
    ItemIndex := 0;
  end;
end;

[mrmarman]

Arkadaşlar DirectX9 paketinden ayıklayıp aşağıdaki şekilde hallettim.

Kod: Tümünü seç

Uses ActiveX, ComObj;
  Type
    ICreateDevEnum = interface(IUnknown)
      ['{29840822-5B84-11D0-BD3B-00A0C911CE86}']
      (*** ICreateDevEnum methods ***)
      function CreateClassEnumerator(const clsidDeviceClass: TGUID;
          out ppEnumMoniker: IEnumMoniker; dwFlags: DWORD): HResult; stdcall;
  end;

procedure EnumerateVideoInputDevices( Liste:TStrings );
// Uses ActiveX, ComObj eklenecek
const
  IID_ICreateDevEnum            : TGUID = '{29840822-5B84-11D0-BD3B-00A0C911CE86}';
  CLSID_SystemDeviceEnum        : TGUID = (D1:$62BE5D10;D2:$60EB;D3:$11D0;D4:($BD,$3B,$00,$A0,$C9,$11,$CE,$86));
  CLSID_VideoInputDeviceCategory: TGUID = (D1:$860BB310;D2:$5D01;D3:$11D0;D4:($BD,$3B,$00,$A0,$C9,$11,$CE,$86));
  IID_IPropertyBag              : TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';
var
  LDevEnum : ICreateDevEnum;
  ppEnumMoniker    : IEnumMoniker;
  pceltFetched : ULONG;
  Moniker    : IMoniker;
  PropBag    : IPropertyBag;
  pvar       : olevariant;
  hr         : HRESULT;
  strDescription, strFriendlyName, strDevicePath, strCLSID : String;
begin
  CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, LDevEnum);
  hr := LDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, ppEnumMoniker, 0);
  if (hr = S_OK) then
  begin
    while(ppEnumMoniker.Next(1, Moniker, @pceltFetched) = S_OK) do
      begin
        strDescription  := '';
        strFriendlyName := '';
        strDevicePath   := '';
        strCLSID        := '';
        Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
        if PropBag.Read('Description', pvar, nil) = S_OK then
          strDescription  := String(pvar);
        if PropBag.Read('FriendlyName', pvar, nil) = S_OK then
          strFriendlyName := String(pvar);
        if PropBag.Read('DevicePath', pvar, nil) = S_OK then
          strDevicePath   := (pvar);
        if PropBag.Read('CLSID', pvar, nil) = S_OK then
           strCLSID       := String(pvar);
        PropBag := nil;
        Moniker := nil;
        Liste.Add( strFriendlyName );
      end;
  end;
  ppEnumMoniker :=nil;
  LDevEnum :=nil;
end;

Kullanımı:

Kod: Tümünü seç

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  EnumerateVideoInputDevices( ComboBox1.Items );
end;

[G.Arkas]

Abime küçük bir hatırlatma yapayım. Ben Directx ile çok çalıştım. Eğer bir aktarım durumu söz konusuysa index 1 den sonra webcam başlıyor. Eğer 0 verirsen ekran görüntüsü aktarılıyor.

İyi çalışmalar.