{******************************************************************************}
{ FileName............: MajorPushSourceUnit001                                 }
{ Project.............: DirectShow                                             }
{ Author(s)...........: MM                                                     }
{ Version.............: 2.00                                                   }
{------------------------------------------------------------------------------}
{  DirectShow push source filter                                               }
{                                                                              }
{  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. }
{                                                                              }
{------------------------------------------------------------------------------}
{                                                                              }
{ Version   Date   Comment                                                     }
{  1.00   20060115 - Initial release                                           }
{  2.00   20060922 - UDP input added                                           }
{                  - save/restore of settings                                  }
{                  - Sync option added                                         }
{                  - New interfaces because of added methods                   }
{                  - Interfaces are now checked against 'nil' instead with     }
{                    Assigned()                                                }
{                  - Turbo Delphi 2006 Explorer (which is 'free') used instead }
{                    of Delphi 5                                               }
{                    Note: some external code still used instead of            }
{                          'integrated' code                                   }
{******************************************************************************}
unit MajorPushSourceUnit001;

interface
uses
  ActiveX,
  IdGlobal,
  IdSocketHandle,
  IdUDPServer,
  Registry,
  BaseClass,
  Classes,
  DirectShow9,
  Messages,
  SysUtils,
  Windows;


const
  CVersion    = $0200;
  CBuild      = $20060922;
  CPacketSize = 188;
  CSyncByte   = $47;

  IID_IPersistStream                     : TGUID = '{0000010C-0000-0000-C000-000000000046}';
  IID_ISpecifyPropertyPages              : TGUID = '{B196B28B-BAB4-101A-B69C-00AA00341D07}';

  // Interfaces for the outside world (yes, not randomly created ....)
  IID_MajorPushSource                            = '{6D616A6F-7269-7479-6E6C-535243020200}';
  T_IID_MajorPushSource                  : TGUID = IID_MajorPushSource;

  // Classes
  CLSID_MajorPushSource                  : TGUID = '{6D616A6F-7269-7479-6E6C-535243000200}';
  CLSID_MajorPushSourcePropertyPage      : TGUID = '{6D616A6F-7269-7479-6E6C-535243010200}';
  CLSID_MajorPushSourcePropertyPageAbout : TGUID = '{6D616A6F-7269-7479-6E6C-535243FF0200}';

  SudPinTypes : TRegPinTypes =
    (clsMajorType: @MEDIATYPE_NULL;
     clsMinorType: @MEDIASUBTYPE_None);

  SudPins : array[0..0] of TRegFilterPins =
    ((strName: 'Output'; bRendered: FALSE; bOutput: TRUE;  bZero: FALSE; bMany: FALSE; oFilter: nil; strConnectsToPin: ''; nMediaTypes: 1; lpMediaType: @SudPinTypes));


type
  // Simple object with fixed number of informational messages to hold/retrieve
  TInformation = class
    FInformation: array[0..127] of AnsiString;
    FInfoIn     : Integer;
    FInfoOut    : Integer;
    FInfoCount  : Integer;
    function  GetInformation: AnsiString;
    procedure SetInformation(Value: AnsiString);
  public
    constructor Create;
    destructor  Destroy; override;
    property    Information: AnsiString read GetInformation write SetInformation;
    property    Count      : Integer    read FInfoCount;
  end;

{------------------------------------------------------------------------------
  Descript: External access interface
 ------------------------------------------------------------------------------}
  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;


{------------------------------------------------------------------------------
  Descript: Output pin
 ------------------------------------------------------------------------------}
  TMajorPushSourceOutputPin = class(TBCSourceStream)
  protected
    FSharedState     : TBCCritSec;
    FInformation     : TInformation;
    FPushPinDataCount: Integer;
  public
    constructor Create(const ObjectName: AnsiString; out hr: HRESULT; Filter: TBCSource; const Name: WideString);
    destructor  Destroy; override;
    function  GetMediaType(MediaType: PAMMediaType): HRESULT; override;
    function  CheckMediaType(MediaType: PAMMediaType): HRESULT; override;
    function  DecideBufferSize(Alloc: IMemAllocator; propInputRequest: PAllocatorProperties): HRESULT; override;

    function  ThreadProc: Dword; override;
    function  FillBuffer(Sample: IMediaSample): HRESULT; override;
  end;


