{******************************************************************************}
{ FileName............: SampleUnit001                                          }
{ Project.............:                                                        }
{ Author(s)...........: MM                                                     }
{ Version.............: 2.00                                                   }
{------------------------------------------------------------------------------}
{  Sample code for using the Push Source DirectShow filter                     }
{                                                                              }
{                                                                              }
{  Note: The default behaviour is to connect to the MPEG2 demultiplxer (with   }
{        the default media types). This means that the data we push must be    }
{        VALID Transport stream data. The SAMPLE.TS file has this kind of data }
{        so use this file for pushing. Incorrect data is not accepted by the   }
{        MPEG2 demultiplexer, so the pushing of data is not recorded!          }
{        Also note that data is only delivered when there is a full media      }
{        buffer, which means you typically 'loose' the last data if the data   }
{        pushed is not a multiple of the media buffer size.                    }
{                                                                              }
{  Copyright (C) 2003-2006  M.Majoor                                           }
{                                                                              }
{  This program is free software; you can redistribute it and/or               }
{  modify it under the terms of the GNU General Public License                 }
{  as published by the Free Software Foundation; either version 2              }
{  of the License, or (at your option) any later version.                      }
{                                                                              }
{  This program is distributed in the hope that it will be useful,             }
{  but WITHOUT ANY WARRANTY; without even the implied warranty of              }
{  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               }
{  GNU General Public License for more details.                                }
{                                                                              }
{  You should have received a copy of the GNU General Public License           }
{  along with this program; if not, write to the Free Software                 }
{  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. }
{                                                                              }
{------------------------------------------------------------------------------}
{  1.00   20060115 - Initial release                                           }
{  2.00   20060910 - Updated for V2.00 of the PushSource filter                }
{******************************************************************************}
unit SampleUnit001;

interface

uses
  DirectShow9,
  ActiveX,

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls;


const
  IID_MajorPushSource                            = '{6D616A6F-7269-7479-6E6C-535243020200}';
  T_IID_MajorPushSource                  : TGUID = IID_MajorPushSource;
  CLSID_MajorPushSource                  : TGUID = '{6D616A6F-7269-7479-6E6C-535243000200}';

