{******************************************************************************}
{ FileName............: MajorScriptPushSourceUnit001                           }
{ Project.............: DirectShow                                             }
{ Author(s)...........: MM                                                     }
{ Version.............: 1.00                                                   }
{------------------------------------------------------------------------------}
{  DirectShow script push source filter                                        }
{  Using Pico script the push source filter can call functions which are       }
{  compiled by the push source filter.                                         }
{                                                                              }
{  Note: Can not use MadExcept: problem when stopping a running graph          }
{                                                                              }
{                                                                              }
{  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   20060205 - Initial release                                           }
{******************************************************************************}
unit MajorScriptPushSourceUnit001;


interface
uses
  ActiveX,
  BaseClass,
  Classes,
  DirectShow9,
  JanPico,
  Messages,
  FlexCopRegisters,
  FlexCopInterface,
  FlexCopIoControl,
  Saa7146aRegisters,
  Saa7146aInterface,
  Saa7146aIoControl,
  SysUtils,
  Windows;


const
  CVersion = $0100;
  CBuild   = $20060205;

  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_MajorScriptPushSource                            = '{6D616A6F-7269-7479-6E6C-534352020100}';
  T_IID_MajorScriptPushSource                  : TGUID = IID_MajorScriptPushSource;

  // Classes
  CLSID_MajorScriptPushSource                  : TGUID = '{6D616A6F-7269-7479-6E6C-534352000100}';
  CLSID_MajorScriptPushSourcePropertyPage      : TGUID = '{6D616A6F-7269-7479-6E6C-534352010100}';
  CLSID_MajorScriptPushSourcePropertyPageAbout : TGUID = '{6D616A6F-7269-7479-6E6C-534352FF0100}';

  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));

  CDvbPacketSize       = 204 - 16;                              // DVB packet size: parity is stripped by the SAA7146A
  CDvbPacketHSync      = CDvbPacketSize;                        // 'Horizontal' synchronization DD1 of SAA7146A
  CDvbPacketVSync      = 512;                                   // 'Vertical'   synchronization DD1 of SAA7146A
  CDvbPacketBufferSize = CDvbPacketHSync * CDvbPacketVSync;     // All packets in a single buffer

type
  PDvbTransportPacket = ^TDvbTransportPacket;
  TDvbTransportPacket = array[0..CDvbPacketSize - 1] of Byte;

  PDvbTransportPackets = ^TDvbTransportPackets;
  TDvbTransportPackets = array[0..CDvbPacketVSync - 1] of TDvbTransportPacket;

  // This definition is 'one too many' for data which is not synchronized
  PDvbTransportPackets2 = ^TDvbTransportPackets2;
  TDvbTransportPackets2 = array[0..CDvbPacketVSync] of TDvbTransportPacket;

const
  CStreamDataBufferSize  = SizeOf(TDvbTransportPackets);   // Exactly the size
  CStreamDataBufferSize2 = SizeOf(TDvbTransportPackets2);  // One too many

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;

  // Pico script object
  TPicoScript = class(TObject)
    FPath       : AnsiString;
    FScript     : TJanPico;
    FInformation: TInformation;
  private
    procedure PicoUses(Sender: TjanPico; const Include: string; var Text: string; var Handled: Boolean);
    procedure PicoExternal(Sender: TjanPico; Symbol: string);
  public
    constructor Create;
    destructor  Destroy; override;
    function  ScriptLoad(Script: AnsiString): Boolean;
    procedure ScriptUnload;
    function  ScriptExecute(FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): Boolean;
  end;

{------------------------------------------------------------------------------
  Descript: External access interface
 ------------------------------------------------------------------------------}
  IMajorScriptPushSource = interface(IUnknown)
  [IID_MajorScriptPushSource]
    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 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
    function  GetPushedData        (Buffer: PByte; Size: Integer): HRESULT; stdcall;                                   // Get first xx bytes of media sample of last pushed data (debug)
    function  SetScript            (ScriptFile: PChar): HRESULT; stdcall;      // Load a (new) script
    function  ScriptExecute        (FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): HRESULT; stdcall; // Script function to call with parameters
    function  SetChipsetAndCard    (Chipset: PChar; Card: Integer): HRESULT; stdcall;    // Set chipset/card to use
    function  GetOvertaken         (out Overtaken: Integer): HRESULT; stdcall;           // Get overtaken counter
    function  SetDataFile          (FileName: PChar): HRESULT; stdcall;                  // Start/stop saving data in file
  end;