{------------------------------------------------------------------------------
  Descript: The filter
  Notes   : The <IPersistStream> is required to make the filter 'saveable'
            and 'loadable' (eg. to save/restore settings)
            The <IPersistStream> retains our settings.
 ------------------------------------------------------------------------------}
  TMajorPushSource = class(TBCSource, IMajorPushSource, ISpecifyPropertyPages, IPersistStream)
  private
    FThisInstance    : Integer;
    FPushPin         : TMajorPushSourceOutputPin;          // The push source output pin
    FInformation     : TInformation;                       // Information
    FLogStream       : TFileStream;                        // Filestream for information log
    FAddTimestamps   : Boolean;                            // True will add timestamps to media samples
    FLastTimestamp   : TReferenceTime;                     // Last used timestamp
    FMediaTypeMajor  : TCLSID;                             // Major  media type to use
    FMediaTypeMinor  : TCLSID;                             // Minor  media type to use
    FMediaTypeFormat : TCLSID;                             // Format media type to use
    FMediaTypeCheck  : Boolean;                            // True will check for correct media type
    FBufferSize      : Integer;                            // Total buffer size
    FBufferAlignment : Integer;                            // Alignment of buffer
    FBufferSizeD     : Integer;                            // Total -decided- buffer size
    FBufferAlignmentD: Integer;                            // Decided alignment of buffer (not necessarily active!)
    FSyncData        : Boolean;                            // Synchronziation to use or not
    FSyncOutOfSync   : Integer;                            // Counts invalid sync at start buffer
    FUdpServer       : TIdUdpServer;                       // UDP object
    FUdpPort         : Integer;                            // UDP port to listen to
    FUdpBufferSize   : Integer;                            // UDP buffersize (<0 will use intermediate buffering)
    FUseIni          : Boolean;                            // Use saved settings or not
    FStreamIniLoaded : Boolean;                            // Indicates settings loaded from stream
    // Media sample buffer
    FPushSample      : IMediaSample;                       // The media sample for pushing data to
    FPushIn          : Integer;                            // Bytes already in input buffer
    FPushInSize      : Integer;                            // Bytes available in input buffer
    FPushInPtr       : PByte;                              // Pointer to input buffer
    // Pushed data buffer
    FPushedDataLock  : TBCCritSec;                         // Lock for pushed data buffer
    FPushedInPtr     : PByte;                              // Pointer to begin input buffer
    FPushedIn        : Integer;                            // Bytes already in input buffer
    FPushedInSize    : Integer;                            // Bytes available in input buffer
    FPushedInPtrPtr  : PByte;                              // Current pointer into input buffer
  protected
  public
    constructor Create(ObjName: AnsiString; unk: IUnknown; out hr: HRESULT);
    constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
    destructor  Destroy; override;

    // Required methods to implement (Source)

    // <ISpecifyPropertyPages>
    function    GetPages(out Pages: TCAGUID): HRESULT;    stdcall;

    // <IPersistStream>
    function    IsDirty: HRESULT; stdcall;
    function    Load(const stm: IStream): HRESULT; stdcall;
    function    Save(const stm: IStream; fClearDirty: BOOL): HRESULT; stdcall;
    function    GetSizeMax(out cbSize: Largeint): HRESULT; stdcall;

    // Specials
    function    NonDelegatingQueryInterface(const IID: TGUID; out Obj): HRESULT; override;

    // External accessible functions
    function  GetVersionInformation(out Info: PChar): HRESULT; stdcall;
    function  GetInformation       (out Info: PChar): HRESULT; stdcall;
    function  GetInformationCount  (out Count: Integer): HRESULT; stdcall;
    function  GetDeliveredCount    (out Count: Integer): HRESULT; stdcall;
    procedure SetLog               (OnOff: Boolean); stdcall;
    function  GetLog               (out OnOff: Boolean): HRESULT; stdcall;
    procedure SetSyncData          (OnOff: Boolean); stdcall;
    function  GetSyncData          (out OnOff: Boolean): HRESULT; stdcall;
    procedure SetUdp               (Port: Integer; BufferSize: Integer); stdcall;
    function  GetUdp               (out Port: Integer; out BufferSize: Integer): HRESULT; stdcall;
    procedure SetAddTimestamps     (OnOff: Boolean); stdcall;
    function  GetAddTimestamps     (out OnOff: Boolean): HRESULT; stdcall;
    procedure SetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; CheckType: Boolean); stdcall;
    function  GetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; out CheckType: Boolean): HRESULT; stdcall;
    procedure SetBufferSize        (BufferSize: Integer; BufferAlignment: Integer); stdcall;
    function  GetBufferSize        (out BufferSize: Integer; out BufferAlignment: Integer): HRESULT; stdcall;
    function  GetPushedData        (Buffer: PByte; Size: Integer): HRESULT; stdcall;
    procedure FlushData; stdcall;
    function  PushData             (Buffer: PByte; Size: Integer; out Delivered: Integer): HRESULT; stdcall;

    // Internal functions
    procedure OnUdpReadEvent(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
    procedure ToLog(Logstring: AnsiString);
    function  SaveSettings(const stm: IStream): HRESULT;
    function  LoadSettings(const stm: IStream): HRESULT;
  published
  end;


var
  InstanceCount: Integer;

implementation


{------------------------------------------------------------------------------
  Params  : <AString>  string to convert
  Returns : <Result>   Converted from string
                       Result is GUID_NULL if an error is detected

  Descript: Convert string to CLSID (== StringFromCLSID equivalent)
  Notes   :
 ------------------------------------------------------------------------------}
function StringToClsid(AString: AnsiString): TCLSID;
var
  Error: Integer;
begin
  Error := 0;
  if Error = 0 then
    Val('$' + Copy(AString, 2, 8), Result.D1, Error);
  if Error = 0 then
    Val('$' + Copy(AString, 11, 4), Result.D2, Error);
  if Error = 0 then
    Val('$' + Copy(AString, 16, 4), Result.D3, Error);
  if Error = 0 then
    Val('$' + Copy(AString, 21, 2), Result.D4[0], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 23, 2), Result.D4[1], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 26, 2), Result.D4[2], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 28, 2), Result.D4[3], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 30, 2), Result.D4[4], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 32, 2), Result.D4[5], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 34, 2), Result.D4[6], Error);
  if Error = 0 then
    Val('$' + Copy(AString, 36, 2), Result.D4[7], Error);
  if Error <> 0 then
    Result := GUID_NULL;
end;


{------------------------------------------------------------------------------
  Params  : <AClsid>  CLSID to convert
  Returns : <Result>  Converted to string

  Descript: Convert CLSID to string
  Notes   :
 ------------------------------------------------------------------------------}
function ClsidToString(AClsid: TCLSID): AnsiString;
begin
  Result := format('{%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
              [AClsid.D1,    AClsid.D2,    AClsid.D3,
               AClsid.D4[0], AClsid.D4[1],
               AClsid.D4[2], AClsid.D4[3], AClsid.D4[4],
               AClsid.D4[5], AClsid.D4[6], AClsid.D4[7]]);
end;


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

  Descript: Create the information object.
  Notes   :
 ------------------------------------------------------------------------------}
constructor TInformation.Create;
begin
  inherited Create;

  FInfoIn    := 0;
  FInfoOut   := FInfoIn;
  FInfoCount := 0;
end;


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

  Descript: Destroy the information object.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TInformation.Destroy;
begin
  inherited Destroy;
end;


{------------------------------------------------------------------------------
  Params  :
  Returns : <Result>  Empty if no information

  Descript: Get information.
  Notes   :
 ------------------------------------------------------------------------------}
function TInformation.GetInformation: AnsiString;
begin
  if FInfoOut = FInfoIn then
  begin
    Result := '';
    Exit;
  end;
  Result := FInformation[FInfoOut];
  Inc(FInfoOut);
  if FInfoOut > High(FInformation) then
    FInfoOut := Low(FInformation);
end;


{------------------------------------------------------------------------------
  Params  : <Value>   Information to add
  Returns : -

  Descript: Set information.
  Notes   :
 ------------------------------------------------------------------------------}
procedure TInformation.SetInformation(Value: AnsiString);
begin
  FInformation[FInfoIn] := Value;
  Inc(FInfoCount);
  if FInfoCount = MaxInt then
    FInfoCount := 0;
  Inc(FInfoIn);
  if FInfoIn > High(FInformation) then
    FInfoIn := Low(FInformation);
end;


{------------------------------------------------------------------------------
  Params  : <ObjectName>  Name of the object
            <Filter>      Filter
            <Name>        Name of the pin to create
  Returns : <Hr>          Result of function

  Descript: Create the output pin.
  Notes   :
 ------------------------------------------------------------------------------}
constructor TMajorPushSourceOutputPin.Create(const ObjectName: AnsiString; out hr: HRESULT; Filter: TBCSource; const Name: WideString);
begin
  inherited Create(ObjectName, hr, Filter, Name);
  FSharedState      := TBCCritSec.Create;
  FInformation      := TInformation.Create;
  FPushPinDataCount := 0;
end;


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

  Descript: Destroy the output pin.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TMajorPushSourceOutputPin.Destroy;
begin
  if Assigned(FInformation) then
    FreeAndNil(FInformation);
  if Assigned(FSharedState) then
    FreeAndNil(FSharedState);

  inherited Destroy;
end;