type
  IMajorPushSource = interface(IUnknown)
  [IID_MajorPushSource]
    function  GetVersionInformation(out Info: PChar): HRESULT; stdcall;        // Get version information
    function  GetInformation       (out Info: PChar): HRESULT; stdcall;        // Get next text information (debug)
    function  GetInformationCount  (out Count: Integer): HRESULT; stdcall;     // Get information count (debug)
    function  GetDeliveredCount    (out Count: Integer): HRESULT; stdcall;     // Get number of bytes delivered to output pin
    procedure SetLog               (OnOff: Boolean); stdcall;                  // (De)activate file log
    function  GetLog               (out OnOff: Boolean): HRESULT; stdcall;     // Get status activation log file
    procedure SetSyncData          (OnOff: Boolean); stdcall;                  // (De)activate synchronization on start packet syncbyte $47
    function  GetSyncData          (out OnOff: Boolean): HRESULT; stdcall;     // Get status synchronization
    procedure SetUdp               (Port: Integer; BufferSize: Integer); stdcall;                   // Set UDP port for listening (<0 to deactivate), buffer size <=0 for default
    function  GetUdp               (out Port: Integer; out BufferSize: Integer): HRESULT; stdcall;  // Get UDP port setup for listening (<0 to deactivate)
    procedure SetAddTimestamps     (OnOff: Boolean); stdcall;                  // (De)activate timestamps in media samples
    function  GetAddTimestamps     (out OnOff: Boolean): HRESULT; stdcall;     // Get status timestamps
    procedure SetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; CheckType: Boolean); stdcall;                // Set media types when pin (re)connects
    function  GetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; out CheckType: Boolean): HRESULT; stdcall;   // Get media types to use when pin (re)connects
    procedure SetBufferSize        (BufferSize: Integer; BufferAlignment: Integer); stdcall;                           // Set (preferred) buffer requirements
    function  GetBufferSize        (out BufferSize: Integer; out BufferAlignment: Integer): HRESULT; stdcall;          // Get (decided) buffer requirements
    function  GetPushedData        (Buffer: PByte; Size: Integer): HRESULT; stdcall;                                   // Get first xx bytes of media sample of last pushed data (debug)
    procedure FlushData; stdcall;                                              // Flush data (assures next data is realigned)
    function  PushData             (Buffer: PByte; Size: Integer; out Delivered: Integer): HRESULT; stdcall;           // Push data
  end;

  
  TPushThread = class(TThread)
    FSourceFilter: IMajorPushSource;
    FFileName    : AnsiString;
    FEndOfStream : Boolean;
    FPushDelay   : Integer;
    FPushed      : Integer;
    FDelivered   : Integer;
  public
    procedure Execute; override;
  end;



  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    mnuDirectShow: TMenuItem;
    mnuDirectShowFilters: TMenuItem;
    mnuFile: TMenuItem;
    mnuExit: TMenuItem;
    OpenDialog1: TOpenDialog;
    btnFile: TButton;
    btnExit: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    lblPushed: TLabel;
    Label2: TLabel;
    lblMessage: TLabel;
    dlgOpen: TOpenDialog;
    Label3: TLabel;
    lblDelivered: TLabel;
    Label4: TLabel;
    lblTotalDelivered: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnFileClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FFilterGraph              : IFilterGraph2;             // Filter graph manager (stream buffer source, all other filters)
    FFilterPushSourceFilter   : IBaseFilter;               // Push source filter
    FFilterPushSourceInterface: IMajorPushSource;          // Push source filter interface
    FRotEntry                 : LongInt;                   // ROT
    FPushThread               : TPushThread;               // Thread used for pushing data
    function  AddToRot(UnknownGraph: IUnknown; var RotEntry: LongInt): HRESULT;
    procedure RemoveFromRot(RotEntry: LongInt);
    procedure DirectShowFiltersAddToMenu;
    function  DirectShowShowPropertyPage(Parent: THandle; FilterName: WideString; QueryOnly: Boolean): Boolean;
    function  DirectShowGetFilterName(Index: Integer): string;
    function  SaveGraphFile(FilterGraph: IFilterGraph2; GraphFile: AnsiString): Boolean;
    procedure mnuDirectShowSaveGraph(Sender: TObject);
    procedure mnuDirectShowClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}


{------------------------------------------------------------------------------
  Params  : <UnknownGraph>  Graph to add to ROT
  Returns : <Result>        Result (S_OK if success)
            <RotEntry>      Assigned number in ROT

  Descript: Add graph to Running Object Table so we can connect to it when
            it is running.
  Notes   :
 ------------------------------------------------------------------------------}

function TfrmMain.AddToRot(UnknownGraph: IUnknown; var RotEntry: LongInt): HRESULT;
var
  Moniker: IMoniker;
  Rot    : IRunningObjectTable;
  Wsz    : WideString;
  Wsz2   : WideString;
  Hr     : HRESULT;
begin
  try
    Hr := GetRunningObjectTable(0, ROT);
    if Failed(Hr) then
    begin
      Result := E_FAIL;
      Exit;
    end;
    Wsz  := format('FilterGraph %p pid %8.8x', [Pointer(UnknownGraph), GetCurrentProcessId]);
    Wsz2 := '!';
    Hr := CreateItemMoniker(@Wsz2[1], @Wsz[1], Moniker);
    if Succeeded(Hr) then
    begin
      Hr := ROT.Register(ROTFLAGS_REGISTRATIONKEEPSALIVE, UnknownGraph, Moniker, RotEntry);
    end;
    Result := Hr;
  except
    Result := E_FAIL;
  end;
end;