{------------------------------------------------------------------------------
  Descript: Output pin
 ------------------------------------------------------------------------------}
  TMajorScriptPushSourceOutputPin = class(TBCSourceStream)
  protected
    FSharedState     : TBCCritSec;
    FInformation     : TInformation;
    FPushPinDataCount: Integer;

    FStreamData      : PDvbTransportPackets2;              // Current pointer to stream data (one too many for misc. processing like aligning)
    FThreadHandle    : THandle;                            // Current active thread handle (SAA7146A or FLEXCOP)
    FChipsetName     : AnsiString;                         // Chipset name (or filename!)
    FCurrentChipset  : Integer;                            // Current chipset (0=SAA7146A, 1=FLEXCOP, >1=FILE)
    FCurrentCard     : Integer;                            // Current card (0..9, -1 for disable)
    FChipset         : Integer;                            // Requested chipset (0=SAA7146A, 1=FLEXCOP)
    FCard            : Integer;                            // Requested card (0..9, -1 for disable)
    FOvertaken       : Integer;                            // Number of non-consecutive buffers detected
    // Synchronization of packet data
    FSynchronize     : Boolean;                            // True if synchronization should take place (if out of sync)
    FSyncRequired    : Integer;                            // Counts invalid sync at start buffer
    FSyncOffset      : Integer;                            // Offset for correction
    FSyncData        : TDvbTransportPacket;                // Remainder data previous data block
    // SAA7146A specific
    FSaa7146aBuffer    : TSaa7146aTransferBuffer;          // Transfer buffer SAA7146A
    FSaa7146aLastBuffer: Dword;                            // Last accessed buffer (for checking if there is a new one avilable)
    FSaa7146aBuffers   : Dword;                            // Available buffers
    // Flexcop specific
    FFlexCopBuffer      : TFlexCopFifoTransferBuffer;
    FFlexCopLastBuffer  : Dword;                           // Last accessed buffer (for checking if there is a new one avilable)
    FFlexCopIrqHandling : TFlexCopIrqTransferBuffer;       // Subbuffer 0 interrupts
    // FILE specific
    FFileStream      : TFileStream;                        // Filestream
  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  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.
 ------------------------------------------------------------------------------}
  TMajorScriptPushSource = class(TBCSource, IMajorScriptPushSource, ISpecifyPropertyPages, IPersistStream)
  private
    FThisInstance    : Integer;
    FPushPin         : TMajorScriptPushSourceOutputPin;    // The push source output pin
    FPicoScript      : TPicoScript;                        // Script
    FInformation     : TInformation;                       // Information
    FLogStream       : TFileStream;                        // Filestream for information log
    FDataStream      : TFileStream;                        // Filestream for received data
    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
    // Pushed data buffer
    FPushedDataLock  : TBCCritSec;                         // Lock for pushed data buffer
    FPushedInPtr     : PByte;                              // Pointer to begin input buffer
    FPushedInSize    : Integer;                            // Bytes available in 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 SetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; CheckType: Boolean); stdcall;
    function  GetMediaType         (MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; out CheckType: Boolean): HRESULT; stdcall;
    function  GetPushedData        (Buffer: PByte; Size: Integer): HRESULT; stdcall;
    function  SetScript            (ScriptFile: PChar): HRESULT; stdcall;
    function  ScriptExecute        (FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): HRESULT; stdcall;
    function  SetChipsetAndCard    (Chipset: PChar; Card: Integer): HRESULT; stdcall;
    function  GetOvertaken         (out Overtaken: Integer): HRESULT; stdcall;
    function  SetDataFile          (FileName: PChar): HRESULT; stdcall;

    // Internal functions
    procedure ToLog(Logstring: AnsiString);
  published
  end;

var
  InstanceCount: Integer;


implementation


{------------------------------------------------------------------------------
  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  : -
  Returns : -

  Descript: Create the script object.
  Notes   :
 ------------------------------------------------------------------------------}
constructor TPicoScript.Create;
begin
  inherited Create;

  FInformation := TInformation.Create;
end;


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

  Descript: Destroy the script object.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TPicoScript.Destroy;
begin
  if Assigned(FInformation) then
    FreeAndNil(FInformation);
  inherited Destroy;
end;


{------------------------------------------------------------------------------
  Params  : <Sender>   Sender
            <Include>  Pico script to include
  Returns : <Text>     The complete script as one text
            <Handled>  True if valid script

  Descript: Handles includes from Pico scripts
  Notes   : Without an extension a '.pico' extension is assumed
 ------------------------------------------------------------------------------}
procedure TPicoScript.PicoUses(Sender: TjanPico; const Include: string; var Text: string; var Handled: Boolean);
var
  Strings: TStrings;
  AddExt : string;
begin
  if ExtractFileExt(Include) = '' then
    AddExt := '.pico'
  else
    AddExt := '';
  if FileExists(FPath + Include + AddExt) then
  begin
    Strings := TStringList.Create;
    try
      Strings.LoadFromFile(FPath + Include + AddExt);
      Text := Strings.Text;
      Handled := True;
    finally
      Strings.Free;
    end
  end
  else
    Handled := False;
end;


{------------------------------------------------------------------------------
  Params  : <Sender>   Sender
            <Symbol>   External function to call
  Returns : -

  Descript: Handles external functions from Pico scripts
  Notes   : For future expansion
 ------------------------------------------------------------------------------}
procedure TPicoScript.PicoExternal(Sender: TjanPico; Symbol: string);
begin
// Example:  if Symbol='system.path' then
//             Sender.pushText(appldir);
end;


{------------------------------------------------------------------------------
  Params  : <Script>   Script name
  Returns : <Result>   True if success
                       (use FMessage to obtain the textual error)

  Descript: Load a Pico script
  Notes   :
 ------------------------------------------------------------------------------}
function TPicoScript.ScriptLoad(Script: AnsiString): Boolean;
var
  Strings: TStrings;
begin
//  FInformation.Information := 'TPicoScript.ScriptLoad';
  Result := False;
  FScript := TJanPico.Create;
  FScript.OnUses     := PicoUses;
  FScript.OnExternal := PicoExternal;
  // Read file and pass it on to Pico (which also tokenizes it)
  Strings := TStringList.Create;
  try
    FPath := ExtractFilePath(Script);
    Strings.LoadFromFile(Script);
    try
      FScript.Script := Strings.Text;
    except
      on E: Exception do
      begin
        FInformation.Information := E.Message;
        FreeAndNil(FScript);
        Exit;
      end;
    end;
  finally
    Strings.Free;
  end;
  // At this point the Pico file has been tokenized and we must execute it
  // before individual functions can be called.
  // If an error occurs display it and remove the script.
  try
    FScript.Execute;
  except
    on E: Exception do
    begin
      FInformation.Information := E.Message;
      FreeAndNil(FScript);
      Exit;
    end;
  end;
  FInformation.Information := format('Script ''%s'' loaded', [Script]);
  Result := True;
end;


{------------------------------------------------------------------------------
  Params  : <FunctionCall>      Function to execute
            <InputParameters>   Input parameters (note: not all types are allowed)
  Returns : <Result>            True if no error
            <OutputParameters>  Output parameters

  Descript: Execute a Pico function
  Notes   :
 ------------------------------------------------------------------------------}
function TPicoScript.ScriptExecute(FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): Boolean;
var
  Loop      : Integer;
  StackEmpty: Boolean;
  StackNo   : Integer;
  StackStr  : AnsiString;
  Data      : TjanPicoObject;
  CurrentVar: OleVariant;
