pointersdelphidelphi-7directshow

It is not possible to correctly write functions from MSDN in Delphi


I want to create my own filter and use it in the DirectShow library. The filter seemed to be able to write, but there was a problem with creating a graph. I based my code on the "Creating an Audio Capture Graph" article. At the very end it says that the functions from the articles "Add a Filter by CLSID" and "Connect Two Filters" are also used. I rewrote the most identical, but the code does not work.

I indicated the location of the error with many "!".

Project Project1.exe raised exception class AEccessViolation with message 'Access violation at address 0045AAA8 in module 'Project1.exe'. Read of address 00000000'. Process stopped. Use step or Run to continue.

In general, I have the following code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, DirectShow9,ActiveX,BaseClass, DirectInput,
  StdCtrls,DirectSound, DirectSetup,  DirectPlay8,   DirectMusic,
  Dialogs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    function AddFilterByCLSID(pGraphA: IGraphBuilder; clsid: TGUID; wazName: PWideChar;  ppF: IBaseFilter): HRESULT;
    function ConnectFilter( pGraph: IGraphBuilder; pSrc: IBaseFilter; pdest: IBaseFilter): HRESULT;
    function GetUnconnectedPin(pFilter: IBaseFilter; PinDir: PIN_DIRECTION; ppPin: IPin): HRESULT;
    function ConnectFilterPin( pGraph: IGraphBuilder; pOut: IPin; pdest: IBaseFilter): HRESULT;
  end;
var
  PropertyName:IPropertyBag;
  pSrc, pWaveDest, pWriter: IBaseFilter; 
  pSink: IFileSinkFilter;
  pGraph: IGraphBuilder;
  FMediaControl: IMediaControl;
  pDevEnum: ICreateDevEnum;
  pEnum: IEnumMoniker;
  pMoniker: IMoniker;
  MArray1,MArray2: array of IMoniker;

  hr: HRESULT;

  DeviceName:OleVariant;
  FAudioCaptureFilter:  IBaseFilter;
const
  CLSID_WavDest : TGUID = '{3C78B8E2-6C4D-11d1-ADE2-0000F8754B99}';
  CLSID_CRleFilter: TGUID = '{BEBCF0A3-2673-42A7-82F2-5D4FC3126171}'; //My Filter.
  IID_ICRleFilter: TGUID = '{35C0AC80-C3E4-4EEA-A1F5-049401E29400}'; //Myfilter
var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.AddFilterByCLSID(pGraphA: IGraphBuilder; clsid: TCLSID;
  wazName: PWideChar; ppF: IBaseFilter): HRESULT;
var
 pF: IBaseFilter;
begin
 CoCreateInstance(clsid, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pF);
 hr:=pGraph.AddFilter(pF, WazName);

   if hr<> S_OK then
   begin
   ShowMessage('фильтр вавдеста не добавился');
   end;
   PPf:= pF;
//   pF._Release;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var
   pOut: IPin;
begin
 HR:= CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
                   IID_IGraphBuilder, pGraph);

 if hr<> S_OK then
   begin
   ShowMessage('Граф не создался');
   end;
  HR:= CoCreateInstance(CLSID_SystemDeviceEnum, NIL, CLSCTX_INPROC_SERVER,
IID_ICreateDevEnum, pDevEnum);
 if hr<> S_OK then
   begin
   ShowMessage('перечеслитель не создался');
   Exit;
   end;


    HR:=pDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, pEnum, 0);