{------------------------------------------------------------------------------
  Params  : <RotEntry>      Assigned number in ROT
  Returns : -

  Descript: Remove graph from Running Object Table
  Notes   :
 ------------------------------------------------------------------------------}

procedure TfrmMain.RemoveFromRot(RotEntry: LongInt);
var
  Rot: IRunningObjectTable;
  Hr : HRESULT;
begin
  try
    Hr := GetRunningObjectTable(0, Rot);
    if Succeeded(Hr) then
      Rot.Revoke(RotEntry);
  except
  end;
end;

{------------------------------------------------------------------------------
  Params  : <Index>  Filter index (0 = first)
  Returns : <Result> Name of filter (empty if no filter at index)

  Descript: Get filter name
  Notes   :
 ------------------------------------------------------------------------------}

function TfrmMain.DirectShowGetFilterName(Index: Integer): string;
var
  EnumFilters: IEnumFilters;
  BaseFilter : IBaseFilter;
  FilterInfo : TFilterInfo;
  FilterIndex: Integer;
begin
  if not Assigned(FFilterGraph) then
    Exit;
  Result := '';
  try
    FFilterGraph.EnumFilters(EnumFilters);
    FilterIndex := -1;
    EnumFilters.Reset;
    while (EnumFilters.Next(1, BaseFilter, nil) = S_OK) and (FilterIndex < Index) do
    begin
      BaseFilter.QueryFilterInfo(FilterInfo);
      Result := FilterInfo.achName;
      Inc(FilterIndex);
    end;
    // Make sure an incorrect index returns nothing
    if FilterIndex <> Index then
      Result := '';
  except
  end;
end;

{------------------------------------------------------------------------------
  Params  : <Parent>      Handle of parent to create property page in
            <FilterName>  Name of filter
            <QueryOnly>   True if only to check for property page (not to show)
  Returns : <Result>      True if property page available

  Descript: Show property page of filter
  Notes   :
 ------------------------------------------------------------------------------}

function TfrmMain.DirectShowShowPropertyPage(Parent: THandle; FilterName: WideString; QueryOnly: Boolean): Boolean;
var
  BaseFilter          : IBaseFilter;
//  SpecifyPropertyPages: ISpecifyPropertyPages;
  CAGUID              : TCAGUID;
  FilterInfo          : TFilterInfo;
  Hr                  : HRESULT;
begin
  Result := False;
  if not Assigned(FFilterGraph) then
    Exit;
  try
    // Get filter using the name
    Hr := FFilterGraph.FindFilterByName(PWideChar(FilterName), BaseFilter);
    if Succeeded(Hr) then
    begin
      //    ZeroMemory(@FilterInfo, SizeOf(TFilterInfo));
      // Get property pages
//      Hr := BaseFilter.QueryInterface(IID_ISpecifyPropertyPages, SpecifyPropertyPages);
//      if Succeeded(Hr) then
      begin
        // Get GUID
//        Hr := SpecifyPropertyPages.GetPages(CAGUID);
        Hr := (BaseFilter as ISpecifyPropertyPages).GetPages(CAGUID);
        if Succeeded(Hr) then
        begin
          // Check number of pages available
          if CAGUID.cElems < 1 then
            Exit;
          if not QueryOnly then
          begin
            // Get info
            Hr := BaseFilter.QueryFilterInfo(FilterInfo);
            if Succeeded(Hr) then
            begin
              Hr := OleCreatePropertyFrame(Parent, 0, 0, FilterInfo.achName, 1, @BaseFilter, CAGUID.cElems, CAGUID.pElems, 0, 0, nil);
              if Succeeded(Hr) then
                Result := True;
            end;
          end
          else
            Result := True;
        end;
      end;
    end;
  except
  end;
end;

{------------------------------------------------------------------------------
  Params  : <FilterGraph>  Graph to save as file
            <GraphFile>    Name of graph file
  Returns : <Result>       True if success

  Descript: Save to a DirectShow graph (.GRF) file
  Notes   :
 ------------------------------------------------------------------------------}