begin
//  FInformation.Information := 'TPicoScript.ScriptExecute';
  Result := False;
  if not Assigned(FScript) then
  begin
    FInformation.Information := 'No script active';
    Exit;
  end;
  if not VarIsEmpty(InputParameters) then
  begin
    try
      // Push all parameters
      Loop := 0;
      if VarIsArray(InputParameters) then
        Loop := VarArrayLowBound(InputParameters, 1);
      repeat
        VarClear(CurrentVar);
        if VarIsArray(InputParameters) then
          CurrentVar := InputParameters[Loop]
        else
          CurrentVar := InputParameters;
        case VarType(CurrentVar) of
          varInteger:    FScript.PushNumber(CurrentVar);
          varBoolean:    if CurrentVar then
                          FScript.PushNumber(-1)
                        else
                          FScript.PushNumber(0);
          varByte:      FScript.PushText(CurrentVar);
          varDouble:    FScript.PushNumber(CurrentVar);
          varOleStr:    FScript.PushText(CurrentVar);
          else          begin
                          FInformation.Information := format('Unsupported type: $%x', [VarType(CurrentVar)]);
                          Exit;
                        end;
        end;
        Inc(Loop);
      until (not VarIsArray(InputParameters)) or (Loop > VarArrayHighBound(InputParameters, 1));
    except
      on E: Exception do
      begin
        FInformation.Information := E.Message;
        Exit;
      end;
    end;
  end;
  // Execute
  try
    FScript.ExecuteFunction(FunctionCall);
  except
    on E: Exception do
    begin
      FInformation.Information := E.Message;
      Exit;
    end;
  end;
  if not VarIsEmpty(OutputParameters) then
  begin
    // Pop parameters
    try
      Loop := 0;
      if VarIsArray(OutputParameters) then
        Loop := VarArrayLowBound(OutputParameters, 1);
      repeat
        VarClear(CurrentVar);
        if VarIsArray(OutputParameters) then
          CurrentVar := OutputParameters[Loop]
        else
          CurrentVar := OutputParameters;
        case VarType(CurrentVar) of
          varInteger:  CurrentVar := Integer(Round(FScript.PopNumber));
          varBoolean:  CurrentVar := (FScript.PopNumber <> 0);
          varByte:     CurrentVar := FScript.PopText[1];
          varDouble:   CurrentVar := FScript.PopNumber;
          varOleStr:   CurrentVar := FScript.PopText;
          else         begin
                         FInformation.Information := format('Unsupported type: $%x', [VarType(CurrentVar)]);
                         Exit;
                       end;
        end;
        if VarIsArray(OutputParameters) then
          OutputParameters[Loop] := CurrentVar
        else
          OutputParameters := CurrentVar;
        Inc(Loop);
      until (not VarIsArray(OutputParameters)) or (Loop > VarArrayHighBound(OutputParameters, 1));
    except
      on E: Exception do
      begin
        FInformation.Information := E.Message;
        Exit;
      end;
    end;
  end
  else
  begin
    // If nothing is to be returned, but there is data on the stack, then display
    // it. We have to 'reverse' it because we like the top of stack displayed last
    // as the 'saystack' would.
    StackEmpty := False;
    StackStr   := '';
    StackNo    := 0;
    repeat
      try
        Data := FScript.Pop;
        try
          case Data.Kind of
            jpoNumber : if Data.Number = Round(Data.Number) then
                        begin
                          if Round(Data.Number) < 0 then
                            StackStr := format('%d %s', [Round(Data.Number), StackStr])
                          else
                            StackStr := format('$%x %s', [Round(Data.Number), StackStr]);
                        end
                        else
                          StackStr := format('%f %s', [Data.Number, StackStr]);
            jpoText   : StackStr := format('"%s" %s', [Data.Text, StackStr]);
          end;
          Inc(StackNo);
        finally
          Data.Free;
        end;
      except
        StackEmpty := True;
      end;
    until StackEmpty;

    if StackNo <> 0 then
      if StackNo > 1 then
        FInformation.Information := format('ScriptExecute stack (bottom -> top) [%d]  --  %s', [StackNo, StackStr])
      else
        FInformation.Information := format('ScriptExecute stack [1]  --  %s', [StackStr]);
  end;
  Result := True;
end;


{------------------------------------------------------------------------------
  Params  : <Identifier>   Identifier of loaded script
  Returns : -

  Descript: Unload a Pico script
  Notes   :
 ------------------------------------------------------------------------------}
procedure TPicoScript.ScriptUnload;
begin
  if Assigned(FScript) then
    FreeAndNil(FScript);
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 TMajorScriptPushSourceOutputPin.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;
  FChipsetName      := '';
  FCurrentChipset   := -1;
  FCurrentCard      := -1;
  FCard             := -1;
  FChipset          := -1;
  FThreadHandle     := INVALID_HANDLE_VALUE;
  FFileStream       := nil;
  FOvertaken        := 0;
  FStreamData       := nil;
end;


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

  Descript: Destroy the output pin.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TMajorScriptPushSourceOutputPin.Destroy;
begin
  if FCurrentCard = 0 then
    Saa7146aCloseHandle(FThreadHandle);
  if FCurrentCard = 1 then
    FlexCopCloseHandle(FThreadHandle);
  if Assigned(FStreamData) then
    FreeMem(FStreamData);
  if Assigned(FFileStream) then
    FreeAndNil(FFileStream);

  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 TMajorScriptPushSourceOutputPin.GetMediaType(MediaType: PAMMediaType): HRESULT;
begin
  FFilter.StateLock.Lock;              // Note: FFilter is the parent
  try
//    FInformation.Information := 'TMajorScriptPushSourceOutputPin.GetMediaType';
    MediaType.MajorType            := TMajorScriptPushSource(FFilter).FMediaTypeMajor;
    MediaType.SubType              := TMajorScriptPushSource(FFilter).FMediaTypeMinor;
    MediaType.bFixedSizeSamples    := True;
    MediaType.lSampleSize          := 0;
    MediaType.bTemporalCompression := False;
    MediaType.FormatType           := TMajorScriptPushSource(FFilter).FMediaTypeFormat;
    MediaType.cbFormat             := 0;
    MediaType.pbFormat             := nil;
    FInformation.Information := format('Pin:GetMediaType major type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.MajorType.D1,    MediaType.MajorType.D2,    MediaType.MajorType.D3,
       MediaType.MajorType.D4[0], MediaType.MajorType.D4[1],
       MediaType.MajorType.D4[2], MediaType.MajorType.D4[3], MediaType.MajorType.D4[4],
       MediaType.MajorType.D4[5], MediaType.MajorType.D4[6], MediaType.MajorType.D4[7]]);
    FInformation.Information := format('Pin:GetMediaType minor type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.SubType.D1,    MediaType.SubType.D2,    MediaType.SubType.D3,
       MediaType.SubType.D4[0], MediaType.SubType.D4[1],
       MediaType.SubType.D4[2], MediaType.SubType.D4[3], MediaType.SubType.D4[4],
       MediaType.SubType.D4[5], MediaType.SubType.D4[6], MediaType.SubType.D4[7]]);
    FInformation.Information := format('Pin:GetMediaType format type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.FormatType.D1,    MediaType.FormatType.D2,    MediaType.FormatType.D3,
       MediaType.FormatType.D4[0], MediaType.FormatType.D4[1],
       MediaType.FormatType.D4[2], MediaType.FormatType.D4[3], MediaType.FormatType.D4[4],
       MediaType.FormatType.D4[5], MediaType.FormatType.D4[6], MediaType.FormatType.D4[7]]);
    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 TMajorScriptPushSourceOutputPin.CheckMediaType(MediaType: PAMMediaType): HRESULT;