if HR<>S_OK  then EXIT;
//Обнуляем массив в списке моникеров
setlength(MArray2,0);
//Пускаем массив по списку устройств
while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
setlength(MArray2,length(MArray2)+1); //Увеличиваем массив на единицу
MArray2[length(MArray2)-1]:=pMoniker; //Запоминаем моникер в масиве
HR:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName); //Линкуем моникер устройства к формату хранения IPropertyBag
if FAILED(HR) then Continue;
HR:=PropertyName.Read('FriendlyName', DeviceName, NIL); //Получаем имя устройства
if FAILED(HR) then Continue;
//Добавляем имя устройства в списки
Listbox2.Items.Add(DeviceName);
end;
 Listbox2.ItemIndex:=0;
   MArray2[Listbox2.ItemIndex].BindToObject(NIL, NIL, IID_IBaseFilter, FAudioCaptureFilter);
              //добавляем устройство в граф фильтров
              Pgraph.AddFilter(FAudioCaptureFilter, 'AudioCaptureFilter');
 // pGraph.AddFilter(pSrc, 'Capture');

  AddfilterByCLSID(pGraph, CLSID_CRleFilter, '_CRleFilter', pWaveDest);



  ConnectFilter(pGraph, pWaveDest, pWriter); // This is where the mistakes start !!!!!!!!!!!!!!!!!
  pGraph.QueryInterface(IID_IMediaControl, FMediaControl);

 FMediaControl.Run();
end;
{
There is no function overloading in Delphi, so I named the functions differently
                                                                                }
function TForm1.ConnectFilterPin(pGraph: IGraphBuilder; pOut: IPin;
  pdest: IBaseFilter): HRESULT;
  var
 pIn : IPin;
begin
  pIn:= nil;
  GetUnconnectedPin(pdest, PINDIR_OUTPUT, pIn);
  pGraph.Connect(pOut, pin);
end;

function TForm1.ConnectFilter(pGraph: IGraphBuilder; pSrc: IBaseFilter;
  pdest: IBaseFilter): HRESULT;
  var
    pOut: IPin;
begin
  //pOut:= 0;


   GetUnconnectedPin(pSrc, PINDIR_OUTPUT, pOut);
   ConnectFilterPin(pGraph, pOut, pdest);

end;

function TForm1.GetUnconnectedPin(pFilter: IBaseFilter;
  PinDir: PIN_DIRECTION; ppPin:  IPin): HRESULT;
var
 pEnum: IEnumPins;
 pPin: IPin;
 hr: HRESULT;
 ThisPinDir : PIN_DIRECTION;
 pTmp: IPin;
begin
  pTmp:=nil;
  ppPin:= nil;
 // pEnum:= nil;
  pPin:= nil;
 hr:= pFilter.EnumPins(pEnum); // This is where the error occurs !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  if hr<> S_OK then
  begin
    ShowMessage('перечесление пинов: не равно S_OK');
  end;

  while pEnum.Next(1, pPin, nil) = S_OK do
  begin
   pPin.QueryDirection(ThisPinDir);
   if ThisPinDir = PinDir then
    begin
     hr:= pPin.ConnectedTo(pTmp);
          if Succeeded(hr) then
           begin
            pTmp._Release;
           end else
           begin
           pEnum._Release;
           ppPin:= pPin;
           Result := S_OK;
           Exit;
           end;


          end;
       end;
      pPin._Release;
       
  ShowMessage('ошибка: не правильный код');
  Result:= E_FAIL;
 // ShowMessage('ошибка: не правильный код');

end;

end.

I was hoping that the error was caused by pointers, or rather their absence. I tried to put them in absolutely all combinations, but this did not lead to the desired result. Besides, everywhere in Delphi pointers are not used at all. Perhaps somewhere the parameters in the functions are not correctly passed. I reviewed all the functions 5 times, tried to find errors, but this did not work. Using pointers didn't work either.

I know the error is small and easy to fix, but I can't figure out where it is.