function TfrmMain.SaveGraphFile(FilterGraph: IFilterGraph2; GraphFile: AnsiString): Boolean;
var
  Storage: IStorage;
  AStream: IStream;
  Hr     : HRESULT;
  Name   : WideString;
begin
  Result := False;
  try
    if (GraphFile <> '') then
    begin
      // Create document file that will hold the GRF file
      Name := GraphFile;
      Hr := StgCreateDocFile(PWideChar(Name), STGM_CREATE or STGM_TRANSACTED or STGM_READWRITE or STGM_SHARE_EXCLUSIVE, 0, Storage);
      if Succeeded(Hr) then
      try
        // Create a stream to store
        Hr := Storage.CreateStream('ActiveMovieGraph', STGM_WRITE or STGM_CREATE or STGM_SHARE_EXCLUSIVE, 0, 0, AStream);
        if Succeeded(Hr) then
        try
          // Using the IPersisStream.Save method which converts a stream into a persistent object
          Hr := (FilterGraph as IPersistStream).Save(AStream, True);
        finally
          AStream := nil;
        end;
        if Succeeded(Hr) then
          Hr := Storage.Commit(STGC_DEFAULT);
      finally
        Storage := nil;
      end;
      Result := Succeeded(Hr);
    end;
  except
  end;
end;

{------------------------------------------------------------------------------
  Params  : -
  Returns : -

  Descript: Save graph clicked.
  Notes   :
 ------------------------------------------------------------------------------}

procedure TfrmMain.mnuDirectShowSaveGraph(Sender: TObject);
begin
  if Assigned(FFilterGraph) then
    SaveGraphFile(FFilterGraph, 'VIDEO_ACTIVE.GRF')
end;

{------------------------------------------------------------------------------
  Params  : -
  Returns : -

  Descript: DirectShow filter from menu clicked.
  Notes   :
 ------------------------------------------------------------------------------}

procedure TfrmMain.mnuDirectShowClick(Sender: TObject);
var
  NewName: string;
  Ampersand: Integer;
begin
  // Since te caption might include ampersands we have to remove them
  NewName := (Sender as TMenuItem).Caption;
  repeat
    Ampersand := Pos('&', NewName);
    if Ampersand <> 0 then
      Delete(NewName, Ampersand, 1);
  until (Ampersand = 0) or (NewName = '');
  // Show property page, if it fails make it unavailable
  if not DirectShowShowPropertyPage(Self.Handle, NewName, False) then
    (Sender as TMenuItem).Enabled := False;
end;

{------------------------------------------------------------------------------
  Params  : -
  Returns : -

  Descript: Place DirectSHow filters in menu
  Notes   :
 ------------------------------------------------------------------------------}

procedure TfrmMain.DirectShowFiltersAddToMenu;
var
  Index     : Integer;
  FilterName: string;
  AMenuItem : TMenuItem;
begin
  Index := 0;
  mnuDirectShowFilters.Clear;
  repeat
    FilterName := DirectShowGetFilterName(Index);
    if FilterName <> '' then
    begin
      AMenuItem := TMenuItem.Create(Self);
      AMenuItem.Caption := FilterName; // Note: This adds an ampersand!!
      AMenuItem.OnClick := mnuDirectShowClick;
      AMenuItem.Hint := 'Click on the filter to show the property page (if available)';
      AMenuItem.Enabled := DirectShowShowPropertyPage(Self.Handle, FilterName, True);
      mnuDirectShowFilters.Add(AMenuItem);
      mnuDirectShowFilters.Enabled := True;
      mnuDirectShowFilters.Visible := True;
    end;
    Inc(Index);
  until FilterName = '';
  if mnuDirectShowFilters.Enabled then
  begin
    // Add 'Save ... graph'
    AMenuItem := TMenuItem.Create(Self);
    AMenuItem.Caption := '&Save graph file';
    AMenuItem.OnClick := mnuDirectShowSaveGraph;
    AMenuItem.Hint := 'This will save the active DirectShow graph to VIDEO_ACTIVE.GRF';
    AMenuItem.Enabled := True;
    mnuDirectShowFilters.Add(AMenuItem);
  end;