begin
//  FInformation.Information := 'TMajorScriptPushSourceOutputPin.CheckMediaType';
    FInformation.Information := format('Pin:CheckMediaType major type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.MajorType.D1,    MediaType.MajorType.D2,    MediaType.MajorType.D3,
       MediaType.MajorType.D4[0], MediaType.MajorType.D4[1],
       MediaType.MajorType.D4[2], MediaType.MajorType.D4[3], MediaType.MajorType.D4[4],
       MediaType.MajorType.D4[5], MediaType.MajorType.D4[6], MediaType.MajorType.D4[7]]);
    FInformation.Information := format('Pin:CheckMediaType minor type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.SubType.D1,    MediaType.SubType.D2,    MediaType.SubType.D3,
       MediaType.SubType.D4[0], MediaType.SubType.D4[1],
       MediaType.SubType.D4[2], MediaType.SubType.D4[3], MediaType.SubType.D4[4],
       MediaType.SubType.D4[5], MediaType.SubType.D4[6], MediaType.SubType.D4[7]]);
    FInformation.Information := format('Pin:CheckMediaType format type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
      [MediaType.FormatType.D1,    MediaType.FormatType.D2,    MediaType.FormatType.D3,
       MediaType.FormatType.D4[0], MediaType.FormatType.D4[1],
       MediaType.FormatType.D4[2], MediaType.FormatType.D4[3], MediaType.FormatType.D4[4],
       MediaType.FormatType.D4[5], MediaType.FormatType.D4[6], MediaType.FormatType.D4[7]]);
  if  TMajorScriptPushSource(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(TMajorScriptPushSource(FFilter).FMediaTypeMajor, GUID_NULL)) then
        if not IsEqualGUID(MediaType.MajorType, TMajorScriptPushSource(FFilter).FMediaTypeMajor) then
          Exit;
      if (not IsEqualGUID(MediaType.SubType, GUID_NULL)) and
         (not IsEqualGUID(TMajorScriptPushSource(FFilter).FMediaTypeMinor, GUID_NULL)) then
        if not IsEqualGUID(MediaType.SubType, TMajorScriptPushSource(FFilter).FMediaTypeMinor) then
          Exit;
      if (not IsEqualGUID(MediaType.FormatType, GUID_NULL)) and
         (not IsEqualGUID(TMajorScriptPushSource(FFilter).FMediaTypeFormat, GUID_NULL)) then
        if not IsEqualGUID(MediaType.FormatType, TMajorScriptPushSource(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 TMajorScriptPushSourceOutputPin.DecideBufferSize(Alloc: IMemAllocator; propInputRequest: PAllocatorProperties): HRESULT;
var
  Actual: TAllocatorProperties;
begin
  FFilter.StateLock.Lock;              // Note: FFilter is the parent
  try
//    FInformation.Information := 'TMajorScriptPushSourceOutputPin.DecideBufferSize';
    Result := E_FAIL;
    if not Assigned(Alloc) then
      Exit;
    if not Assigned(propInputRequest) then
      Exit;
    // Ensure a minimum number of buffers
    if propInputRequest.cBuffers = 0 then
      propInputRequest.cBuffers := 1;
    propInputRequest.cbBuffer := TMajorScriptPushSource(FFilter).FBufferSize;
    propInputRequest.cbAlign  := TMajorScriptPushSource(FFilter).FBufferAlignment;
    propInputRequest.cbPrefix := 0;
    // Specify our buffer requirements
    Result := Alloc.SetProperties(propInputRequest^, Actual);
    if Failed(Result) then
      Exit;
    // We NEED the requested buffer size  
    if (Actual.cbBuffer <> propInputRequest.cbBuffer) or
       (Actual.cBuffers < propInputRequest.cBuffers) then
      Result := E_FAIL
    else
      Result := S_OK;
    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: 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.
            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 ....
 ------------------------------------------------------------------------------}
function TMajorScriptPushSourceOutputPin.FillBuffer(Sample: IMediaSample): HRESULT;
var
  ChipsetName : AnsiString;
  Chipset     : Integer;
  Card        : Integer;
  Info        : TSaa7146aGetDmaStatus;
  Channel     : Dword;
  ChannelFound: Boolean;
  Data        : Dword;
  PushInPtr   : PByte;                           // Pointer to input buffer media sample
begin
//  FInformation.Information := 'TMajorScriptPushSourceOutputPin.FillBuffer';
  Result := S_OK;

  // Check for changed chipset/card
  if (FCard <> FCurrentCard) or (FChipset <> FCurrentChipset) then
  begin
    // Make local copies of selected chipset/card
    ChipsetName := FChipsetName;
    Chipset     := FChipset;
    Card        := FCard;
    if Card < 0 then
      FInformation.Information := 'New chipset/card/file/end-of-file set: Stopping'
    else
    begin
      if Chipset = 0 then
        FInformation.Information := format('New chipset/card set: SAA7146A, card %d (%d cards detected)', [Card, Saa7146aGetNumberOfCards]);
      if Chipset = 1 then
        FInformation.Information := format('New chipset/card set: FLEXCOP, card %d (%d cards detected)', [Card, FlexcopGetNumberOfCards]);
      if Chipset = 1 then
        FInformation.Information := format('New filename set: %s)', [ChipsetName]);
    end;
    // Changed chipset/card means releasing old stuff
    case FCurrentChipset of
      0:   Saa7146aCloseHandle(FThreadHandle);
      1:   FlexCopCloseHandle(FThreadHandle);
      else if Assigned(FFileStream) then
             FreeAndNil(FFileStream);
    end;  
    FThreadHandle := INVALID_HANDLE_VALUE;
    // Create new handles if appropriate
    if Card >= 0 then
    begin
      case Chipset of
        0: begin
             FThreadHandle := Saa7146aCreateFile(Card);
             if FThreadHandle = INVALID_HANDLE_VALUE then
               FInformation.Information := 'Could not get handle for SAA7146A card';
           end;    
        1: begin
             FThreadHandle := FlexCopCreateFile(Card);
             if FThreadHandle = INVALID_HANDLE_VALUE then
               FInformation.Information := 'Could not get handle for FLEXCOP card';
           end;
        2: begin
             try
               FFileStream := TFileStream.Create(ChipsetName, fmOpenRead or fmShareDenyNone);
               // Indicate we are 'validated' 
               FThreadHandle := FFileStream.Handle;
             except
               FFileStream := nil;
               FInformation.Information := 'Could not open file';
             end;
           end
      end;
    end;
    // Try to setup 'contact' with chipset
    if FThreadHandle <> INVALID_HANDLE_VALUE then
    begin
      if Chipset = 0 then
      begin
        // SAA7146A
        FInformation.Information := 'Valid handle for chipset acquired';
        // First we need to find the buffer identifier and size of the allocated
        // DMA buffer. Any allocated DMA memory > TDvbTransportPackets will be
        // 'seen' as the DMA memory we are looking for (the number of buffers
        // is/should be an even number because of odd/even field processing)
        Channel      := 0;
        ChannelFound := False;
        while (Saa7146aGetDmaStatus(FThreadHandle, Channel, Info) and (not ChannelFound)) and (Channel < 256) do
        begin
          if Info.Size > CStreamDataBufferSize then
            ChannelFound := True
          else
            Inc(Channel);
        end;
        if ChannelFound then
        begin
          if not Assigned(FStreamData) then
            GetMem(FStreamData, CStreamDataBufferSize2);   // We could just acquire CStreamDataBufferSize bytes here ...
          FSaa7146aBuffer.Identifier      := Channel;
          FSaa7146aBuffer.TransferAddress := PChar(FStreamData);
          FSaa7146aBuffer.TargetIndex     := 0;
          FSaa7146aBuffer.TransferLength  := CStreamDataBufferSize;

          // The allocated size should be an exact (not checked) multiple ...
          FSaa7146aBuffers := Info.Size div CStreamDataBufferSize;
          FSaa7146aLastBuffer             := 0;
          FSynchronize                    := False;
          FOvertaken                      := 0;
          FInformation.Information := format('SAA7146A card acquiring of data started (%d buffers detected)', [FSaa7146ABuffers]);
          if Sample.GetSize <> CStreamDataBufferSize then
            FInformation.Information := format('Conflicting buffer size and media sample size detected:  %d (card)  %d (media sample)', [CStreamDataBufferSize, Sample.GetSize]);
        end
        else
        begin
          // Nothing found, remove
          FInformation.Information := 'No active DMA memory found for SAA7146A';
          Saa7146aCloseHandle(FThreadHandle);
          FThreadHandle := INVALID_HANDLE_VALUE;
        end;
      end;

      if Chipset = 1 then
      begin
        // FLEXCOP (B2C2)
        FInformation.Information := 'Valid handle for chipset acquired';
        FFlexCopIrqHandling.Identifier := CFlexCopIrqDma10Irq;
        FlexCopReadFromIrqHandling(FThreadHandle, FFlexcopIrqHandling);
        Channel := 0;
        if not FFlexCopIrqHandling.Information.IrqBufferingIsActive then
          ChannelFound := False
        else
        begin
          Channel := CFlexCopIrqDma10Irq;
          ChannelFound := True;
        end;
        if ChannelFound then
        begin
          if not Assigned(FStreamData) then
            GetMem(FStreamData, CStreamDataBufferSize2);
          // Dma 1, subbuffer 0 interrrupts are used
          FFlexCopIrqHandling.Identifier := Channel;
          FlexCopReadFromIrqHandling(FThreadHandle, FFlexCopIrqHandling);
          if FFlexCopIrqHandling.Information.IrqBufferingIsActive then
          begin
            FFlexCopLastBuffer   := $FFFF;
            FSynchronize  := True;
            FSyncRequired := 0;
            FSyncOffset   := 0;
            FFlexCopBuffer.TransferAddress[0] := @FStreamData^[0][FSyncOffset];
            FInformation.Information := format('FLEXCOP card acquiring of data started (%d buffers detected)', [FFlexCopIrqHandling.Information.FifoBufferLastIndex - FFlexCopIrqHandling.Information.FifoBufferFirstIndex + 1]);
            if Sample.GetSize <> CStreamDataBufferSize then
              FInformation.Information := format('Conflicting buffer size and media sample size detected:  %d (card)  %d (media sample)', [CStreamDataBufferSize, Sample.GetSize]);
          end
          else
          begin
            // Nothing found, remove
            FInformation.Information := 'No interrupts active for FLEXCOP';
            FlexCopCloseHandle(FThreadHandle);
            FThreadHandle := INVALID_HANDLE_VALUE;
          end;
        end
        else
        begin
          // Nothing found, remove
          FInformation.Information := 'No active DMA memory found for FLEXCOP';
          FlexCopCloseHandle(FThreadHandle);
          FThreadHandle := INVALID_HANDLE_VALUE;
        end;

      end;

      if Chipset = 2 then
      begin
        if not Assigned(FStreamData) then
          GetMem(FStreamData, CStreamDataBufferSize2);
        FInformation.Information := 'Acquiring data from file started';
        // FILE
        FSynchronize  := True;
        FSyncRequired := 0;
        FSyncOffset   := 0;
        FOvertaken    := 0;
      end;
    end;

    // If all is OK then reflect this in current chipset/card, or otherwise
    // reset these. This means that the chipset/card need to be set again
    // for a retry.
    if FThreadHandle <> INVALID_HANDLE_VALUE then
    begin
      FCurrentCard    := Card;
      FCurrentChipset := Chipset;
    end
    else
    begin
      if Assigned(FStreamData) then
        FreeMem(FStreamData);
      FStreamData     := nil;
      FChipset        := -1;
      FCurrentChipset := -1;
      FCurrentCard    := -1;
      FCard           := -1;
    end;
  end;

  // If acquiring from chipset/card active
  if FThreadHandle <> INVALID_HANDLE_VALUE then
  begin
    if FCurrentChipset = 0 then
    begin
      // If SAA7146A active
      // First check if there are already buffers filled
      Saa7146aReadFromSaa7146aRegister(FThreadHandle, CSaa7146aEcT1R, Data);
      // Compensate for invalid buffer returned (e.g. DMA never run or RPS off)
      if Data >= FSaa7146ABuffers then
        Data := 0;
      // If no new data
      if Data = FSaa7146aLastBuffer then
      begin
        // Wait for it until data arrives or handle is removed
        repeat
          Sleep(3);
          Saa7146aReadFromSaa7146aRegister(FThreadHandle, CSaa7146aEcT1R, Data);
        until (Data <> FSaa7146aLastBuffer) or (FThreadHandle = INVALID_HANDLE_VALUE);
      end
      else
      begin
        if FOverTaken > 1000000000 then
          FOverTaken := 0
        else
          Inc(FOvertaken);
      end;
      // If new data
      if FThreadHandle <> INVALID_HANDLE_VALUE then
      begin
        FSaa7146aBuffer.SourceIndex := CStreamDataBufferSize * FSaa7146aLastBuffer;
        // Next buffer to wait for
        Inc(FSaa7146aLastBuffer);
        // Circular buffer
        if FSaa7146aLastBuffer = FSaa7146aBuffers then
          FSaa7146aLastBuffer := 0;
        // Get data in local buffer
        Saa7146aReadFromDma(FThreadHandle, FSaa7146aBuffer);
      end;
    end;

    if FCurrentChipset = 1 then
    begin
      // If FLEXCOP active
      // Get information of buffer being filled by driver
      FlexCopReadFromIrqHandling(FThreadHandle, FFlexCopIrqHandling);
      FOvertaken := FFlexCopIrqHandling.Information.FifoOverflows;
      while (FThreadHandle <> INVALID_HANDLE_VALUE) and (FFlexCopIrqHandling.Information.FifoBufferPreviousIndex = FFlexCopLastBuffer) do
      begin
        Sleep(3);
        FlexCopReadFromIrqHandling(FThreadHandle, FFlexCopIrqHandling);
      end;
      // If new data
      if FThreadHandle <> INVALID_HANDLE_VALUE then
      begin
        // Next buffer to wait for
        Inc(FFlexCopLastBuffer);
        // Circular buffer
        if FFlexCopLastBuffer > FFlexCopIrqHandling.Information.FifoBufferLastIndex then
          FFlexCopLastBuffer := FFlexCopIrqHandling.Information.FifoBufferFirstIndex;
        // Read buffer
        FFlexCopBuffer.TransferAddress[0] := @FStreamData^[0][FSyncOffset];
        FFlexCopBuffer.TransferLength     := CStreamDataBufferSize;
        FFlexCopBuffer.Identifier         := FFlexCopLastBuffer;
        FlexCopReadFromFifo(FThreadHandle, FFlexCopBuffer);
      end;
    end;

    if FCurrentChipset > 1 then
    begin
      // If FILE active
      // Read data; If not all data could be read (end of file) then end it next loop
      if FFileStream.Read(FStreamData^[0][FSyncOffset], CStreamDataBufferSize) < CStreamDataBufferSize then
        FCard := -1;
      // This implicit delay will 'overflow' the downstream filters less fast
      // then without a delay  
      Sleep(10);
    end;

    // Some data (from the FLEXCOP for instance) is not synchronized (meaning that
    // the first data byte starts with the start of a packet.
    if FSynchronize then
    begin
      // Check first packet (the offset should have made the second packet correct)
      if (FStreamData^[1][0] <> $47) then
        Inc(FSyncRequired)
      else
        if FSyncRequired > 0 then
          Dec(FSyncRequired);
      if FSyncRequired > 50 then
      begin
        // Search for new sync
        FSyncOffset := 0;
        while (FSyncOffset < CDvbPacketSize) and (FStreamData^[0][FSyncOffset] <> $47) do
          Inc(FSyncOffset);
        // Not found, default to start
        // Otherwise the correction is related to the packet size because
        // the correct data is to be placed in the second packet of
        // StreamDataBuffer
        if (FSyncOffset = 0) or (FSyncOffset = CDvbPacketSize) then
          FSyncOffset := 0
        else
          FSyncOffset := CDvbPacketSize - FSyncOffset;
        FSyncRequired := 0;
      end
      else
      begin
        // We have to store the data at the end and use it for the
        // next block of data
        if FSyncOffset <> 0 then
        begin
          // Copy remainder of previous block
          CopyMemory(FStreamData, @FSyncData, FSyncOffset);
          // Copy leftover of current block ('one too many' packet)
          CopyMemory(@FSyncData, @FStreamData^[High(TDvbTransportPackets2)], FSyncOffset);
        end;
      end;
    end;

    // If we did not escape because of an invalidated handle, then save the data
    if FThreadHandle <> INVALID_HANDLE_VALUE then
    begin
      // Pushed data buffer (debug)
      TMajorScriptPushSource(FFilter).FPushedDataLock.Lock;
      try
        if Assigned(TMajorScriptPushSource(FFilter).FPushedInPtr) then
        begin
          if TMajorScriptPushSource(FFilter).FPushedInSize >= CStreamDataBufferSize then
            CopyMemory(TMajorScriptPushSource(FFilter).FPushedInPtr, FStreamData, CStreamDataBufferSize)
          else
            CopyMemory(TMajorScriptPushSource(FFilter).FPushedInPtr, FStreamData, TMajorScriptPushSource(FFilter).FPushedInSize);
         end;
      finally
        TMajorScriptPushSource(FFilter).FPushedDataLock.Unlock;
      end;

      // Save to file if needed (typically debug)
      if Assigned(TMajorScriptPushSource(FFilter).FDataStream) then
        TMajorScriptPushSource(FFilter).FDataStream.Write(FStreamData^, CStreamDataBufferSize);

      // Get pointer to media sample
      if Failed(Sample.GetPointer(PushInPtr)) then
        Exit;
      // Check for correct media size (must match)
      if Sample.GetSize <> CStreamDataBufferSize then
        Exit;
      CopyMemory(PushInPtr, FStreamData, CStreamDataBufferSize);
      Inc(FPushPinDataCount, CStreamDataBufferSize);
      if FPushPinDataCount > 1000000000 then
        FPushPinDataCount := 0;
    end;
  end;
end;


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

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

  FThisInstance := InterlockedIncrement(InstanceCount);

  FInformation := TInformation.Create;
  FLogStream   := nil;
  FDataStream  := nil;

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

  // Set default settings
  MajorType  := MEDIATYPE_Stream;
  MinorType  := MEDIASUBTYPE_MPEG2_TRANSPORT;
  FormatType := GUID_NULL;
  SetMediaType(@MajorType, @MinorType, @FormatType, False);

  FBufferSize       := CDvbPacketSize * CDvbPacketVSync;
  FBufferAlignment  := CDvbPacketSize;
  SetLog(False);

  // Create our output pin
  FPushPin := TMajorScriptPushSourceOutputPin.Create(ObjName, hr, Self, 'Output');
  if not Assigned(FPushPin) then
    hr := S_FALSE;
  FPicoScript := TPicoScript.Create;
//  ToLog('TMajorScriptPushSource.Create');
end;


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

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


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

  Descript: Destructor.
  Notes   :
 ------------------------------------------------------------------------------}