Solution

  • The error was not in the pointers. The purpose of the Connect Filter function is to connect two filters. The structure looks like this ConnectFilter(Graph, Filter 1, Filter 2);. I added only one filter to the project. As a result, nothing was sent to the function instead of the second filter. There was an address reading error that was very hard to catch. Perhaps it would be easy to identify the error if I used all sorts of checks. Due to the fact that C ++ uses pointers, but Delphi does not, I thought that the error was in pointers, because I did not use them. But the fix turned out to be simpler: you need to add a second filter, and send it as the third parameter. From these errors we can conclude:

    1. Even in experimental code, it is worth doing as many checks as possible.
    2. Watch and read carefully.
    3. Functions that are called from other functions should be above these functions. There was no error, but it is indicated in the book Flenov M.E. The Bible of Delphi (third edition), chapter 5.4: Procedures and functions in Delphi. Solutions to other errors are also described there.
    4. Unlike C++, Delphi does not need to assign nil to new variables, Delphi does it on its own.
    5. You also don't need to call Release yourself.

    I rewrote the code with the correction of all the errors I noticed. I'll leave it below:

    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, DirectShow9,ActiveX,BaseClass, DirectInput,
      StdCtrls,DirectSound, DirectSetup,  DirectPlay8,   DirectMusic,
      Dialogs;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        ListBox2: TListBox;
        procedure Button1Click(Sender: TObject);
    
      private
        { Private declarations }
      public
        { Public declarations }
        function AddFilterByCLSID(pGraphA: IGraphBuilder; clsid: TGUID; wazName: PWideChar; var ppF: IBaseFilter): HRESULT;
        function ConnectFilter( pGraph: IGraphBuilder; pSrc: IBaseFilter; pdest: IBaseFilter): HRESULT;
        function GetUnconnectedPin(pFilter: IBaseFilter; PinDir: PIN_DIRECTION; var ppPin: IPin): HRESULT;
        function ConnectFilterPin( pGraph: IGraphBuilder; pOut: IPin; pdest: IBaseFilter): HRESULT;
      end;
    var
      PropertyName:IPropertyBag;
      pSrc, pWaveDest, pWriter: IBaseFilter;
      pSink: IFileSinkFilter;
      pGraph: IGraphBuilder;
      FMediaControl: IMediaControl;
      pDevEnum: ICreateDevEnum;
      pEnum: IEnumMoniker;
      pMoniker: IMoniker;
      MArray1,MArray2: array of IMoniker;
    
      hr: HRESULT;
    
      DeviceName:OleVariant;
      FAudioCaptureFilter:  IBaseFilter;
    const
      CLSID_WavDest : TGUID = '{3C78B8E2-6C4D-11d1-ADE2-0000F8754B99}';
      CLSID_CRleFilter: TGUID = '{BEBCF0A3-2673-42A7-82F2-5D4FC3126171}';
      IID_ICRleFilter: TGUID = '{35C0AC80-C3E4-4EEA-A1F5-049401E29400}';
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    function TForm1.AddFilterByCLSID(pGraphA: IGraphBuilder; clsid: TCLSID;
      wazName: PWideChar; var ppF: IBaseFilter): HRESULT;
      {The last parameter of the function is returned,
       for this you need to add [ var ] before the declaration.
       Возвращается последний параметр функции,
        для этого вам нужно добавить [ var ] перед объявлением.}
    var
      pf: IBaseFilter;
    begin
      hr:= CoCreateInstance(clsid, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pF);
        if Succeeded(hr) then               // Added full error checking
        begin
          hr:=pGraph.AddFilter(pF, WazName);
          if Succeeded(hr) then
          begin
           ppf:= pf;
          end else
           ShowMessage('фильтр добавился / Filter not added');
        end else
         ShowMessage('фильтр добавился / Filter not added 2');
       Result:= hr;
    end;
    
    function TForm1.GetUnconnectedPin(pFilter: IBaseFilter;
      PinDir: PIN_DIRECTION; var ppPin:  IPin): HRESULT;
    var
     pEnum: IEnumPins;
     pPin: IPin;
     hr: HRESULT;
     ThisPinDir : PIN_DIRECTION;
     pTmp: IPin;
    begin
      //you don't need to assign [ nil ]; Delphi does it by itself.
      //Не нужно явно указывать [ nil ]; Delphi делает это самостоятельно.
     hr:= pFilter.EnumPins(pEnum);
    
      if Failed(hr) then
      begin
        ShowMessage('перечесление пинов: ошибка / pin listing: error');
      end;
    
      while pEnum.Next(1, pPin, nil) = S_OK do
      begin
       pPin.QueryDirection(ThisPinDir);
       if ThisPinDir = PinDir then
        begin
         hr:= pPin.ConnectedTo(pTmp);
              if Succeeded(hr) then
               begin
               end else
               begin
               ppPin:= pPin;
               Result := S_OK;
               Exit;
               end;
        end;
      end;
    
      ShowMessage('ошибка: не правильный код / error: invalid code');
      Result:= E_FAIL;
    
    end;
    
    function TForm1.ConnectFilterPin(pGraph: IGraphBuilder; pOut: IPin;
      pdest: IBaseFilter): HRESULT;
      var
     pIn : IPin;
    begin
     GetUnconnectedPin(pdest, PINDIR_OUTPUT, pIn);
     pGraph.Connect(pOut, pin);
    end;
    
    function TForm1.ConnectFilter(pGraph: IGraphBuilder; pSrc: IBaseFilter;
      pdest: IBaseFilter): HRESULT;
      var
        pOut: IPin;
    begin
       GetUnconnectedPin(pSrc, PINDIR_OUTPUT, pOut);
       ConnectFilterPin(pGraph, pOut, pdest);
    
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
     var
       pOut: IPin;
    begin
     HR:= CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,
                       IID_IGraphBuilder, pGraph);
    
     if hr<> S_OK then
       begin
       ShowMessage('Ошибка создания графа / Graph creation error');
       end;
      HR:= CoCreateInstance(CLSID_SystemDeviceEnum, NIL, CLSCTX_INPROC_SERVER,
    IID_ICreateDevEnum, pDevEnum);
     if hr<> S_OK then
       begin
       ShowMessage('Ошибка создания графа / Graph creation error');
       Exit;
       end;
    
    
        HR:=pDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, pEnum, 0);
    if HR<>S_OK  then EXIT;
     //Обнуляем массив в списке моникеров  /  Resetting the array in the list of monikers
     setlength(MArray2,0);
     //Пускаем массив по списку устройств  /  Let's run the array through the list of devices
    while (S_OK=pEnum.Next(1,pMoniker,Nil)) do
    begin
     setlength(MArray2,length(MArray2)+1); //Увеличиваем массив на единицу  /  Incrementing the array by one
     MArray2[length(MArray2)-1]:=pMoniker; //Запоминаем моникер в масиве  /  Remembering the moniker in the array
     HR:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName); //Линкуем моникер устройства к формату хранения IPropertyBag
                                                                      // Link Device Monitor to IPropertyBag Storage Format
     if FAILED(HR) then Continue;
     HR:=PropertyName.Read('FriendlyName', DeviceName, NIL); //Получаем имя устройства  /  Getting the device name
     if FAILED(HR) then Continue;
     //Добавляем имя устройства в списки  /  Adding the device name to the lists
     Listbox2.Items.Add(DeviceName);
    end;
     Listbox2.ItemIndex:=0;
     MArray2[Listbox2.ItemIndex].BindToObject(NIL, NIL, IID_IBaseFilter, FAudioCaptureFilter);
                  //добавляем устройство в граф фильтров  /  adding a device to the filter graph
    
      Pgraph.AddFilter(FAudioCaptureFilter, 'AudioCaptureFilter');
      AddfilterByCLSID(pGraph, CLSID_FileWriter, 'File Writer', pWriter);
      AddfilterByCLSID(pGraph, CLSID_CRleFilter, '_CRleFilter', pWaveDest);
    
      {The error was that [ ConnectFilter ] connects two filters, and only one was specified.
       The first filter is specified in the second parameter; the second filter is
       specified in the third parameter; In order for the function to execute correctly,
       you must first add two filters, then use [ ConnectFilter ] }
    
      {Ошибка заключалась в том что [ ConnectFilter ] соединяет два фильтра,
       а задавался только один. Первый фильтр указан во втором параметре;
       второй фильтр указывается в третьем параметре; Что бы функция выполнилась правильно,
       нужно предварительно добавить два фильтра, затем использовать [ ConnectFilter ] }
    
      ConnectFilter(pGraph, FAudioCaptureFilter, pWaveDest);
      ConnectFilter(pGraph, pWaveDest, pWriter);
    
      pGraph.QueryInterface(IID_IMediaControl, FMediaControl);
      FMediaControl.Run();
    end;
    
    end.