{------------------------------------------------------------------------------
  Params  : <MediaType>  Object receiving the media type.
  Returns : <Result>     Result (S_OK)

  Descript: Get preferred media type of output pin.
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
function TMajorPushSourceOutputPin.GetMediaType(MediaType: PAMMediaType): HRESULT;
begin
  FFilter.StateLock.Lock;              // Note: FFilter is the parent
  try
    MediaType.MajorType            := TMajorPushSource(FFilter).FMediaTypeMajor;
    MediaType.SubType              := TMajorPushSource(FFilter).FMediaTypeMinor;
    MediaType.bFixedSizeSamples    := True;
    MediaType.lSampleSize          := 0;
    MediaType.bTemporalCompression := False;
    MediaType.FormatType           := TMajorPushSource(FFilter).FMediaTypeFormat;
    MediaType.cbFormat             := 0;
    MediaType.pbFormat             := nil;
    FInformation.Information := 'Pin:GetMediaType major  type: ' + ClsidToString(MediaType.MajorType);
    FInformation.Information := 'Pin:GetMediaType minor  type: ' + ClsidToString(MediaType.SubType);
    FInformation.Information := 'Pin:GetMediaType format type: ' + ClsidToString(MediaType.FormatType);
    Result := S_OK;
  finally
    FFilter.StateLock.Unlock;
  end;
end;


{------------------------------------------------------------------------------
  Params  : <MediaType>  Pointer to media type object with the proposed media
                         type
  Returns : <Result>     S_OK    if correct media type (if checked)
                         S_FALSE if incorrect media type

  Descript: Check media type of output pin.
  Notes   : DirectShow
            The GUID is only checked if both GUIDs are not 'null'.
 ------------------------------------------------------------------------------}
function TMajorPushSourceOutputPin.CheckMediaType(MediaType: PAMMediaType): HRESULT;
begin
  FInformation.Information := 'Pin:CheckMediaType major  type: ' + ClsidToString(MediaType.MajorType);
  FInformation.Information := 'Pin:CheckMediaType minor  type: ' + ClsidToString(MediaType.SubType);
  FInformation.Information := 'Pin:CheckMediaType format type: ' + ClsidToString(MediaType.FormatType);
  if  TMajorPushSource(FFilter).FMediaTypeCheck then
  begin
    FFilter.StateLock.Lock;              // Note: FFilter is the parent
    try
      Result := S_FALSE;
      if (not IsEqualGUID(MediaType.MajorType, GUID_NULL)) and
         (not IsEqualGUID(TMajorPushSource(FFilter).FMediaTypeMajor, GUID_NULL)) then
        if not IsEqualGUID(MediaType.MajorType, TMajorPushSource(FFilter).FMediaTypeMajor) then
          Exit;
      if (not IsEqualGUID(MediaType.SubType, GUID_NULL)) and
         (not IsEqualGUID(TMajorPushSource(FFilter).FMediaTypeMinor, GUID_NULL)) then
        if not IsEqualGUID(MediaType.SubType, TMajorPushSource(FFilter).FMediaTypeMinor) then
          Exit;
      if (not IsEqualGUID(MediaType.FormatType, GUID_NULL)) and
         (not IsEqualGUID(TMajorPushSource(FFilter).FMediaTypeFormat, GUID_NULL)) then
        if not IsEqualGUID(MediaType.FormatType, TMajorPushSource(FFilter).FMediaTypeFormat) then
          Exit;
    finally
      FFilter.StateLock.Unlock;
    end;
  end;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <Alloc>            Pointer to allocaters interface
            <propInpuRequest>  Input pin buffer requirements
  Returns :

  Descript: Place data in output pin buffer
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
function TMajorPushSourceOutputPin.DecideBufferSize(Alloc: IMemAllocator; propInputRequest: PAllocatorProperties): HRESULT;
var
  Actual: TAllocatorProperties;
begin
  FFilter.StateLock.Lock;              // Note: FFilter is the parent
  try
    Result := E_FAIL;
    if Alloc = nil then
      Exit;
    if propInputRequest = nil then
      Exit;
    // Ensure a minimum number of buffers
    if propInputRequest.cBuffers = 0 then
      propInputRequest.cBuffers := 1;
    propInputRequest.cbBuffer := TMajorPushSource(FFilter).FBufferSize;
    propInputRequest.cbAlign  := TMajorPushSource(FFilter).FBufferAlignment;
    propInputRequest.cbPrefix := 0;
    // Specify our buffer requirements
    Result := Alloc.SetProperties(propInputRequest^, Actual);
    if Failed(Result) then
      Exit;
    if (Actual.cBuffers < propInputRequest.cBuffers) then
      Result := E_FAIL
    else
      Result := S_OK;
    // Record decided parameters
    TMajorPushSource(FFilter).FBufferAlignmentD := Actual.cbAlign;
    TMajorPushSource(FFilter).FBufferSizeD      := Actual.cbBuffer;
    FInformation.Information := format('DecideBufferSize: %d bytes buffer, %d bytes alignment', [Actual.cbBuffer, Actual.cbAlign]);
  finally
    FFilter.StateLock.Unlock;
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Sample>  Pointer to an empty media sample interface
  Returns : <Result>  S_FALSE if end of stream
                      S_OK if success

  Descript: Our own ThreadProc (with very small exceptions equal to original
            ThreadProc code from BaseClasses).
  Notes   : This one does not call DoBufferProcessingLoop, so we can deliver
            samples elsewhere.
 ------------------------------------------------------------------------------}
function TMajorPushSourceOutputPin.ThreadProc: Dword;
var
  com, cmd: TThreadCommand;
begin
  repeat
    com := GetRequest;
    if (com <> CMD_INIT) then
      FThread.Reply(DWORD(E_UNEXPECTED));
  until (com = CMD_INIT);

  Result := OnThreadCreate; // perform set up tasks
  if FAILED(Result) then
  begin
    OnThreadDestroy();
    FThread.Reply(Result);	// send failed return code from OnThreadCreate
    Result := 1;
    Exit;
  end;

  // Initialisation succeeded
  FThread.Reply(NOERROR);
  repeat
    cmd := GetRequest;
    // "repeat..until false" ensures, that if cmd = CMD_RUN
    // the next executing block will be CMD_PAUSE handler block.
    // This corresponds to the original C "switch" functionality
    repeat
      sleep(50);     // Added (no visible effects though ....?? )
      case cmd of
        CMD_EXIT, CMD_STOP:
          begin
            FThread.Reply(NOERROR);
            Break;
          end;
        CMD_RUN:
          begin
            cmd := CMD_PAUSE;
          end;
        CMD_PAUSE:
          begin
            FThread.Reply(NOERROR);
// Delvering samples done elsewhere....    Original code here: DoBufferProcessingLoop;
            Break;
          end;
      else
        FThread.Reply(DWORD(E_NOTIMPL));
        Break;
      end;
    until False;
  until (cmd = CMD_EXIT);
  Result := OnThreadDestroy;	// tidy up.
  if FAILED(Result) then
  begin
    Result := 1;
    Exit;
  end;
  Result := 0;
end;


{------------------------------------------------------------------------------
  Params  : <Sample>  Pointer to an empty media sample interface
  Returns : <Result>  S_FALSE if end of stream
                      S_OK if success

  Descript: Fill a media sample with data.
  Notes   : DirectShow
            The source stream class has the DoBufferProcessingLoop method
            which calls this function in a loop (this loop ends if a
            media sample is rejected; the FillBuffer returns S_FALSE or a
            stop request is received).
            The filter graph must set to 'run' to have this function called.
            Note that because we have called 'Inactive' when we created the
            pin this will never be called.
            If the DoBufferProcessingLoop was running then we have to either
            return S_OK or S_FALSE. Unfortunately, with S_OK we also deliver
            a sample, and with S_FALSE we stop the graph running ....
            Because ThreadProc is overridden in our code, this code is no
            longer executed. However, it still exists so when the original
            ThreadProc is used the code still functions.
 ------------------------------------------------------------------------------}
function TMajorPushSourceOutputPin.FillBuffer(Sample: IMediaSample): HRESULT;
begin
//  FInformation.Information := 'TMajorPushSourceOutputPin.FillBuffer';
//  Result := S_OK;
  // Since we are not using the FillBuffer, but handle the uploading ourselves,
  // we give a negative result which stops calling FillBuffer.
  // However, this alos stops the graph .... when called from withn GraphEdit.
  Result := S_FALSE;
end;


{------------------------------------------------------------------------------
  Params  : <ObjName>  Object name
            <Unk>      Interface
  Returns : <hr>       Result

  Descript: Create filter.
  Notes   :
 ------------------------------------------------------------------------------}