destructor TMajorScriptPushSource.Destroy;
begin
  // Release all created instances/objects
  if Assigned(FInformation) then
    FreeAndNil(FInformation);
  if Assigned(FPushPin) then
    FreeAndNil(FPushPin);
  if Assigned(FPushedInPtr) then
    FreeMem(FPushedInPtr);
  if Assigned(FPicoScript) then
    FreeAndNil(FPicoScript);
  FPushedInPtr    := nil;
  if Assigned(FPushedDataLock) then
    FreeAndNil(FPushedDataLock);
  if Assigned(FDataStream) then
    FreeAndNil(FDataStream);
  SetLog(False);
  inherited;
end;


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

  Descript: Put text to log file
  Notes   :
 ------------------------------------------------------------------------------}
procedure TMajorScriptPushSource.ToLog(LogString: AnsiString);
var
  NewLog: AnsiString;
begin
  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  : <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 TMajorScriptPushSource.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 or fmShareDenyNone);
    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 TMajorScriptPushSource.GetLog(out OnOff: Boolean): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetLog');
  OnOff  := Assigned(FLogStream);
  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 TMajorScriptPushSource.SetMediaType(MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; CheckType: Boolean); stdcall;
begin
//  ToLog('TMajorScriptPushSource.SetMediaType');
  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(format('SetMediaType major type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
    [FMediaTypeMajor.D1,    FMediaTypeMajor.D2,    FMediaTypeMajor.D3,
     FMediaTypeMajor.D4[0], FMediaTypeMajor.D4[1],
     FMediaTypeMajor.D4[2], FMediaTypeMajor.D4[3], FMediaTypeMajor.D4[4],
     FMediaTypeMajor.D4[5], FMediaTypeMajor.D4[6], FMediaTypeMajor.D4[7]]));
  ToLog(format('SetMediaType minor type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
    [FMediaTypeMinor.D1,    FMediaTypeMinor.D2,    FMediaTypeMinor.D3,
     FMediaTypeMinor.D4[0], FMediaTypeMinor.D4[1],
     FMediaTypeMinor.D4[2], FMediaTypeMinor.D4[3], FMediaTypeMinor.D4[4],
     FMediaTypeMinor.D4[5], FMediaTypeMinor.D4[6], FMediaTypeMinor.D4[7]]));
  ToLog(format('SetMediaType format type: {%8.8x-%4.4x-%4.4x-%2.2x%2.2x-%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x}',
    [FMediaTypeFormat.D1,    FMediaTypeFormat.D2,    FMediaTypeFormat.D3,
     FMediaTypeFormat.D4[0], FMediaTypeFormat.D4[1],
     FMediaTypeFormat.D4[2], FMediaTypeFormat.D4[3], FMediaTypeFormat.D4[4],
     FMediaTypeFormat.D4[5], FMediaTypeFormat.D4[6], FMediaTypeFormat.D4[7]]));
  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 TMajorScriptPushSource.GetMediaType(MajorType: PCLSID; MinorType: PCLSID; FormatType: PCLSID; out CheckType: Boolean): HRESULT; stdcall;