end;



procedure TfrmMain.FormCreate(Sender: TObject);
var
  Hr          : HRESULT;
  EnumFilters : IEnumFilters;
  AllPins     : array[0..99] of IPin;
  AllPinsCount: Integer;
  BaseFilter  : IBaseFilter;
  PinsEnum    : IEnumPins;
  Pins        : IPin;
  Index1      : Integer;
  FilterState : TFilterState;
begin
  // Create the filter graph manager
  // Note: Very minor error checking ...
  Hr := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FFilterGraph);
  if Failed(Hr) then
    Close;
  // Add graph to ROT (so with GraphEdit we can connect with the running graph)
  AddToRot(FFilterGraph, FRotEntry);

  // Create the push source filter
  Hr := CoCreateInstance(CLSID_MajorPushSource, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FFilterPushSourceFilter);
  if Failed(Hr) then
    Close;
  // Add the filter to the graph
  Hr := FFilterGraph.AddFilter(FFilterPushSourceFilter, 'Major Push Source');
  if Failed(Hr) then
    Close;
  // Get the interface to the filter
  Hr := FFilterPushSourceFilter.QueryInterface(T_IID_MajorPushSource, FFilterPushSourceInterface);
  if Failed(Hr) then
    Exit;

  // Modify buffer and/or media settings -before- connecting the pins
  // Here we request a buffer of 256000, with an alignment of 256 -->
  // because of the alignment of 256 the buffer will most likely become 249856
  // or 250112 bytes in length ...
  FFilterPushSourceInterface.SetBufferSize(250000, 256);

  // Render (connect) all pins in the graph
  // We first enumerate (go through) all filters and record them
  Hr := FFilterGraph.EnumFilters(EnumFilters);
  AllPinsCount := 0;
  // If we don't retrieve all filters/pins before rendering them, then we will not get all filters for some reason
  if Succeeded(Hr) then
  begin
    EnumFilters.Reset;
    while EnumFilters.Next(1, BaseFilter, nil) = S_OK do
    begin
      Hr := BaseFilter.EnumPins(PinsEnum);
      if Succeeded(Hr) then
      begin
        PinsEnum.Reset;
        while PinsEnum.Next(1, Pins, nil) = S_OK do
        begin
          AllPins[AllPinsCount] := Pins;
          Inc(AllPinsCount);
        end;
        Pins := nil;
      end;
    end;
    EnumFilters := nil;
  end;
  // We now have all the filters with their pins, so render then
  if AllPinsCount > 0 then
    for Index1 := 0 to AllPinsCount - 1 do
    begin
      // Try using RenderEx but fall back on Render if fails 
      Hr := FFilterGraph.RenderEx(AllPins[Index1], AM_RENDEREX_RENDERTOEXISTINGRENDERERS, nil);
      if Failed(Hr) then
        FFilterGraph.Render(AllPins[Index1]);
      AllPins[Index1] := nil;
    end;

  // Assume that the graph is now connected

  // Run the graph
  (FFilterGraph as IMediaControl).Run;
  // Get the state (this way we know for sure that the previous .Run
  // command has been executed, since it wait for it to complete) 
  (FFilterGraph as IMediaControl).GetState(1000, FilterState);

  // Add the filters of the ceated graph to our menu, so we can access the
  // property pages
  DirectShowFiltersAddToMenu;
end;


procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(FPushThread) then
  begin
    FPushThread.Terminate;
    FPushThread.Resume;
    FPushThread.WaitFor;
    FreeAndnil(FPushThread);
  end;
  if Assigned(FFilterGraph) then
  begin
    (FFilterGraph as IMediaControl).Stop;
    FFilterGraph.Abort;
    RemoveFromRot(FRotEntry);
    FFilterGraph := nil;
  end;
  FFilterPushSourceInterface := nil;
  FFilterPushSourceFilter := nil;