constructor TMajorPushSource.Create(ObjName: AnsiString; unk: IUnknown; out hr: HRESULT);
var
  MajorType      : TCLSID;
  MinorType      : TCLSID;
  FormatType     : TCLSID;
begin
  inherited Create(ObjName, unk, CLSID_MajorPushSource, hr);

  FThisInstance := InterlockedIncrement(InstanceCount);
  FLogStream   := nil;

  FUdpServer   := nil;
  FUdpPort     := -1;

  FPushSample := nil;
  FPushInPtr  := nil;
  FPushIn     := 0;
  FPushInSize := 0;

  FPushedDataLock := TBCCritSec.Create;
  FPushedInPtrPtr := nil;
  FPushedIn       := 0;
  FPushedInSize   := 0;
  FPushedInPtr    := nil;

  FSyncOutOfSync  := 0;

  // Create our output pin
  FPushPin := TMajorPushSourceOutputPin.Create(ObjName, hr, Self, 'Output');
  if not Assigned(FPushPin) then
    hr := S_FALSE;

  // Set default settings
  FUseIni          := True;
  FStreamIniLoaded := False;
  MajorType        := MEDIATYPE_Stream;
  MinorType        := MEDIASUBTYPE_MPEG2_TRANSPORT;
  FormatType       := GUID_NULL;
  SetMediaType(@MajorType, @MinorType, @FormatType, False);
  SetSyncData(False);
  SetBufferSize(188 * 512, 188);
  SetAddTimestamps(False);
  SetLog(False);
  SetUdp(0, 0);

  FInformation := TInformation.Create;

  LoadSettings(nil);                         // Load registry settings and 'activate' the settings
end;