begin
//  ToLog('TMajorScriptPushSource.GetMediaType');
  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  : -
  Returns : <Result>  Result
            <Pages>   Property pages GUID

  Descript: Get property pages.
  Notes   : DirectShow
            <ISpecifyPropertyPages>
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.GetPages(out pages: TCAGUID): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetPages');
  Pages.cElems := 2;
  Pages.pElems := CoTaskMemAlloc(SizeOf(TGUID) * Pages.cElems);
  if not Assigned(Pages.pElems) then
  begin
    ToLog('TMajorScriptPushSource.GetPages failed');
    Result := E_OUTOFMEMORY;
    Exit;
  end;
  Pages.pElems^[0] := CLSID_MajorScriptPushSourcePropertyPage;
  Pages.pElems^[1] := CLSID_MajorScriptPushSourcePropertyPageAbout;
  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>
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.IsDirty: HRESULT;
begin
//  ToLog('TMajorScriptPushSource.IsDirty');
  Result := S_FALSE;
end;


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

  Descript: Load setting data from stream.
  Notes   : DirectShow
            <IPersistStream>
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.Load(const stm: IStream): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.Load');
  Result := S_OK;
end;


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

  Descript: Save setting data to stream.
  Notes   : DirectShow
            <IPersistStream>
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.Save(const stm: IStream; fClearDirty: BOOL): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.Save');
  Result := S_OK;