end;


procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
  Close;
end;


procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;


procedure TfrmMain.btnFileClick(Sender: TObject);
begin
  if Assigned(FPushThread) then
  begin
    FPushThread.FEndOfStream := True;
    FPushThread.Terminate;
    // rest handled by timer
  end
  else
  begin
    if dlgOpen.Execute then
    begin
      FPushThread := TPushThread.Create(True);
      FPushThread.FSourceFilter := FFilterPushSourceInterface;
      FPushThread.FFileName     := dlgOpen.FileName;
      FPushThread.Resume;
      lblMessage.Caption := 'Pushing file started';
      btnFile.Caption := 'Stop push';
    end;
  end;
end;


procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  Pushed: Integer;
  Info  : PChar;
begin
  // Check for pushing of a file
  if btnFile.Caption <> 'Push TS file' then
  begin
    if Assigned(FPushThread) then
    begin
      lblPushed.Caption := format('%d', [FPushThread.FPushed]);
      lblDelivered.Caption := format('%d', [FPushThread.FDelivered]);
      // If pushing the file has been terminated, check for error (not FEndOfStream)
      if FPushThread.Terminated then
      begin
        if not FPushThread.FEndOfStream then
          lblMessage.Caption := 'Pushing file data terminated (e.g. incorrect data)'
        else
          lblMessage.Caption := 'Pushing file data ended (end of stream)';
        FreeAndnil(FPushThread);
        btnFile.Caption := 'Push TS file';
      end;
    end
    else
      btnFile.Caption := 'Push TS file';
  end;

  if FFilterPushSourceInterface.GetDeliveredCount(Pushed) = S_OK then
    lblTotalDelivered.Caption := format('%d', [Pushed])
  else
    lblTotalDelivered.Caption := 'Output pin connected?';

  GetMem(Info, 128);
  try
    FFilterPushSourceInterface.GetInformation(Info);
    if Length(Info) > 0 then
      lblMessage.Caption := Info;
  finally
    FreeMem(Info);
  end;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : -

  Descript: Push data from file (thread).
  Notes   : Only has some real effect when the graph is running!
 ------------------------------------------------------------------------------}
procedure TPushThread.Execute;
var
  FileStream     : TFilestream;
  FileBuffer     : Pointer;
  FileBufferSize : Integer;
  BufferAlignment: Integer;
  DataRead       : Longint;
  Delivered      : Integer;
begin
  try
    // Indicate abnormal ending
    FEndOfStream := False;
    FDelivered   := 0;
    FPushed      := 0;
    // Open file
    FileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone);
    if Assigned(FileStream) then
    try
      // Get buffer size to use for pushing
      FSourceFilter.GetBufferSize(FileBufferSize, BufferAlignment);
      // Make sure data will be re-aligned
      FSourceFilter.FlushData;
      // Allocate buffer for file data (we upload the same size as is used by
      // the media sample, wich is the most efficient)
      GetMem(FileBuffer, FileBufferSize);
      if Assigned(FileBuffer) then
      try
        // Wait until file pushed or terminated elsewhere
        while not Terminated do
        begin
          Sleep(10);
          // Read data from file
          DataRead := FileStream.Read(FileBuffer^, FileBufferSize);
          if DataRead <> 0 then
          begin
            // Push the data but terminate when some error occurs
            // (e.g. when the graph is not running)
            Inc(FPushed, DataRead);
            if FSourceFilter.PushData(FileBuffer, DataRead, Delivered) <> S_OK then
              Terminate;
            Inc(FDelivered, Delivered);
          end
          else
          begin
            Terminate;
            // Indicate normal ending
            FEndOfStream := True;
          end;
        end;
      finally
        FreeMem(FileBuffer);
      end;
    finally
      FreeAndNil(FileStream);
    end;
  except
  end;
end;


end.