{------------------------------------------------------------------------------
  Params  : <Factory>
            <Controller>
  Returns : <hr>

  Descript: Create from factory.
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
constructor TMajorPushSource.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
var
  hr: HRESULT;
begin
  Create(Factory.Name, Controller, hr);
end;


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

  Descript: Destructor.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TMajorPushSource.Destroy;
begin
  // Save current settings
  SaveSettings(nil);

  SetLog(False);
  // Release all created instances/objects
  if Assigned(FUdpServer) then
    FreeAndNil(FUdpServer);
  if Assigned(FInformation) then
    FreeAndNil(FInformation);
  if Assigned(FPushSample) then
    FPushSample := nil;
  if Assigned(FPushPin) then
    FreeAndNil(FPushPin);
  if Assigned(FPushedInPtr) then
    FreeMem(FPushedInPtr);
  FPushedInPtr    := nil;
  FPushedInPtrPtr := nil;
  if Assigned(FPushedDataLock) then
    FreeAndNil(FPushedDataLock);

  inherited;
end;


{------------------------------------------------------------------------------
  Params  : <Sender>    Server generating the event
            <AData>     Buffer containing new data (dynamic array)
            <ABinding>  Socket binding receiving the data
  Returns : -

  Descript: Event triggered when data has been received from the UDP connection
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.OnUdpReadEvent(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
var
  Delivered: Integer;
begin
  PushData(@AData[0], Length(AData), Delivered);
end;


{------------------------------------------------------------------------------
  Params  : <LogString>  Text to output to log file
  Returns : -

  Descript: Put text to log file
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.ToLog(LogString: AnsiString);
var
  NewLog: AnsiString;
begin
  if Assigned(FInformation) then
    FInformation.Information := LogString;
  if not Assigned(FLogStream) then
    Exit;
  NewLog := FormatDateTime('YYYYMMDD"T"HHMMSS"  "', Now) + LogString + #13#10;
  FLogStream.Write(NewLog[1], Length(NewLog));
end;


{------------------------------------------------------------------------------
  Params  : <stm>     Stream interface
                      If stream interface is not assigned then settings are loaded
                      from the registry
  Returns : <Result>  S_OK if no error

  Descript: Load settings (from INI or stream == saved graph settings)
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.LoadSettings(const stm: IStream): HRESULT;
var
  AString      : AnsiString;
  ABool        : Boolean;
  ADword       : Dword;
  AnInteger    : Integer;
  AnInteger2   : Integer;
  MajorType    : TCLSID;
  MinorType    : TCLSID;
  FormatType   : TCLSID;
  MajorTypeStr : AnsiString;
  MinorTypeStr : AnsiString;
  FormatTypeStr: AnsiString;
  Buffer       : array[0..MAX_PATH-1] of Char;
  Hr           : HRESULT;
begin
  if stm = nil then
  begin
    // Load from registry
    Hr := S_OK;
    if GetModuleFileName(HInstance, Buffer, MAX_PATH) > 0 then
    begin
      ToLog('Loading settings from registry');
      AString := 'Software\Major\MajorPushSource';
      with TRegIniFile.Create(AString) do
      begin
        FUseIni := ReadBool('', 'UseRegistrySettings', False);
        if FUseIni then
        begin
          GetAddTimestamps(ABool);
          ABool := ReadBool   ('Settings', 'AddTimestamps',  ABool);
          SetAddTimestamps(ABool);

          GetBufferSize(AnInteger, AnInteger2);
          AnInteger  := ReadInteger('Settings', 'BufferSize',      AnInteger);
          AnInteger2 := ReadInteger('Settings', 'BufferAlignment', AnInteger2);
          SetBufferSize(AnInteger, AnInteger2);

          GetLog(ABool);
          ABool := ReadBool   ('Settings', 'Log',  ABool);
          SetLog(ABool);

          GetMediaType(@MajorType, @MinorType, @FormatType, ABool);
          FormatTypeStr := ClsidToString(FormatType);
          MajorTypeStr  := ClsidToString(MajorType);
          MinorTypeStr  := ClsidToString(MinorType);
          FormatTypeStr := ReadString ('Settings', 'MediaFormatType', FormatTypeStr);
          MajorTypeStr  := ReadString ('Settings', 'MediaMajorType',  MajorTypeStr);
          MinorTypeStr  := ReadString ('Settings', 'MediaMinorType',  MinorTypeStr);
          ABool         := ReadBool   ('Settings', 'MediaTypeCheck',  ABool);
          FormatType := StringToClsid(FormatTypeStr);
          MajorType  := StringToClsid(MajorTypeStr);
          MinorType  := StringToClsid(MinorTypeStr);
          SetMediaType(@MajorType, @MinorType, @FormatType, ABool);

          GetSyncData(ABool);
          ABool := ReadBool   ('Settings', 'SyncData',  ABool);
          SetSyncData(ABool);

          GetUdp(AnInteger, AnInteger2);
          AnInteger  := ReadInteger('Settings', 'UdpPort',       AnInteger);
          AnInteger2 := ReadInteger('Settings', 'UdpBufferSize', AnInteger2);
          SetUdp(AnInteger, AnInteger2);
        end;
        Free;
      end;
    end;
  end
  else
  begin
    // Load from stream (graph)
    ToLog('Loading settings from graph');
    FStreamIniLoaded := True;
    Hr := S_OK;
    // The first in the stream is the software version (as per CPersistStream definition)
    if Hr = S_OK then
      Hr := stm.Read(@ADword, SizeOf(ADword), nil);

    // Now the settings (same order as it is being saved)
    if Hr = S_OK then
      Hr := stm.Read(@ABool, SizeOf(ABool), nil);
    if Hr = S_OK then
      SetAddTimestamps(ABool);

    if Hr = S_OK then
      Hr := stm.Read(@AnInteger, SizeOf(AnInteger), nil);
    if Hr = S_OK then
      Hr := stm.Read(@AnInteger2, SizeOf(AnInteger2), nil);
    if Hr = S_OK then
      SetBufferSize(AnInteger, AnInteger2);

    if Hr = S_OK then
      Hr := stm.Read(@ABool, SizeOf(ABool), nil);
    if Hr = S_OK then
      SetLog(ABool);

    FormatTypeStr := ClsidToString(GUID_NULL);
    if Hr = S_OK then
      stm.Read(@FormatTypeStr[1], Length(FormatTypeStr), nil);
    MajorTypeStr := ClsidToString(GUID_NULL);
    if Hr = S_OK then
      stm.Read(@MajorTypeStr[1], Length(MajorTypeStr), nil);
    MinorTypeStr := ClsidToString(GUID_NULL);
    if Hr = S_OK then
      stm.Read(@MinorTypeStr[1], Length(MinorTypeStr), nil);
    if Hr = S_OK then
      Hr := stm.Read(@ABool, SizeOf(ABool), nil);
    FormatType := StringToClsid(FormatTypeStr);
    MajorType  := StringToClsid(MajorTypeStr);
    MinorType  := StringToClsid(MinorTypeStr);
    if Hr = S_OK then
      SetMediaType(@MajorType, @MinorType, @FormatType, ABool);

    if Hr = S_OK then
      Hr := stm.Read(@ABool, SizeOf(ABool), nil);
    if Hr = S_OK then
      SetSyncData(ABool);

    if Hr = S_OK then
      Hr := stm.Read(@AnInteger, SizeOf(AnInteger), nil);
    if Hr = S_OK then
      Hr := stm.Read(@AnInteger2, SizeOf(AnInteger2), nil);
    if Hr = S_OK then
      SetUdp(AnInteger, AnInteger2);
  end;
  Result := Hr;
end;


{------------------------------------------------------------------------------
  Params  : <stm>          Stream interface
                           If stream interface is not assigned then settings are loaded
                           from the registry
  Returns : <Result>       S_OK if no error

  Descript: Load settings (from INI or stream == saved graph settings)
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.SaveSettings(const stm: IStream): HRESULT;
var
  Buffer    : array[0..MAX_PATH-1] of Char;
  AString   : AnsiString;
  ABool     : Boolean;
  ADword    : Dword;
  AnInteger : Integer;
  AnInteger2: Integer;
  MajorType : TCLSID;
  MinorType : TCLSID;
  FormatType: TCLSID;
  Hr        : HRESULT;
begin
  if stm = nil then
  begin
    // We only save these if the filter did not load through a IPersistStream
    // (e.g. loaded graph)
    Hr := S_OK;
    if not FStreamIniLoaded then
    begin
      if GetModuleFileName(HInstance, Buffer, MAX_PATH) > 0 then
      begin
        ToLog('Saving settings to registry');
        AString := 'Software\Major\MajorPushSource';
        with TRegIniFile.Create(AString) do
        begin
          WriteBool   ('', 'UseRegistrySettings',     FUseIni);
          GetAddTimestamps(ABool);
          WriteBool   ('Settings', 'AddTimestamps',   ABool);
          GetBufferSize(AnInteger, AnInteger2);
          WriteInteger('Settings', 'BufferSize',      AnInteger);
          WriteInteger('Settings', 'BufferAlignment', AnInteger2);
          GetLog(ABool);
          WriteBool   ('Settings', 'Log',             ABool);
          GetMediaType(@MajorType, @MinorType, @FormatType, ABool);
          WriteString ('Settings', 'MediaFormatType', ClsidToString(FormatType));
          WriteString ('Settings', 'MediaMajorType',  ClsidToString(MajorType));
          WriteString ('Settings', 'MediaMinorType',  ClsidToString(MinorType));
          WriteBool   ('Settings', 'MediaTypeCheck',  ABool);
          GetSyncData(ABool);
          WriteBool   ('Settings', 'SyncData',        ABool);
          GetUdp(AnInteger, AnInteger2);
          WriteInteger('Settings', 'UdpPort',         AnInteger);
          WriteInteger('Settings', 'UdpBufferSize',   AnInteger2);
          Free;
        end;
      end;
    end;
  end
  else
  begin
    // Saving to the stream
    ToLog('Saving settings to graph');
    Hr := S_OK;
    // The first in the stream is the software version (as per CPersistStream definition)
    ADword := CVersion;
    if Hr = S_OK then
      Hr := stm.Write(@ADword, SizeOf(ADword), nil);

    // Now the settings (alphabetically)
    GetAddTimestamps(ABool);
    if Hr = S_OK then
      Hr := stm.Write(@ABool, SizeOf(ABool), nil);

    GetBufferSize(AnInteger, AnInteger2);
    if Hr = S_OK then
      Hr := stm.Write(@AnInteger, SizeOf(AnInteger), nil);
    if Hr = S_OK then
      Hr := stm.Write(@AnInteger2, SizeOf(AnInteger2), nil);

    GetLog(ABool);
    if Hr = S_OK then
      Hr := stm.Write(@ABool, SizeOf(ABool), nil);

    GetMediaType(@MajorType, @MinorType, @FormatType, ABool);
    AString := ClsidToString(FormatType);
    if Hr = S_OK then
      Hr := stm.Write(@AString[1], Length(AString), nil);
    AString := ClsidToString(MajorType);
    if Hr = S_OK then
      Hr := stm.Write(@AString[1], Length(AString), nil);
    AString := ClsidToString(MinorType);
    if Hr = S_OK then
      Hr := stm.Write(@AString[1], Length(AString), nil);
    if Hr = S_OK then
      Hr := stm.Write(@ABool, SizeOf(ABool), nil);

    GetSyncData(ABool);
    if Hr = S_OK then
      Hr := stm.Write(@ABool, SizeOf(ABool), nil);

    GetUdp(AnInteger, AnInteger2);
    if Hr = S_OK then
      Hr := stm.Write(@AnInteger, SizeOf(AnInteger), nil);
    if Hr = S_OK then
      Hr := stm.Write(@AnInteger2, SizeOf(AnInteger2), nil);
  end;
  Result := Hr;
end;


{------------------------------------------------------------------------------
  Params  : <OnOff>    TRUE to activate log (new file will be created)
                       FALSE to stop log
  Returns : -

  Descript: (De)activate logging mechanism.
  Notes   : Activating an already started logging has no effect.
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetLog(OnOff: Boolean);
begin
  if not OnOff and Assigned(FLogStream) then
  begin
    ToLog('Log stopped');
    FreeAndNil(FLogStream);
  end;
  if OnOff and not Assigned(FLogStream) then
  begin
    FLogStream := TFileStream.Create(FormatDateTime('YYYYMMDD"T"HHMMSS', Now) + '.LOG', fmCreate);
    ToLog('Log started');
  end;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>   S_OK
            <OnOff>    TRUE if activate log
                       FALSE if no active log

  Descript: Get activation logging mechanism.
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetLog(out OnOff: Boolean): HRESULT;
begin
  OnOff  := Assigned(FLogStream);
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <OnOff>    TRUE to activate synchronization on syncbyte $47
                       FALSE if no synchronization to be used
  Returns : -

  Descript: (De)activate synchronization mechanism
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetSyncData(OnOff: Boolean);
begin
  StateLock.Lock;
  try
    // Flush all old data if synchronization is required
    FPushSample    := nil;
    FSyncOutOfSync := 0;
    FSyncData      := OnOff;
  finally
    StateLock.Unlock;
  end;
  if FSyncData then
    ToLog('Synchronization on')
  else
    ToLog('Synchronization off');
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>   S_OK
            <OnOff>    TRUE if synchronization is on
                       FALSE if synchronization is off

  Descript: Get synchronization setting
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetSyncData(out OnOff: Boolean): HRESULT;
begin
  OnOff  := FSyncData;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <Port>        Port to listen on (<=0 deactivates it)
            <BufferSize>  Buffersize to implement for listening
                          0 = default size
  Returns : -

  Descript: Set UDP
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetUdp(Port: Integer; BufferSize: Integer);
var
  Alignment: Integer;
begin
  // Return immediately of nothing to do (settings are identical to current settings)
  if Assigned(FUdpServer) and (Port = FUdpPort) and (BufferSize = FUdpBufferSize) then
    Exit;
  if Assigned(FUdpServer) then
  begin
    // Stop listening
    FUdpServer.Active := False;
    ToLog(format('Listening on UDP port %d stopped', [FUdpPort]));
    FreeAndNil(FUdpServer);
  end;
  FUdpPort       := Port;
  FUdpBufferSize := BufferSize;
  if Port > 0 then
  begin
    // Create the server if object was not yet created
    if not Assigned(FUdpServer) then
    begin
      FUdpServer            := TidUdpServer.Create;
      FUdpServer.OnUdpRead  := OnUdpReadEvent;
    end;
    // Start listening on UDP port
    // An illogical buffersize default to the buffersize used for the output pin
    if BufferSize <= 0 then
      GetBufferSize(BufferSize, Alignment);
    FUdpServer.BufferSize    := BufferSize;
    FUdpServer.ThreadedEvent := True;            // Essential, otherwise 'hanging' when changing port or deactivating
    FUdpServer.DefaultPort := Port;
    FUdpServer.Active      := True;
    ToLog(format('Listening on UDP port %d started, buffer size %d', [FUdpPort, BufferSize]));
  end;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>      S_OK
            <Port>        Active UDP port (<=0 if not active)
            <BufferSize>  Buffer size used for listeneing
  Descript: Get UDP settings
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetUdp(out Port: Integer; out BufferSize: Integer): HRESULT;
begin
  Port       := FUdpPort;
  BufferSize := FUdpBufferSize;
  Result     := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <OnOff>    TRUE to activate timestamps
                       FALSE to deactivate timestamps
  Returns : -

  Descript: (De)activate timestamps.
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetAddTimestamps(OnOff: Boolean);
begin
  FAddTimestamps := OnOff;
  if OnOff then
    ToLog('Timestamps set on')
  else
    ToLog('Timestamps set off');
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>   S_OK
            <OnOff>    TRUE if activate timestamps
                       FALSE if no active timestamps

  Descript: Get activation timestamps mechanism.
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetAddTimestamps(out OnOff: Boolean): HRESULT;
begin
  OnOff  := FAddTimestamps;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <MajorType>   Pointer to structure with major  media type to use
            <MinorType>   Pointer to structure with minor  media type to use
            <FormatType>  Pointer to structure with format media type to use
            <CheckType>   True will check media types (major/minor only)
  Returns : -

  Descript: Set media type to use.
  Notes   : Must be called before the output pin is connected.
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetMediaType(MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; CheckType: Boolean); stdcall;
begin
  if Assigned(MajorType) then
    FMediaTypeMajor  := MajorType^;
  if Assigned(MinorType) then
    FMediaTypeMinor  := MinorType^;
  if Assigned(FormatType) then
    FMediaTypeFormat := FormatType^;
  FMediaTypeCheck := CheckType;
  // Could use StringFromGUID2, but why not do it ourselves
  ToLog('SetMediaType major  type: ' + ClsidToString(FMediaTypeMajor));
  ToLog('SetMediaType minor  type: ' + ClsidToString(FMediaTypeMinor));
  ToLog('SetMediaType format type: ' + ClsidToString(FMediaTypeFormat));
  if FMediaTypeCheck then
    ToLog('SetMediaType type will be checked')
  else
    ToLog('SetMediaType type will not be checked');
end;


{------------------------------------------------------------------------------
  Params  : <MajorType>   Pointer to structure with major  media type to return
            <MinorType>   Pointer to structure with minor  media type to return
            <FormatType>  Pointer to structure with format media type to return
  Returns : <Result>      Result code (S_OK)
            <CheckType>   Type is checked or not

  Descript: Get media type to use.
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetMediaType(MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; out CheckType: Boolean): HRESULT; stdcall;
begin
  if Assigned(MajorType) then
    MajorType^  := FMediaTypeMajor;
  if Assigned(MinorType) then
    MinorType^  := FMediaTypeMinor;
  if Assigned(FormatType) then
    FormatType^ := FMediaTypeFormat;
  CheckType := FMediaTypeCheck;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <BufferSize>       Proposed buffer size
            <BufferAlignment>  Alignment of buffer (0 if none)
  Returns : -

  Descript: Set preferred buffer sizes to use.
  Notes   : Must be called before the output pin is connected.
            Presets the -decided- buffer size/alignment equal to the preferred
            buffer size/alignment.
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.SetBufferSize(BufferSize: Integer; BufferAlignment: Integer); stdcall;
begin
  FBufferSize       := BufferSize;
  FBufferAlignment  := BufferAlignment;
  FBufferSizeD      := FBufferSize;
  FBufferAlignmentD := FBufferAlignment;
  ToLog(format('SetBufferSize, size %d, alignment %d', [FBufferSize, FBufferAlignment]));
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>           S_OK
            <BufferSize>       Decided buffer size
            <BufferAlignment>  Alignment of buffer (0 if none)

  Descript: Get -decided- buffer sizes to use.
  Notes   : This is -not- the preferred buffer size/alignment, but the actual
            buffer size/alignment (assuming the pin has been connected!)
            When the pin has not been connected the returned values are not
            valid (they return the preferred values).
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetBufferSize(out BufferSize: Integer; out BufferAlignment: Integer): HRESULT; stdcall;
begin
  BufferSize      := FBufferSizeD;
  BufferAlignment := FBufferAlignmentD;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  Result
            <Pages>   Property pages GUID

  Descript: Get property pages.
  Notes   : DirectShow
            <ISpecifyPropertyPages>
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetPages(out pages: TCAGUID): HRESULT;
begin
  Pages.cElems := 2;
  Pages.pElems := CoTaskMemAlloc(SizeOf(TGUID) * Pages.cElems);
  if not Assigned(Pages.pElems) then
  begin
    ToLog('TMajorPushSource.GetPages failed');
    Result := E_OUTOFMEMORY;
    Exit;
  end;
  Pages.pElems^[0] := CLSID_MajorPushSourcePropertyPage;
  Pages.pElems^[1] := CLSID_MajorPushSourcePropertyPageAbout;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  S_FALSE if does not need saving
                      S_OK    if needs saving

  Descript: Indicate if a property has changed.
  Notes   : DirectShow
            <IPersistStream>
            Note used
 ------------------------------------------------------------------------------}
function TMajorPushSource.IsDirty: HRESULT;
begin
  Result := S_FALSE;
end;


{------------------------------------------------------------------------------
  Params  : <stm>     Stream data
  Returns : <Result>

  Descript: Load setting data from stream.
  Notes   : DirectShow
            <IPersistStream>
 ------------------------------------------------------------------------------}
function TMajorPushSource.Load(const stm: IStream): HRESULT;
begin
  Result := E_FAIL;
  if stm = nil then
    Exit;
  Result := LoadSettings(stm);
end;


{------------------------------------------------------------------------------
  Params  : <stm>          Stream data
            <fClearDirty>  True reset dirty flag
  Returns : <Result>

  Descript: Save setting data to stream.
  Notes   : DirectShow
            <IPersistStream>
 ------------------------------------------------------------------------------}
function TMajorPushSource.Save(const stm: IStream; fClearDirty: BOOL): HRESULT;
begin
  Result := E_FAIL;
  if stm = nil then
    Exit;
  Result := SaveSettings(stm);
end;

{------------------------------------------------------------------------------
  Params  :
  Returns : <Result>
            <cbSize>  Stream size

  Descript: Needed bytes for stream.
  Notes   : DirectShow
            <IPersistStream>
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetSizeMax(out cbSize: Largeint): HRESULT;
begin
  Result := S_OK;
  cbSize := 100;
end;


{------------------------------------------------------------------------------
  Params  : <IID>
  Returns : <Result>
            <Obj>

  Descript: Support for delegating and non delegating IUnknown interfaces.
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
function TMajorPushSource.NonDelegatingQueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  Result := E_NOINTERFACE;
  // Since we are dealing with 16 byte long types we can not just use '=' on it
  // without typecasting or using <IsEqualGUID> (or simular)
  if IsEqualGUID(IID, T_IID_MajorPushSource) then
  begin
    if GetInterface(IMajorPushSource, Obj) then
    begin
      Result := S_OK;
    end
    else
      ToLog('TMajorPushSource.NonDelegatingQueryInterface IMajorPushSource failed');
    Exit;
  end;
  if IsEqualGUID(IID, IID_ISpecifyPropertyPages) then
  begin
    if GetInterface(ISpecifyPropertyPages, Obj) then
    begin
      Result := S_OK;
    end
    else
      ToLog('TMajorPushSource.NonDelegatingQueryInterface ISpecifyPropertyPages failed');
    Exit;
  end;
  if IsEqualGUID(IID, IID_IPersistStream) then
  begin
    if GetInterface(IPersistStream, Obj) then
    begin
      Result := S_OK;
    end
    else
      ToLog('TMajorPushSource.NonDelegatingQueryInterface IPersistStream failed');
    Exit;
  end;
  Result := inherited NonDelegatingQueryInterface(IID, Obj);
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  S_OK
            <Info>    Informational data

  Descript: Get version information data.
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetVersionInformation(out Info: PChar): HRESULT;
begin
  Result := S_FALSE;
  if not Assigned(Info) then
    Exit;
  StrPCopy(Info, format('V%1.1x.%2.2x, build %x', [CVersion div $100, CVersion mod $100, CBuild]));
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <Info>    Pointer to PCHAR receiving the result (must have enough
                      memory allocated!)
  Returns : <Result>  S_OK
                      S_FALSE  Error (no result pointer)

  Descript: Get information data (also from output pin).
  Notes   : Only new data is returned!
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetInformation(out Info: PChar): HRESULT;
begin
  Result := S_FALSE;
  if not Assigned(Info) then
    Exit;
  StrPCopy(Info, FInformation.Information);
  if Length(Info) = 0 then
    if Assigned(FPushPin) then
      StrPCopy(Info, FPushPin.FInformation.Information);
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  S_OK
            <Count>   Information counter

  Descript: Get information count (also from output pin).
  Notes   : 
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetInformationCount(out Count: Integer): HRESULT;
begin
  Count := FInformation.Count;
  if Assigned(FPushPin) then
    Count := Count + FPushPin.FInformation.Count;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  S_OK
                      S_FALSE  No output pin
            <Count>   Transferred bytes

  Descript: Get information count of delivered data on output pin.
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetDeliveredCount(out Count: Integer): HRESULT;
begin
  Result := S_FALSE;
  if not Assigned(FPushPin) then
    Exit;
  Count := FPushPin.FPushPinDataCount;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <Buffer>  Pointer to buffer receiving the data
            <Size>    Size of the buffer (and new size of acquiring buffer)
                      0 to disable acquiring data
  Returns : <Result>  S_OK

  Descript: Get acquires pushed data (first data of media sample)
  Notes   : If the <Size> is different from the current acquireing size then
            a new buffer is allocated.
 ------------------------------------------------------------------------------}
function TMajorPushSource.GetPushedData(Buffer: PByte; Size: Integer): HRESULT;
begin
  Result := S_OK;
  FPushedDataLock.Lock;
  try
    // New size
    if (Size <> FPushedInSize) then
    begin
      ToLog(format('GetPushedData new size of %d bytes', [Size]));
      if (Size > 0) and Assigned(Buffer) and Assigned(FPushedInPtr) then
      begin
        // Something to copy ....
        // Copy current contents of buffer
        if Size < FPushedInSize then
        begin
          CopyMemory(Buffer, FPushedInPtr, Size);
        end
        else
        begin
          // We have less data than requested: return zero for those
          CopyMemory(Buffer, FPushedInPtr, FPushedInSize);
          Inc(Buffer, FPushedInSize);
          ZeroMemory(Buffer, Size - FPushedInSize);
        end;
      end;
      // Release old buffer
      FreeMem(FPushedInPtr);
      // Allocate new buffer and reset settings
      GetMem(FPushedInPtr, Size);
      FPushedInSize   := Size;
      FPushedInPtrPtr := FPushedInPtr;
      FPushedIn       := 0;
    end
    else
    begin
      // Same size, return buffer contents if buffers exist
      if (Size > 0) and Assigned(Buffer) and Assigned(FPushedInPtr) then
        CopyMemory(Buffer, FPushedInPtr, FPushedInSize);
    end;
  finally
    FPushedDataLock.Unlock;
  end;
end;


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

  Descript: Flush (re-allign) for next data.
  Notes   : Some filters require correctly aligned data. The one pushing
            the data should keep this into mind, but to force a re-alignment
            this procedure can be called. Any old buffer data is discarded.
 ------------------------------------------------------------------------------}
procedure TMajorPushSource.FlushData;
begin
  StateLock.Lock;
  try
    if Assigned(FPushSample) then
      FPushSample := nil;
  finally
    StateLock.Unlock;
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Buffer>     Pointer to buffer data
            <Size>       Size of buffer
  Returns : <Result>     S_OK     if data can be delivered
                         S_FALSE  if an error was detected (e.g. when graph
                                  not running etc).
            <Delivered>  Bytes actually delivered through media sample
                         (note: not necessarily equal to <Size> bytes because
                         the media sample buffer might be smaller/larger or
                         'out of sync')

  Descript: Push source data.
  Notes   : No intermediate buffers. Data is directly copied to the media
            sample.
            A typical push source filter would use FillBuffer instead, which
            is called automatically for every media sample. Since our
            FillBuffer returns a S_FALSE, this is not the case.....
 ------------------------------------------------------------------------------}
function TMajorPushSource.PushData(Buffer: PByte; Size: Integer; out Delivered: Integer): HRESULT;
var
  CopyBytes    : Integer;                        // Number of bytes to copy/copied 
  ToCopy       : Integer;                        // Number of bytes still to copy from Buffer
  EndTime      : REFERENCE_TIME;
  PushInSyncPtr: PByteArray;                     // Points to start of first packet missing a sync byte
  Resync       : Boolean;                        // True when resynchronization active/required
  SyncOffset   : Integer;                        // Offset for checking for new sync byte 
  SyncFound    : Boolean;                        // Temporarily flag indication sync byte has been found
begin
  Result        := S_FALSE;
  if not Assigned(Buffer) then
    Exit;
  Delivered     := 0;
  SyncOffset    := 0;
  Resync        := False;
  PushInSyncPtr := nil;
  // Lock the filter so it can not be removed
  StateLock.Lock;
  try
    ToCopy := Size;
    // Accumulate data into media sample until a full media buffer is accumulated
    // and then deliver it
    while (ToCopy <> 0) do
    begin
      // Get a new media sample for the input pin (we copy directly to it)
      // if there is not yet one
      if not Assigned(FPushSample) then
      begin
        // Get media sample
        if (FPushPin.GetDeliveryBuffer(FPushSample, nil, nil, 0) <> S_OK) then
        begin
          FPushSample := nil;
          Exit;
        end;
        // Get pointer to media sample
        if Failed(FPushSample.GetPointer(FPushInPtr)) then
        begin
          FPushSample := nil;
          Exit;
        end;
        // Get size of media sample buffer and reset data counter
        FPushInSize := FPushSample.GetSize;
        FPushIn     := 0;
        // Pushed data buffer reset (the pushed data buffer buffers the first FPushedInSize data)
        FPushedDataLock.Lock;
        try
          FPushedInPtrPtr := FPushedInPtr;
          FPushedIn       := 0;
        finally
          FPushedDataLock.Unlock;
        end;
      end;

      // Pushed data buffer (not synchronized)
      FPushedDataLock.Lock;
      try
        if Assigned(FPushedInPtr) then
        begin
          // Only copy if not yet full
          if (FPushedIn < FPushedInSize) then
          begin
            CopyBytes := ToCopy;
            if (ToCopy + FPushedIn) >= FPushedInSize then
              CopyBytes := FPushedInSize - FPushedIn;
            CopyMemory(FPushedInPtrPtr, Buffer, CopyBytes);
            // Adjust pointers/counters
            Inc(FPushedInPtrPtr, CopyBytes);
            Inc(FPushedIn,       CopyBytes);
          end;
        end;
      finally
        FPushedDataLock.Unlock;
      end;

      // Some data (from FLEXCOP/B2C chipsets for example) is not synchronized
      // (meaning that the first data byte does not start with the start of a packet)
      if FSyncData then
      begin
        // Because of the synchronization we need to check the first byte
        // of every packet. This also implies that we handle one packet at
        // a time.
        // Note that the check is not done on the received data (Buffer),
        // but on the media buffer (this is the one to be synchronized).

        // Copy one packet (if possible)
        if ToCopy > CPacketSize then
          CopyBytes := CPacketSize
        else
          CopyBytes := ToCopy;
        if (ToCopy + FPushIn) >= FPushInSize then
          CopyBytes := FPushInSize - FPushIn;
        CopyMemory(FPushInPtr, Buffer, CopyBytes);
        // Adjust pointers/counters
        Inc(FPushInPtr, CopyBytes);
        Inc(FPushIn,    CopyBytes);
        Inc(Buffer,     CopyBytes);
        Dec(ToCopy,     CopyBytes);
        // We might already have been trying to resync (but could not
        // find new sync data in the available data). If this is the case,
        // then continue the resync. 
        // Note that if we are resyncing, that PushInCheckPtr still points
        // to the start of the packet which did not have sync data.
        if not Resync then
        begin
          // No resync busy, just check for the synchronization byte
          // We need to check the start of the last packet index for correct
          // synchronization data
          // Calculate new index/pointer for start of last packet
          // SyncOffset is used here as a temporarily variable
          SyncOffset    := ((FPushIn-1) div CPacketSize) * CPacketSize;
          PushInSyncPtr := PByteArray(FPushInPtr);
          Dec(PByte(PushInSyncPtr), FPushIn - SyncOffset);  // Typecasting to PByte is essential to decrease as single bytes instead of array!
          SyncOffset := 0;
          // We can now check for the sync data
          // Increase/decrease the 'out of sync' counter
          if (PushInSyncPtr[0] <> CSyncByte) then
          begin
            Inc(FSyncOutOfSync);
            // If we lost a lot of syncs, do a resync
            if (FSyncOutOfSync > 50) then
            begin
              Resync     := True;
              SyncOffset := 0;                   // Could use '1' because '0' definitely does not have the sync byte, but the indexed address might be out of range
            end;
          end
          else
            if FSyncOutOfSync > 0 then
              Dec(FSyncOutOfSync);
        end;
        // Only after some definite synchronization loss or when we were
        // busy resyncing, try to resync
        if Resync then
        begin
          // Search for new sync in available data
          // The search ends when all data has been checked or a sync byte has been found
          SyncFound := False;
          repeat
            if PushInSyncPtr[SyncOffset] = CSyncByte then
              SyncFound := True
            else
              Inc(SyncOffset);
          until SyncFound or (@PushInSyncPtr[SyncOffset] = FPushInPtr);
          // Did we find sync data?
          if SyncFound then
          begin
            // New sync found. PushInSyncPtr still points to the start of the
            // packet which was not aligned.
            // SyncOffset indicates at which byte a new sync byte was found
            // from PushInSyncPtr.
            // First correct indexes for new end of data
            ToLog(format('Resync at offset %d', [SyncOffset]));
            // Copy data starting with the found sync data
            CopyMemory(PushInSyncPtr, @PushInSyncPtr[SyncOffset], Integer(FPushInPtr) - Integer(@PushInSyncPtr[SyncOffset]));
            Dec(FPushInPtr, SyncOffset);
            Dec(FPushIn,    SyncOffset);
            Resync         := False;            // No resync
            // Note: FSyncOutOfSync counter is not reset ..
          end;
        end;
      end
      else
      begin
        // Synchronization not used
        // Copy as much of data to the media sample as possible
        CopyBytes := ToCopy;
        if (ToCopy + FPushIn) >= FPushInSize then
          CopyBytes := FPushInSize - FPushIn;
        CopyMemory(FPushInPtr, Buffer, CopyBytes);
        // Adjust pointers/counters
        Inc(FPushInPtr, CopyBytes);
        Inc(FPushIn,    CopyBytes);
        Inc(Buffer,     CopyBytes);
        Dec(ToCopy,     CopyBytes);
      end;

      // If we have a full buffer then 'upload' it
      if FPushIn = FPushInSize then
      try
        // Add timestamps if requested (-not- accurate at all, just the
        // time from buffer to buffer)
        if FAddTimestamps then
        begin
          Self.StreamTime(EndTime);
          FPushSample.SetTime(@FLastTimestamp, @EndTime);
          FLastTimestamp := EndTime;
        end;
        if FPushPin.Deliver(FPushSample) = S_OK then       // Deliver the media sample to the input pin
        begin
          Inc(Delivered, FPushInSize);                     // Adjust returned information
          Inc(FPushPin.FPushPinDataCount, FPushInSize);    // Adjust debug information
          if FPushPin.FPushPinDataCount > 1000000000 then  // Make sure it will not get too excessive
            FPushPin.FPushPinDataCount := 0;
        end;
      finally
        // After delivering the sample we make it available again
        FPushSample := nil;
      end;
    end;
    Result := S_OK;
  finally
    StateLock.Unlock;
  end;
end;


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

  Descript: Initialization
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
initialization
  InstanceCount := 0;

  TBCClassFactory.CreateFilter(TMajorPushSource, 'Major Push Source', CLSID_MajorPushSource,
    CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE, 1, @SudPins);
end.