end;


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

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


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

  Descript: Support for delegating and non delegating IUnknown interfaces.
  Notes   : DirectShow
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.NonDelegatingQueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface');
  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_MajorScriptPushSource) then
  begin
    if GetInterface(IMajorScriptPushSource, Obj) then
    begin
//      ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface IMajorScriptPushSource success');
      Result := S_OK;
    end
    else
      ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface IMajorScriptPushSource failed');
    Exit;
  end;
  if IsEqualGUID(IID, IID_ISpecifyPropertyPages) then
  begin
    if GetInterface(ISpecifyPropertyPages, Obj) then
    begin
//      ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface ISpecifyPropertyPages success');
      Result := S_OK;
    end
    else
      ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface ISpecifyPropertyPages failed');
    Exit;
  end;
  if IsEqualGUID(IID, IID_IPersistStream) then
  begin
    if GetInterface(IPersistStream, Obj) then
    begin
//      ToLog('TMajorScriptPushSource.NonDelegatingQueryInterface IPersistStream success');
      Result := S_OK;
    end
    else
      ToLog('TMajorScriptPushSource.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 TMajorScriptPushSource.GetVersionInformation(out Info: PChar): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetVersionInformation');
  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 TMajorScriptPushSource.GetInformation(out Info: PChar): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetInformation');
  Result := S_FALSE;
  if not Assigned(Info) then
    Exit;
  StrPCopy(Info, FInformation.Information);
  if Length(Info) = 0 then
    if Assigned(FPushPin) then
    begin
      StrPCopy(Info, FPushPin.FInformation.Information);
      if Length(Info) = 0 then
        if Assigned(FPicoScript) then
        begin
          StrPCopy(Info, FPicoScript.FInformation.Information);
        end;
    end;
  Result := S_OK;
end;


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

  Descript: Get information count (also from output pin).
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.GetInformationCount(out Count: Integer): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetInformationCount');
  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 TMajorScriptPushSource.GetDeliveredCount(out Count: Integer): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetDeliveredCount');
  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 TMajorScriptPushSource.GetPushedData(Buffer: PByte; Size: Integer): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.GetPushedData');
  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;
    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  : <ScriptFile>  Pointer to a null terminated string with filename
                          'nil' can be used to remove a loaded script
  Returns : <Result>      S_OK
                          S_FALSE if any error

  Descript: Set (load) a (new) script file
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.SetScript(ScriptFile: PChar): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.SetScript');
  Result := S_FALSE;
  if not Assigned(FPicoScript) then
    Exit;
  // Unloading only ?
  if not Assigned(ScriptFile) then
  begin
    FPicoScript.ScriptUnload;
    Exit;
  end;
  FPicoScript.ScriptLoad(ScriptFile);
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <FunctionCall>      Pointer to null terminated string with function
                                to execute
            <InputParameters>   Input parameters (note: not all types are allowed)
  Returns : <Result>            S_OK
                                S_FALSE if any error
            <OutputParameters>  Output parameters

  Descript: Execute a script line
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.ScriptExecute(FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.ScriptExecute');
  Result := S_FALSE;
  if not Assigned(FPicoScript) then
    Exit;
  if FPicoScript.ScriptExecute(FunctionCall, InputParameters, OutputParameters) then
    Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <Chipset>           Pointer to null terminated string with card name
                                or a file name
                                ('SAA7146A', 'FLEXCOP', 'B2C2')
            <Card>              Card to use (0..9)
                                <0 to disable acquiring data (Chipset is not
                                checked for correctness)
  Returns : <Result>            S_OK
                                S_FALSE if any error (invalid chipset/card)

  Descript: Set the chipset and card to use for acquiring data
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.SetChipsetAndCard(Chipset: PChar; Card: Integer): HRESULT;
var
  ChkStr    : AnsiString;
  NewChipset: Integer;
begin
//  ToLog('TMajorScriptPushSource.SetChipsetAndCard');
  Result := S_FALSE;
  if not Assigned(FPushPin) then
    Exit;
  if Card > 9 then
    Exit;
  if Card < 0 then
  begin
    FPushPin.FCard := -1;
    ToLog('Closing up acquiring of data')
  end
  else
  begin
    // Check the name
    NewChipset := 2;
    ChkStr := ChipSet;
    ChkStr := lowercase(ChkStr);
    if Pos('flexcop', ChkStr) <> 0 then
      NewChipset := 1;
    if Pos('b2c2', ChkStr) <> 0 then
      NewChipset := 1;
    if Pos('saa7146', ChkStr) <> 0 then
      NewChipset := 0;
    if NewChipset = 2 then
    begin
      // Make sure the same file issues a restart
      if FPushPin.FChipset > 1 then
        NewChipset := FPushPin.FChipset + 1;
      ToLog(format('Setting up for using file %s', [Chipset]));
    end
    else
      ToLog(format('Setting up for chipset %s, card %d', [Chipset, Card]));
    FPushPin.FChipsetName := Chipset;
    FPushPin.FChipset     := NewChipset;
    FPushPin.FCard        := Card;
  end;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>     S_OK
            <Overtaken>  Overtaken count

  Descript: Get overtaken count
  Notes   :
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.GetOvertaken(out Overtaken: Integer): HRESULT; stdcall;
begin
  Overtaken := FPushPin.FOvertaken;
  Result := S_OK;
end;


{------------------------------------------------------------------------------
  Params  : <FileName>          File to create
                                or empty to close any opened file
  Returns : <Result>            S_OK    if file created
                                S_FALSE if any error or file closed

  Descript: Create or close a file for writing the data to
  Notes   : Will always close any created file when called
 ------------------------------------------------------------------------------}
function TMajorScriptPushSource.SetDataFile(FileName: PChar): HRESULT;
begin
//  ToLog('TMajorScriptPushSource.SetDataFile');
  Result := S_FALSE;
  if Assigned(FDataStream) then
    FreeAndNil(FDataStream);
  if Length(FileName) > 0 then
  begin
    try
      FDataStream := TFileStream.Create(FileName, fmCreate or fmShareDenyNone);
      ToLog('SetDataFile file created');
      Result := S_OK;
    except
      FreeAndNil(FDataStream);
      ToLog('SetDataFile file not created due to some error (e.g. filename)');
    end;
  end
  else
    ToLog('SetDataFile file closed');
end;


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

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

  TBCClassFactory.CreateFilter(TMajorScriptPushSource, 'Major Script Push Source', CLSID_MajorScriptPushSource,
    CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE, 1, @SudPins);
end.
