{******************************************************************************}
{ FileName............: StreamReaderPico                                       }
{ Project.............:                                                        }
{ Author(s)...........: MM                                                     }
{ Version.............: 1.00                                                   }
{------------------------------------------------------------------------------}
{  Front end budget card/Flexcop interface (based on StreamReader API)         }
{  using Pico script files.                                                    }
{                                                                              }
{  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. }
{                                                                              }
{------------------------------------------------------------------------------}
{                                                                              }
{  StreamReader function calls                                                 }
{    CheckForDvb       Check for available hardware                            }
{    DelFilter         Remove filter from list                                 }
{    SendDiSEqC        Send DiSEqC command                                     }
{    SetBitFilter      Set PID filter with additional requirements             }
{    SetChannel        Set the tuner                                           }
{    SetFilter         Set PID filter                                          }
{    SetRemoteControl  Set remote control                                      }
{    StartDVB          Initialize hardware                                     }
{    StopDVB           Deinitialize hardware                                   }
{    SetFilterEx       Differently called SetFilter                            }
{                                                                              }
{------------------------------------------------------------------------------}
{                                                                              }
{ Version   Date   Comment                                                     }
{  1.00   20060402 - Initial release                                           }
{******************************************************************************}
unit StreamReaderPico;
interface

uses
  MmSystem, Windows;

type
  PByte = ^Byte;
  ByteArray = array[0..$FFFF] of Byte;
  PByteArray = ^ByteArray;

  TFastDvbCallbackEx = procedure(Data: Pointer; Length: Integer; Pid: Integer); register;
  TFastDvbCallback   = procedure(Data: Pointer; Length: Integer); register;
  TStdDvbCallback    = procedure(Data: Pointer; Length: Integer); stdcall;
  TStdDvbCallbackEx  = procedure(Data: Pointer; Length: Integer; Pid: Integer); stdcall;
  TCdeclDvbCallback  = procedure(Data: Pointer; Length: Integer); cdecl;

  // Note: Ordinals 1/2/4 should stay at same indexes because it is also used
  //       by calling functions
  TCallbackTypes = (cbFastEx, cbFast, cbStd, cbStdEx, cbCdecl);

  function CheckForDvb     : Boolean; cdecl;
  function DelFilter       (Filter_num  : Dword): Boolean; cdecl;
  function SendDiSEqC      (DiSEqCType  : Dword;           Data        : Byte): Boolean; cdecl;
  function SetBitFilter    (Pid         : Word;            FilterData  : PByteArray;
                            FilterMask  : PByteArray;      FilterLength: Byte;
                            LpFunc      : Pointer;         LpFilter_num: PDword): Boolean; cdecl;
  function SetChannel      (Freq        : Dword;           Symb        : Dword;
                            Pol         : Dword;           Fec         : Dword;
                            Lof1        : Dword;           Lof2        : Dword;
                            LofSw       : Dword): Boolean; cdecl;
  function SetFilter       (Pid         : Word;            LpFunc      : Pointer;
                            CallBackType: Dword;           Size        : Dword;
                            LpFilter_Num: PDword): Boolean; cdecl;
  function SetRemoteControl(IR_Type     : Dword;           DevAddr     : Word;
                            LpFunc      : Pointer;         LpFilter_num: PDword):Boolean; cdecl;
  function StartDVB        : Boolean; cdecl;
  function StopDVB         : Boolean; cdecl;
  function SetFilterEx     (Pid         : Word;            LpFunc      : Pointer;
                            CallBackType: Dword;           Size        : Dword;
                            LpFilter_Num: PDword): Boolean; cdecl;

implementation

uses
  JanPico,
  Messages,
  FlexCopRegisters,
  FlexCopInterface,
  FlexCopIoControl,
  Saa7146aRegisters,
  Saa7146aInterface,
  Saa7146aIoControl,
  Classes,
  IniFiles, SyncObjs, SysUtils;


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

  TDecodeCallback = procedure(StreamData: PDvbTransportPackets);
  
const
  CStreamDataBufferSize  = SizeOf(TDvbTransportPackets);   // Exactly the size
  CStreamDataBufferSize2 = SizeOf(TDvbTransportPackets2);  // One too many

type
  TPicoScript = class(TObject)
    FPath   : AnsiString;
    FScript : TJanPico;
    FMessage: AnsiString;
  private
    procedure PicoUses(Sender: TjanPico; const Include: string;
      var Text: string; var Handled: Boolean);
    procedure PicoExternal(Sender: TjanPico; Symbol: string);
  public
    function  ScriptLoad(Script: AnsiString): Boolean;
    procedure ScriptUnload;
    function  ScriptExecute(FunctionCall: PChar; InputParameters: OleVariant; var OutputParameters: OleVariant): Boolean;
  end;


  // The data thread is the work horse of the application. It receives the DVB data,
  // processes it, and sends to the filters
  TDataThread = class(TThread)
  private
    // Setup
    FCardNumber        : Integer;                // Card number
    FDecodeCallback    : TDecodeCallback;        // Callback for decoding data received
    FStreamData        : PDvbTransportPackets2;  // Current pointer to stream data (one too many for misc. processing)
    // Status/runtime data
    FThreadHandle      : THandle;                // Handle to driver as used in thread
    FBufferId          : Word;                   // Buffer identifier
    FBuffers           : Word;                   // Buffer used
    FHasStopped        : Boolean;                // Flag indicating thread not running
    FProgrammedStop    : Boolean;                // If true indicates programmed termination
    FOvertaken         : Word;                   // Number of buffers we were too late for (NOT necessarily missed!)
    FPacketBufferCount : Dword;                  // Counter for received number of buffers
    FPacketTiming      : Extended;               // Timing per packet (high performance frequency resolution)
    FError             : AnsiString;             // Error
    FSuspend           : Boolean;                // True request suspend of thread ('synchronized')
  protected
  public
  end;

  TDataThreadSaa7146a = class(TDataThread)
  protected
    procedure Execute; override;
  end;

  TDataThreadFlexCop = class(TDataThread)
  protected
    procedure Execute; override;
  end;



  // PID filter definition
  TFilter = record
    Active          : Boolean;                   // Filter is (to be) set active
    Pid             : Word;                      // Only used for cross reference
    CountDetected   : Integer;                      // Debug counter
    CountCheckedOut : Integer;                   // Debug counter
    CountCalled     : Integer;                   // Debug counter
    CallBackFunction: Pointer;                   // Function to call
    CallBackType    : TCallbackTypes;            // Type of function to use for callback
    FilterData      : array of Byte;             // Additional bytes to check (from 4th byte in packet)
    FilterMask      : array of Byte;             // Mask data for FilterData
    PacketBuffer    : PByteArray;                // Packet buffer if not every single packet is
                                                 // directly passed on
    PacketBufferSize: Integer;                   // Size of buffer (packets)
    PacketIndex     : Integer;                   // Packets in buffer
  end;
  PTFilters = ^TFilters;
  TFilters = record
    Filters         : array[0..255] of TFilter; // The filter definitions
                                                // Index 0 use for passing on ALL data
    CrossReference  : array[0..$1FFF] of Byte;  // Pid index references to <Filters>
    Active          : Word;                     // Number of active filters
  end;

var
  IniFile              : TMemIniFile;            // Ini file
  ScriptLocation       : AnsiString;             // Script location
  Script               : TPicoScript;            // Script object
  PacketThread         : TDataThread;            // Thread handling packets
  FilterLock           : TCriticalSection;
  Filters              : TFilters;
  PacketSize           : Byte;                   // Size of a packet to pass on
  PassAll              : Boolean;                // True if all data to be passed on
                                                 // Forces use of filter index 0
  PassAllPid           : Word;                   // Special PID which can also be used
                                                 // for passing all data

  ForceSinglePacket    : Boolean;                // True forces single packets (no buffer is used)                                                                                      

  LogStream            : TFileStream;            // Filestream for log
  LogLevel             : Byte;                   // LogLevel (00 = no log)
                                                 //  $x0 = No log
                                                 //  $x1 = Lowest level
                                                 //  $x2 = Command errors
                                                 //  $x3 = Procedure/Function entries
                                                 //  $x4 = Procedure/Function specifics
                                                 //  $x5 = Generic procedure/Function entries


{------------------------------------------------------------------------------
  Params  : <LogString>  Data to log
            <Level>      Log level: if this number if <= <LogLevel> then
                         it is logged
                         $8x indicates that the string is intended for
                             displaying on form too.
  Returns : -

  Descript: Write data to log. A timestamp is added.
  Notes   :
 ------------------------------------------------------------------------------}
procedure ToLog(LogString: string; Level: Byte);
var
  NewLog: string;
begin
  try
    // Only log if the level is high enough
    if (Level and $0F) > LogLevel then
      Exit;
    // The check on <LogStream> is necessary because the application might
    // call this prior to completing initialization
    if not Assigned(LogStream) then
      Exit;
    NewLog := FormatDateTime('YYYYMMDD"T"HHMMSS"  "', Now) + LogString + #13#10;
    LogStream.Write(NewLog[1], Length(NewLog));
  except
  end;  
end;


{------------------------------------------------------------------------------
  Params  : <Section>    Section to access in INI file
            <Paremeter>  Paremeter in INI file
            <Default>    Default value (eg. if not present in INI file)
  Returns : <Result>     String value for parameter

  Descript: Get parameter from INI file.
  Notes   :
 ------------------------------------------------------------------------------}
function GetParameter(Section: string; Parameter: string; Default: string): string;
var
  FromIni : string;
  Position: Integer;
  TempStr : string;
begin
  try
    ToLog('GetParameter (Section: [' + Section + '], Parameter: [' + Parameter + '].', $03);
    if not Assigned(IniFile) then
      Exit;
    FromIni := IniFile.ReadString(Section, Parameter, Default);
    // Strip out leading/trailing spaces
    FromIni := Trim(FromIni);
    // Check for starting string parameter
    Position := Pos('''', FromIni);
    if Position = 1 then
    begin
      TempStr  := Copy(FromIni, Position+1, 255);
      // Find ending of string
      Position := Pos('''', TempStr);
      if Position <> 0 then
      begin
        // End of string found, which will be the result
        Result := Copy(TempStr, 1, Position-1);
        ToLog('Result: [' + Result + '].', $05);
        Exit;
      end;
    end
    else
    begin
      Position := Pos('"', FromIni);
      if Position = 1 then
      begin
        TempStr := Copy(FromIni, Position+1, 255);
        // Find ending of string
        Position := Pos('"', TempStr);
        if Position <> 0 then
        begin
          // End of string found, which will be the result
          Result := Copy(TempStr, 1, Position-1);
          ToLog('Result: [' + Result + '].', $05);
          Exit;
        end;
      end;
    end;
    // We know we don't have a string type so handle the whole string as
    // normal text. We could have a comment in it so check this too
    Position := Pos(';', FromIni);
    if Position <> 0 then
    begin
      TempStr := Copy(FromIni, 1, Position-1);
      // Strip out leading/trailing spaces
      Result := Trim(TempStr);
    end
    else
      Result := FromIni;
    ToLog('Result: [' + Result + '].', $05);
  except
  end;
end;


{******************************************************************************}
{                             PICO SCRIPT START                                }
{******************************************************************************}

{------------------------------------------------------------------------------
  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
  Result := False;
  FMessage := '';
  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
        FMessage := 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
      FMessage := E.Message;
      FreeAndNil(FScript);
      Exit;
    end;
  end;
  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
  Result := False;
  if not Assigned(FScript) then
  begin
    FMessage := '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
                          FMessage := 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
        FMessage := E.Message;
        Exit;
      end;
    end;
  end;
  // Execute
  try
    FScript.ExecuteFunction(FunctionCall);
  except
    on E: Exception do
    begin
      FMessage := 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
                         FMessage := 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
        FMessage := 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
        FMessage := format('ScriptExecute stack (bottom -> top) [%d]  --  %s', [StackNo, StackStr])
      else
        FMessage := 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;

{******************************************************************************}
{                             PICO SCRIPT END                                  }
{******************************************************************************}


{******************************************************************************}
{                             DATA THREAD START                                }
{******************************************************************************}

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

  Descript: Execution of thread. This thread handles reception of data.
  Notes   : We get an interrupt at both edges of the field indicator (for a
            SAA7146A based card), meaning that we get notified when a switch is
            made from 'odd' -> 'even' and from 'even' -> 'odd'
            The rate is about 25 interrupts a second
 ------------------------------------------------------------------------------}

procedure TDataThreadSaa7146a.Execute;
var
  Data        : Dword;
  LastBuffer  : Dword;
  Buffer      : TSaa7146aTransferBuffer;
  TickCount   : Dword;
  UpdateTiming: Dword;
  PacketTiming: TLargeInteger;
  PacketCount : Integer;
  StartTiming : TLargeInteger;
  EndTiming   : TLargeInteger;
  TimerCaps   : TTimeCaps;
begin
  FPacketBufferCount := 0;
  FHasStopped        := False;
  FProgrammedStop    := False;
  FError             := '';
  UpdateTiming := GetTickCOunt;
  PacketTiming := 0;
  PacketCount  := 0;
  try
    FThreadHandle := Saa7146aCreateFile(FCardNumber);
    if not Terminated then
    begin
      GetMem(FStreamData, SizeOf(TDvbTransportPackets2));
      Buffer.Identifier      := FBufferId;
      Buffer.TransferAddress := PChar(FStreamData);
      Buffer.TargetIndex     := 0;
      Buffer.TransferLength  := CStreamDataBufferSize;

      // Wait for application to have started and such
      LastBuffer := 0;
      Data := $FFFF;
      // Increase resolution for timings to smallest possible (otherwise a
      // sleep(1) will take much longer!)
      if timeGetDevCaps(@TimerCaps, SizeOf(TimerCaps)) = TIMERR_NOERROR then
        timeBeginPeriod(TimerCaps.wPeriodMin);
      try
        while not Terminated do
        begin
          if FPacketBufferCount = $FFFF then
            FPacketBufferCount := 0
          else
            Inc(FPacketBufferCount);
          // Suspending can be initiated once every loop
          if FSuspend then
            Suspend;

          // First check if there are already buffers filled
          Saa7146aReadFromSaa7146aRegister(FThreadHandle, CSaa7146aEcT1R, Data);
          // If we get an incorrect packet identification then the SAA7146
          // program has not received any data yet.
          if Data >= FBuffers then
          begin
            Data := 0;
            // Since we don't have any data no need to be fast
            Sleep(100);
          end;
          // If no new data, wait (or if first time)
          if Data = LastBuffer then
          begin
            repeat
              Sleep(3);
              Saa7146aReadFromSaa7146aRegister(FThreadHandle, CSaa7146aEcT1R, Data);
            until Terminated or (Data <> LastBuffer);
          end
          else
          begin
            if FOverTaken = $FFFF then
              FOverTaken := 0
            else
              Inc(FOvertaken);
          end;
          Buffer.SourceIndex := CDvbPacketBufferSize * LastBuffer;
          // Next buffer to wait for
          Inc(LastBuffer);
          // Circular buffer
          if LastBuffer = FBuffers then
            LastBuffer := 0;
          // Get data in local buffer
          Saa7146aReadFromDma(FThreadHandle, Buffer);
          // Process packet data (keep record of the time it takes)
          QueryPerformanceCounter(StartTiming);
          if Assigned(@FDecodeCallback) then
            FDecodeCallback(PDvbTransportPackets(FStreamData));

          QueryPerformanceCounter(EndTiming);
          PacketTiming := PacketTiming + (EndTiming - StartTiming);
          Inc(PacketCount, CDvbPacketVSync);
          // Update statistical data
          TickCount := GetTickCount;
          if Abs(TickCount - UpdateTiming) > 1000 then
          begin
            FPacketTiming := PacketTiming / PacketCount;
            UpdateTiming := TickCount;
            PacketTiming := 0;
            PacketCount  := 0;
          end;
        end;
      finally
        FHasStopped := True;
        Saa7146aCloseHandle(FThreadHandle);
        timeEndPeriod(TimerCaps.wPeriodMin);
        if Assigned(FStreamData) then
          FreeMem(FStreamData);
        FStreamData := nil;
      end;
    end;
  except
    FError := 'Unexpected termination of SAA7146A thread.';
    FHasStopped := True;
  end;
end;

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

  Descript: Execution of thread. This thread handles reception of data.
  Notes   :
 ------------------------------------------------------------------------------}

procedure TDataThreadFlexCop.Execute;
var
  TickCount         : Dword;
  UpdateTiming      : Dword;
  PacketTiming      : TLargeInteger;
  PacketCount       : Integer;
  StartTiming       : TLargeInteger;
  EndTiming         : TLargeInteger;
  FlexCopBuffer     : TFlexCopFifoTransferBuffer;
  FlexCopLastRead   : Dword;
  FlexCopIrqHandling: TFlexCopIrqTransferBuffer; // Subbuffer 0 interrupts
  SyncRequired      : Integer;                   // Counts invalid sync at start buffer
  SyncOffset        : Integer;                   // Offset for correction
  SyncData          : TDvbTransportPacket;       // Remainder data previous data block
  TimerCaps         : TTimeCaps;
begin
  FPacketBufferCount := 0;
  FHasStopped        := False;
  FProgrammedStop    := False;
  FError             := '';
  UpdateTiming       := GetTickCOunt;
  PacketTiming       := 0;
  PacketCount        := 0;
  try
    FThreadHandle := FlexCopCreateFile(FCardNumber);
    if not Terminated then
    begin
      GetMem(FStreamData, SizeOf(TDvbTransportPackets2));
      // Dma 1, subbuffer 0 interrrupts are used
      FlexCopIrqHandling.Identifier := FBufferId;
      FlexCopReadFromIrqHandling(FThreadHandle, FlexCopIrqHandling);
      if not FlexCopIrqHandling.Information.IrqBufferingIsActive then
        Terminate;
      FlexCopLastRead := $FFFF;
      SyncRequired    := 0;
      SyncOffset      := 0;
      FlexCopBuffer.TransferAddress[0] := @FStreamData^[0][SyncOffset];
      // Increase resolution for timings to smallest possible (otherwise a
      // sleep(1) will take much longer!)
      if timeGetDevCaps(@TimerCaps, SizeOf(TimerCaps)) = TIMERR_NOERROR then
        timeBeginPeriod(TimerCaps.wPeriodMin);
      try
        while not Terminated do
        begin
          if FPacketBufferCount = $FFFF then
            FPacketBufferCount := 0
          else
            Inc(FPacketBufferCount);
          // Suspending can be initiated once every loop
          if FSuspend then
            Suspend;

          // Get information of buffer being filled by driver
          FlexCopReadFromIrqHandling(FThreadHandle, FlexCopIrqHandling);
          FOvertaken := FlexCopIrqHandling.Information.FifoOverflows;
          while (not Terminated) and (FlexCopIrqHandling.Information.FifoBufferPreviousIndex = FlexCopLastRead) do
          begin
            Sleep(3);
            FlexCopReadFromIrqHandling(FThreadHandle, FlexCopIrqHandling);
          end;
          Inc(FlexCopLastRead);
          if FlexCopLastRead >
            FlexCopIrqHandling.Information.FifoBufferLastIndex then
            FlexCopLastRead := FlexCopIrqHandling.Information.FifoBufferFirstIndex;
          // Read buffer
          FlexCopBuffer.TransferLength := CStreamDataBufferSize;
          FlexCopBuffer.Identifier     := FlexCopLastRead;
          FlexCopReadFromFifo(FThreadHandle, FlexCopBuffer);

          // Check first packet (the offset should have made the second packet correct)
          if (FStreamData^[1][0] <> $47) then
            Inc(SyncRequired)
          else if SyncRequired > 0 then
            Dec(SyncRequired);
          if SyncRequired > 50 then
          begin
            // Search for sync
            SyncOffset := 0;
            while (SyncOffset < CDvbPacketSize) and (FStreamData^[0][SyncOffset] <> $47) do
              Inc(SyncOffset);
            // 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 (SyncOffset = 0) or (SyncOffset = CDvbPacketSize) then
              SyncOffset := 0
            else
              SyncOffset := CDvbPacketSize - SyncOffset;
            FlexCopBuffer.TransferAddress[0] := @FStreamData^[0][SyncOffset];
            SyncRequired := 0;
          end
          else
          begin
            // We have to store the data at the end and use it for the
            // next block of data
            if SyncOffset <> 0 then
            begin
              // Copy remainder of previous block
              CopyMemory(FStreamData, @SyncData, SyncOffset);
              // Copy leftover of current block ('one too many' packet)
              CopyMemory(@SyncData, @FStreamData^[High(TDvbTransportPackets2)], SyncOffset);
            end;

            QueryPerformanceCounter(StartTiming);
            if Assigned(@FDecodeCallback) then
              FDecodeCallback(PDvbTransportPackets(FStreamData));

            QueryPerformanceCounter(EndTiming);
            PacketTiming := PacketTiming + (EndTiming - StartTiming);
            Inc(PacketCount, CDvbPacketVSync);
            // Update statistical data
            TickCount := GetTickCount;
            if Abs(TickCount - UpdateTiming) > 1000 then
            begin
              FPacketTiming := PacketTiming / PacketCount;
              UpdateTiming := TickCount;
              PacketTiming := 0;
              PacketCount  := 0;
            end;
          end;
        end;
      finally
        FHasStopped := True;
        FlexCopCloseHandle(FThreadHandle);
        timeEndPeriod(TimerCaps.wPeriodMin);
        if Assigned(FStreamData) then
          FreeMem(FStreamData);
        FStreamData := nil;
      end;
    end;
  except
    FHasStopped := True;
    FError := 'Unexpected termination of FlexCop thread.';
  end;
end;

{******************************************************************************}
{                             DATA THREAD END                                  }
{******************************************************************************}




{******************************************************************************}
{                           START FILTER FUNCTIONS                             }
{******************************************************************************}
{------------------------------------------------------------------------------
  Params  : <Filter>  Pointer to filter data
  Returns : -

  Descript: Update cross reference table for filters.
  Notes   :
------------------------------------------------------------------------------}
procedure FilterUpdateCrossReference(Filter: PTFilters);
var
  FilterIndex: Integer;
begin
  // Clear cross references
  Filter.Active := 0;
  for FilterIndex := 1 to High(Filter.CrossReference)
    do
    Filter.CrossReference[FilterIndex] := 0;
  // Renew cross reference
  for FilterIndex := 1 to High(Filter.Filters) do
    if Filter.Filters[FilterIndex].Active then
    begin
      Filter.CrossReference[Filter.Filters[FilterIndex].Pid] := FilterIndex;
      Inc(Filter.Active);
    end;
end;


{------------------------------------------------------------------------------
  Params  : <Filter>      Filter to use
            <FilterIndex> Filter index to clear
                          0 will stop all filters
  Returns : <Result>      0 if no error

  Descript: Clear filter data
  Notes   :
------------------------------------------------------------------------------}

function DvbStopFilter(Filter: PTFilters; FilterIndex: Dword): Dword; stdcall;
var
  ClearAll: Boolean;
begin
  FilterLock.Acquire;
  try
    Result := 0;
    if FilterIndex > High(Filter.Filters) then
      Exit;
    // Check for 'all' data passing to stop
    if FilterIndex = 0 then
    begin
      ClearAll := True;
      FilterIndex := 1;
      PassAll := False;
    end
    else
      ClearAll := False;

    repeat
      Filter.Filters[FilterIndex].Active := False;
      // Remove mask data
      Filter.Filters[FilterIndex].FilterData := nil;
      Filter.Filters[FilterIndex].FilterMask := nil;
      if Assigned(Filter.Filters[FilterIndex].PacketBuffer) then
        FreeMem(Filter.Filters[FilterIndex].PacketBuffer);
      Filter.Filters[FilterIndex].PacketBuffer := nil;
      Filter.Filters[FilterIndex].PacketBufferSize := 0;
      FilterUpdateCrossReference(Filter);
      Inc(FilterIndex);
      if not ClearAll then
        FilterIndex := (High(Filter.Filters)+1);
    until FilterIndex > High(Filter.Filters);
  finally
    FilterLock.Release;
  end;
end;

{------------------------------------------------------------------------------
  Params  : <Filter>        Filter to use
            <Pid>           Pid for filter to set
                            >$1FFF will initiate passing on all data until
                            DelFilter with filter id 0 is used
            <FilterProc>    Callback function for Pid
            <CallBackType>  Type of filter callback (see TFilter)
            <FilterData>    Optional filter data
            <FilterMask>    Optional filter mask for FilterData (size must be the same)
            <BufferSize>    Size of buffer for packets
  Returns : <Result>        Filter index/identifier
                            $FFFF if error

  Descript: Set filter data
  Notes   :
------------------------------------------------------------------------------}

function DvbSetFilter(Filter: PTFilters; Pid: Word; FilterProc: Pointer;
  CallBackType: TCallbackTypes; FilterData: array of Byte; FilterMask: array of Byte;
  BufferSize: Integer): Dword; stdcall;
var
  FilterIndex: Integer;
  Valid      : Boolean;
  Loop       : Integer;
begin
  if ForceSinglePacket then
  begin
    if BufferSize > 0 then
      ToLog('DvbSetFilter requested 4K buffer but forcing single packets.', $04);
    BufferSize := 0;
  end;
  Result := $FFFF;
  FilterLock.Acquire;
  try
    if (Pid > High(Filter.CrossReference)) or (Pid = PassAllPid) then
    begin
      // Remove all present filters
      DvbStopFilter(@Filters, 0);
      FilterIndex := 0;
      Valid := True;
    end
    else
    begin
      Valid := False;
      // First try to find existing active filter
      if Filter.CrossReference[Pid] <> 0 then
      begin
        FilterIndex := Filter.CrossReference[Pid];
        Valid := True;
      end
      else
      begin
        // No existing filter found for Pid, find first available one
        FilterIndex := 1;
        repeat
          if Filter.Filters[FilterIndex].Active then
            Inc(FilterIndex)
          else
            Valid := True;
        until Valid or (FilterIndex > High(Filter.Filters));
      end;
    end;
    if Valid then
    begin
      // Now set filter data and
      Filter.Filters[FilterIndex].Pid := Pid;
      Filter.Filters[FilterIndex].CallBackFunction := FilterProc;

      Filter.Filters[FilterIndex].CallBackType := CallBackType;
      Filter.Filters[FilterIndex].PacketBuffer := nil;
      Filter.Filters[FilterIndex].PacketBufferSize := 0;
      Filter.Filters[FilterIndex].PacketIndex := 0;
      Filter.Filters[FilterIndex].FilterMask := nil;
      Filter.Filters[FilterIndex].FilterData := nil;
      if Length(FilterData) <> Length(FilterMask) then
        Exit;
      if Length(FilterData) > 0 then
      begin
        try
          SetLength(Filter.Filters[FilterIndex].FilterData, Length(FilterData));
          SetLength(Filter.Filters[FilterIndex].FilterMask, Length(FilterMask));
          for Loop := 0 to Length(FilterData)-1 do
            Filter.Filters[FilterIndex].FilterData[Loop] := FilterData[Loop];
          for Loop := 0 to Length(FilterMask)-1 do
            Filter.Filters[FilterIndex].FilterMask[Loop] := FilterMask[Loop];
        except
          Filter.Filters[FilterIndex].FilterData := nil;
          Filter.Filters[FilterIndex].FilterMask := nil;
        end;
      end;
      Filter.Filters[FilterIndex].CountDetected   := 0;
      Filter.Filters[FilterIndex].CountCheckedOut := 0;
      Filter.Filters[FilterIndex].CountCalled     := 0;
      Filter.Filters[FilterIndex].Active := True;
      FilterUpdateCrossReference(Filter);
      if BufferSize > 0 then
      begin
        // Number of whole packets in buffer
        Filter.Filters[FilterIndex].PacketBufferSize := BufferSize div PacketSize;
        try
          ToLog(format('DvbSetFilter acquiring %d bytes (%d packets).',
            [Filter.Filters[FilterIndex].PacketBufferSize * PacketSize,
             Filter.Filters[FilterIndex].PacketBufferSize]), $04);
          GetMem(Filter.Filters[FilterIndex].PacketBuffer,
            Filter.Filters[FilterIndex].PacketBufferSize * PacketSize);
        except
          ToLog('DvbSetFilter error acquiring memory.', $02);
          Filter.Filters[FilterIndex].PacketBufferSize := 0;
        end;
      end;
      Result := FilterIndex;
      ToLog(format('DvbSetFilter filter index %d.', [FilterIndex]), $04);
      if FilterIndex = 0 then
      begin
        PassAll := True;
          ToLog('DvbSetFilter passing all data.', $02);
      end;
    end;
  finally
    FilterLock.Release;
  end;
end;
{******************************************************************************}
{                            END FILTER FUNCTIONS                              }
{******************************************************************************}


{------------------------------------------------------------------------------
  Params  : <StreamPacketData>  Packet data buffer
  Returns : <Result>            True if valid Pid (no other errors detected)
            <Pid>               Pid value

  Descript: Get PID from transport stream.
  Notes   :
 ------------------------------------------------------------------------------}

function DvbFilterGetPid(StreamPacketData: PDvbTransportPacket; var Pid: Word):
  Boolean;
begin
  Result := False;
  // One of the few checks at this point is the synchronization byte which must be correct
  if StreamPacketData[0] = $47 then
    Result := True;
  Pid := ((StreamPacketData[1] and $1F) shl 8) or StreamPacketData[2];
end;

{------------------------------------------------------------------------------
  Params  : <StreamPacketData>  Packet data buffer
  Returns : <Result>            True if valid offset
                                False if error or no payload
            <Offset>            Offset into first data byte of payload

  Descript: Get offset where payload starts.
  Notes   :
 ------------------------------------------------------------------------------}

function DvbGetPayloadOffset(StreamPacketData: PDvbTransportPacket; var Offset:
  Word): Boolean;
var
  AdaptationFieldControl: Byte;
begin
  Result := False;
  Offset := 0;
  // The start of the payload depends on the adaptation field. If there is
  // an adaptation field then the payload starts after this. If there is no
  // adaptation field then the payload start immediately.
  // Also there is the posibility that there is no payload at all.
  AdaptationFieldControl := StreamPacketData[3] and $30;
  case AdaptationFieldControl of
    $00: Exit; // Reserved
    $10: Offset := 4; // Payload only
    $20: Exit; // Adaptation field only, no payload
    $30: begin
           Offset := StreamPacketData[4] + 5; // Adaptation field with payload
           // Check for excessive value
           if Offset > CDvbPacketSize then
           begin
             Offset := 0;
             Exit;
           end;
         end;    
  end;
  Result := True;
end;


{------------------------------------------------------------------------------
  Params  : <StreamData>  Stream packets (multiple packets of 188 bytes)
  Returns : -

  Descript: Process transport stream.
  Notes   :
 ------------------------------------------------------------------------------}
procedure ProcessTransportStreamData(StreamData: PDvbTransportPackets);
var
  StreamPacket: Word;
  Pid         : Word;
  Ref         : Byte;
  Process     : Boolean;
  Loop        : Integer;
  Data        : Byte;
  InitialStart: Word;
begin
  try
    for StreamPacket := 0 to CDvbPacketVSync-1 do
      // The Pid is the identifier of what type of information we are dealing with
      if DvbFilterGetPid(@StreamData[StreamPacket], Pid) then
      begin
        if PassAll then
          Ref := 0
        else  
          Ref := Filters.Crossreference[Pid];
        if PassAll or (Ref > 0) then
        begin
          if Filters.Filters[Ref].Active then
          begin
            if Filters.Filters[Ref].CountDetected = MaxInt then
              Filters.Filters[Ref].CountDetected := 0
            else
              Inc(Filters.Filters[Ref].CountDetected);

            Process := False;
            // First check if there is mask data to check for
            if Length(Filters.Filters[Ref].FilterData) > 0 then
            begin
              // If we check the data we must make sure that our packet is at
              // the start of a payload
              if (StreamData[StreamPacket][1] and $40) <> 0 then
              begin
                // Get offset to payload
                if DvbGetPayloadOffset(@StreamData[StreamPacket], InitialStart) then
                begin
                  // Check mask data
                  Process := True;
                  for Loop := 0 to Length(Filters.Filters[Ref].FilterData)-1 do
                  begin
                    Data := StreamData[StreamPacket][InitialStart + Loop];
                    Data := Data and Filters.Filters[Ref].FilterMask[Loop];
                    if (Data <> Filters.Filters[Ref].FilterData[Loop]) then
                    begin
                      // Exit check if match fails
                      Process := False;
                      Break;
                    end;
                  end;
                end;
              end
            end
            else
              Process := True;

            if Process then
            begin
              if Filters.Filters[Ref].CountCheckedOut = MaxInt then
                Filters.Filters[Ref].CountCheckedOut := 0
              else
                Inc(Filters.Filters[Ref].CountCheckedOut);
              // Valid packet data found (either just the PID or also the masked data)
              // Now buffer it (if indicated)
              if Filters.Filters[Ref].PacketBufferSize > 0 then
              begin
                // Buffering active, always copy first
                CopyMemory(@Filters.Filters[Ref].PacketBuffer[Filters.Filters[Ref].PacketIndex*PacketSize],
                  @StreamData[StreamPacket][CDvbPacketSize-PacketSize], PacketSize);
                // Adjust packets in buffer
                Inc(Filters.Filters[Ref].PacketIndex);
                if Filters.Filters[Ref].PacketIndex = Filters.Filters[Ref].PacketBufferSize then
                begin
                  if Filters.Filters[Ref].CountCalled = MaxInt then
                    Filters.Filters[Ref].CountCalled := 0
                  else
                    Inc(Filters.Filters[Ref].CountCalled);
                  // If buffer full, pass it on to callback
                  case Filters.Filters[Ref].CallBackType of
                    cbFastEx: TFastDvbCallBackEx(Filters.Filters[Ref].CallBackFunction)(Filters.Filters[Ref].PacketBuffer,
                                Filters.Filters[Ref].PacketIndex * PacketSize, Pid);
                    cbFast  : TFastDvbCallBack  (Filters.Filters[Ref].CallBackFunction)(Filters.Filters[Ref].PacketBuffer,
                                Filters.Filters[Ref].PacketIndex * PacketSize);
                    cbStd   : TStdDvbCallBack   (Filters.Filters[Ref].CallBackFunction)(Filters.Filters[Ref].PacketBuffer,
                                Filters.Filters[Ref].PacketIndex * PacketSize);
                    cbStdEx : TStdDvbCallBackEx (Filters.Filters[Ref].CallBackFunction)(Filters.Filters[Ref].PacketBuffer,
                                Filters.Filters[Ref].PacketIndex * PacketSize, Pid);
                    cbCdecl : TCdeclDvbCallBack (Filters.Filters[Ref].CallBackFunction)(Filters.Filters[Ref].PacketBuffer,
                                Filters.Filters[Ref].PacketIndex * PacketSize);
                  end;
                  Filters.Filters[Ref].PacketIndex := 0;
                end;
              end
              else
              begin
                if Filters.Filters[Ref].CountCalled = MaxInt then
                  Filters.Filters[Ref].CountCalled := 0
                else
                  Inc(Filters.Filters[Ref].CountCalled);
                // No buffering, always pass on single packets
                case Filters.Filters[Ref].CallBackType of
                  cbFastEx: TFastDvbCallBackEx(Filters.Filters[Ref].CallBackFunction)(@StreamData[StreamPacket][CDvbPacketSize-PacketSize],
                              PacketSize, Pid);
                  cbFast  : TFastDvbCallBack  (Filters.Filters[Ref].CallBackFunction)(@StreamData[StreamPacket][CDvbPacketSize-PacketSize],
                              PacketSize);
                  cbStd   : TStdDvbCallBack   (Filters.Filters[Ref].CallBackFunction)(@StreamData[StreamPacket][CDvbPacketSize-PacketSize],
                              PacketSize);
                  cbStdEx : TStdDvbCallBackEx (Filters.Filters[Ref].CallBackFunction)(@StreamData[StreamPacket][CDvbPacketSize-PacketSize],
                              PacketSize, Pid);
                  cbCdecl : TCdeclDvbCallBack (Filters.Filters[Ref].CallBackFunction)(@StreamData[StreamPacket][CDvbPacketSize-PacketSize],
                              PacketSize);
                end;
              end;
            end;
          end;
        end;
      end;
  except
  end;
end;


{******************************************************************************}
{                               API FUNCTIONS                                  }
{                                                                              }
{******************************************************************************}
{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>          True if supported driver found
                              False if no driver found

  Descript: Checks if the driver is installed.
  Notes   :
 ------------------------------------------------------------------------------}
function CheckForDvb: Boolean; cdecl;
var
  InData : OleVariant;
  OutData: OleVariant;
begin
  Result := False;

  if not Assigned(Script) then
  begin
    ToLog('CheckForDVB error: Script not active.', $02);
    Exit;
  end;

  ToLog('CheckForDvb.', $04);
  try
    // Call script function
    VarClear(InData);
    VarClear(OutData);
    try
      OutData    := VarArrayCreate([0, 0], varVariant);
      OutData[0] := varAsType(0, varInteger);
      if not Script.ScriptExecute('CheckForDvb', InData, OutData) then
      begin
        ToLog(format('Script function "CheckForDvb" failed [%s --> %s].', [ScriptLocation, Script.FMessage]), $02);
        Exit;
      end;
      Result := (OutData[0] = -1);
      if Result then
        ToLog('CheckForDvb found a driver.', $02)
      else
        ToLog('CheckForDvb did not find a driver.', $02)
    finally
      VarClear(InData);
      VarClear(OutData);
    end;
  except
    Result := False;
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Filter_num>      The filter number/identifier to remove
                              $FFFF for remote control
  Returns : <Result>          Always true

  Descript: Stops the processing of a filter
  Notes   :
 ------------------------------------------------------------------------------}
function DelFilter(Filter_num: Dword): Boolean; cdecl;
begin
  ToLog(format('DelFilter removing filter number %d.', [Filter_num]), $04);
  // Filter number 0 is the remote control ....
  if Filter_num = $FFFF then
  begin
    // Stop remote control
  end
  else
    DvbStopFilter(@Filters, Filter_Num);
  Result := True;
end;


{------------------------------------------------------------------------------
  Params  : <DiSEqCType>  Desired action
                          0: None, disable DiSEqC
                          1: Simple, send tone burst only
                          2: Version 1.0, Multi, Send DiSEqC sequence
            <Data>        DiSEqCType
                          0  ->  Not used
                          1  ->    0 = Burst A
                                   1 = Burst B
                                 > 1 = Burst B (V1.03 added)
                          2  ->  Data is send 'as is' using
                                 the committed switch command

  Returns : <Result>      True  if success
                          False if error

  Descript: Send a DiSEqC message to the LNB.
  Notes   :
 ------------------------------------------------------------------------------}
function SendDiSEqC(DiSEqCType: Dword; Data: Byte): Boolean; cdecl;
var
  InData : OleVariant;
  OutData: OleVariant;
begin
  ToLog(format('SendDiSEqC type %d, data $%2.2x.', [DiSEqCType, Data]), $04);
  Result := False;

  if not Assigned(Script) then
  begin
    ToLog('SendDiSEqC error: Script not active.', $02);
    Exit;
  end;

  // Call script function
  VarClear(InData);
  VarClear(OutData);
  try
    InData     := VarArrayCreate([0, 1], varVariant);
    InData[0]  := VarAsType(Data, varInteger);
    InData[1]  := VarAsType(Integer(DiSEqCType), varInteger);
    OutData    := VarArrayCreate([0, 0], varVariant);
    OutData[0] := varAsType(0, varInteger);
    if not Script.ScriptExecute('SendDiSEqC', InData, OutData) then
    begin
      ToLog(format('Script function "SendDiSEqC" failed [%s --> %s].', [ScriptLocation, Script.FMessage]), $02);
      Exit;
    end;
    Result := (OutData[0] = -1);
    if not Result then
      ToLog('SendDiSEqC failed.', $02);
  finally
    VarClear(InData);
    VarClear(OutData);
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Pid>           Pid number
            <FilterData>    The additional bytes to inspect
            <FilterMask>    The mask to check the bytes with. Only the '1' masked
                            bits should match to be
            <FilterLength>  Length of FilterData/FilterMaks array
            <LpFunc>        Pointer to callback
                            This is a STDCALL function
  Returns : <Result>        True if filter set
                            False if any error
            <LpFilter_Num>  Filter identifier

  Descript: Creates a filter with additional selection criteria.
            Besides the PID the data at specific bytes must match the mask to
            be passed on.
  Notes   :
 ------------------------------------------------------------------------------}
function SetBitFilter(Pid: Word; FilterData: PByteArray; FilterMask: PByteArray;
                      FilterLength: Byte; LpFunc: Pointer; LpFilter_num: PDword): Boolean; cdecl;
var
  Data    : array of Byte;
  Mask    : array of Byte;
  Loop    : Integer;
  Id      : Dword;
  TempStr1: ShortString;
  TempStr2: ShortString;
begin
  ToLog(format('SetBitFilter, Pid %d, %d filter data bytes.', [Pid, Filterlength]), $04);
  Result := False;
  if FilterLength = 0 then
  begin
    Data := nil;
    Mask := nil;
  end
  else
  begin
    try
      TempStr1 := '$';
      TempStr2 := '$';
      SetLength(Data, Filterlength);
      SetLength(Mask, Filterlength);
      for Loop := 0 to Filterlength-1 do
      begin
        Data[Loop] := FilterData[Loop];
        Mask[Loop] := FilterMask[Loop];
        TempStr1 := TempStr1 + format('%2.2x ', [Data[Loop]]);
        TempStr2 := TempStr2 + format('%2.2x ', [Mask[Loop]]);
      end;
      ToLog(format('SetBitFilter, Data %s, Mask %s.', [TempStr1, TempStr2]), $04);
    except
      Data := nil;
      Mask := nil;
      ToLog('SetBitFilter error in data/mask.', $02);
      Exit;
    end;
  end;
  Id := DvbSetFilter(@Filters, Pid, LpFunc, cbStd, Data, Mask, 0);
  if Id <> $FFFF then
  begin
    try
      LpFilter_Num^ := Id;
      Result := True;
      if Id = 0 then
        ToLog('SetBitFilter success, passing on all data.', $04)
      else
        ToLog(format('SetBitFilter success, Pid %d has filter identifier %d.', [Pid, Id]), $04);
    except
      ToLog('SetBitFilter error passing back identifier.', $02);
      Result := False;
    end;
  end
  else
  begin
    ToLog(format('SetBitFilter setting filter for Pid %d failed.', [Pid]), $02);
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Freq>    Frequency (kHz)
            <Symb>    Symbol rate (symbols/sec)
            <Pol>     Polarity (0 = Horizontal, 1= Vertical)
            <Fec>     Forward Error correction
                      Not used. Always automatic FEC used.
            <Lof1>    Local Oscillator Frequency low band (kHz)
            <Lof2>    Local Oscillator Frequency high band (kHz)
            <Lofsw>   Switching frequency for using <Lof2> instead of <Lof1> (kHz)
  Returns : <Result>  True if no error (and tuned)
                      False if error or not tuned

  Descript: Sets the card's tuner to desired values.
  Notes   :
 ------------------------------------------------------------------------------}
function SetChannel(Freq: Dword; Symb: Dword; Pol: Dword; Fec: Dword;
                    Lof1: Dword; Lof2: Dword; LofSw: Dword): Boolean; cdecl;
var
  InData : OleVariant;
  OutData: OleVariant;
begin
  Result := False;
  case Pol of
    0:   ToLog(format('SetChannel H, %d kHz, %d S/s, Pol: %d, LOF1: %d kHz, LOF2: %d kHz, LOFsw: %d kHz.', [Freq, Symb, Pol, Lof1, Lof2, LofSw]), $04);
    1:   ToLog(format('SetChannel V, %d kHz, %d S/s, Pol: %d, LOF1: %d kHz, LOF2: %d kHz, LOFsw: %d kHz.', [Freq, Symb, Pol, Lof1, Lof2, LofSw]), $04);
    else ToLog(format('SetChannel Unknown polarity, %d kHz, %d S/s, Pol: %d, LOF1: %d kHz, LOF2: %d kHz, LOFsw: %d kHz.', [Freq, Symb, Pol, Lof1, Lof2, LofSw]), $04);
  end;
  if not Assigned(Script) then
  begin
    ToLog('SetChannel error: Script not active.', $02);
    Exit;
  end;

  // Call script function
  VarClear(InData);
  VarClear(OutData);
  try
    InData     := VarArrayCreate([0, 6], varVariant);
    InData[0]  := VarAsType(Integer(LofSw), varInteger);
    InData[1]  := VarAsType(Integer(Lof2),  varInteger);
    InData[2]  := VarAsType(Integer(Lof1),  varInteger);
    InData[3]  := VarAsType(Integer(Fec),   varInteger);
    InData[4]  := VarAsType(Integer(Pol),   varInteger);
    InData[5]  := VarAsType(Integer(Symb),  varInteger);
    InData[6]  := VarAsType(Integer(Freq),  varInteger);
    OutData    := VarArrayCreate([0, 0], varVariant);
    OutData[0] := varAsType(0, varInteger);
    if not Script.ScriptExecute('SetChannel', InData, OutData) then
    begin
      ToLog(format('Script function "SetChannel" failed [%s --> %s].', [ScriptLocation, Script.FMessage]), $02);
      Exit;
    end;
    Result := (OutData[0] = -1);
    if not Result then
      ToLog('SetChannel could not lock to channel in time.', $02);
  finally
    VarClear(InData);
    VarClear(OutData);
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Pid>           Pid number
            <LpFunc>        Pointer to callback
            <CallBackType>  Type of callback. Only types 1/2/4 are defined
            <Size>          Size of data to be returned in callback
                            Size of a packet is defined in INI file
                            1: Single packet
                            2: 4096 byte blocks
                               Note that only complete packets are returned,
                               thus for a 188 packet size data is passed on
                               when 21 packets are received
  Returns : <Result>        True if filter set
                            False if any error
            <LpFilter_Num>  Filter identifier

  Descript: Creates a filter for the indicated Pid.
  Notes   :
 ------------------------------------------------------------------------------}
function SetFilter(Pid: Word; LpFunc: Pointer; CallBackType: Dword; Size: Dword;
                   LpFilter_Num: PDword): Boolean; cdecl;
var
  Id   : Dword;
  CType: TCallbackTypes;
  Data : array of Byte;
  Mask : array of Byte;
begin
  ToLog('SetFilter.', $04);
  Result := False;
  case CallBackType of
    Ord(cbFast) : CType := cbFast;
    Ord(cbStd)  : CType := cbStd;
    Ord(cbCdecl): CType := cbCdecl;
    else begin
          ToLog('SetFilter invalid callback type detected.', $02);
          Exit;
         end;
  end;
  Data := nil;
  Mask := nil;
  if Size = 2 then
    Size := 4096
  else
    Size := 0;
  Id := DvbSetFilter(@Filters, Pid, LpFunc, CType, Data, Mask, Size);
  if Id <> $FFFF then
  begin
    try
      LpFilter_Num^ := Id;
      Result := True;
      if Id = 0 then
      begin
        if Size = 0 then
          ToLog(format('SetFilter success, callback type %d, passing on all data with filter identifier %d, single packets.', [CallBackType, Id]), $02)
        else
          ToLog(format('SetFilter success, callback type %d, passing on all data with filter identifier %d, 4K buffer requested.', [CallBackType, Id]), $02);
      end
      else
      begin
        if Size = 0 then
          ToLog(format('SetFilter success, callback type %d, Pid %d has filter identifier %d, single packets.', [CallBackType, Pid, Id]), $02)
        else
          ToLog(format('SetFilter success, callback type %d, Pid %d has filter identifier %d, 4K buffer requested.', [CallBackType, Pid, Id]), $02)
      end;
    except
      ToLog('SetFilter error passing back identifier.', $02);
      Result := False;
    end;
  end
  else
  begin
    ToLog(format('SetFilter setting filter for Pid %d failed.', [Pid]), $02);
  end;
end;


{------------------------------------------------------------------------------
  Params  : <Pid>           Pid number
            <LpFunc>        Pointer to callback
            <CallBackType>  Type of callback. NOT USED. Special type is used.
            <Size>          Size of data to be returned in callback
                            Size of a packet is defined in INI file
                            1: Single packet
                            2: 4096 byte blocks
                               Note that only complete packets are returned,
                               thus for a 188 packet size data is passed on
                               when 21 packets are received
  Returns : <Result>        True if filter set
                            False if any error
            <LpFilter_Num>  Filter identifier

  Descript: Creates a filter for the indicated Pid (special type).
  Notes   :
 ------------------------------------------------------------------------------}
function SetFilterEx(Pid: Word; LpFunc: Pointer; CallBackType: Dword; Size: Dword;
                     LpFilter_Num: PDword): Boolean; cdecl;
begin
  ToLog('SetFilterEx -> we call SetFilter internally.', $04);
  Result := SetFilter(Pid, LpFunc, Ord(cbFastEx), Size, LpFilter_Num);
end;


{------------------------------------------------------------------------------
  Params  : <IR_Type>       $01 = RC5
            <DevAddr>       Device address to respond to
                            $FFFF if all devices to pass through
            <LpFunc>        Callback
  Returns : <Result>        True if remote control callback installed
                            False if any error
            <LpFilter_Num>  Filter identifier (always 0)

  Descript: Creates a filter for the remote control.
  Notes   : Not implemented
 ------------------------------------------------------------------------------}
function SetRemoteControl(IR_Type: Dword; DevAddr: Word; LpFunc: Pointer;
                          LpFilter_num: PDword): Boolean; cdecl;
begin
  ToLog('SetRemoteControl.', $04);
  Result := True;
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  True if success
                      False if any error

  Descript: Initialize the driver and setup reception.
  Notes   :
 ------------------------------------------------------------------------------}
function StartDVB: Boolean; cdecl;
var
  Loop      : Integer;
  InData    : OleVariant;
  OutData   : OleVariant;
  CardNumber: Integer;
  CardName  : AnsiString;
  BufferId  : Integer;
  Buffers   : Integer;
begin
  ToLog('StartDVB.', $04);
  Result := False;

  if not Assigned(Script) then
  begin
    ToLog('StartDVB error: Script not active.', $02);
    Exit;
  end;
  if Assigned(PacketThread) then
  begin
    ToLog('StartDVB error: Buffering not active.', $02);
    Exit;
  end;

  // Call script function
  VarClear(InData);
  VarClear(OutData);
  try
    OutData    := VarArrayCreate([0, 4], varVariant);
    OutData[0] := varAsType(0, varInteger);
    OutData[1] := varAsType(0, varOleStr);
    OutData[2] := varAsType(0, varInteger);
    OutData[3] := varAsType(0, varInteger);
    OutData[4] := varAsType(0, varInteger);
    if not Script.ScriptExecute('StartDvb', InData, OutData) then
    begin
      ToLog(format('Script function "StartDvb" failed [%s --> %s].', [ScriptLocation, Script.FMessage]), $02);
      Exit;
    end;
    Result     := (OutData[0] = -1);
    CardName   := OutData[1];
    CardNumber := OutData[2];
    Buffers    := OutData[3];
    BufferId   := OutData[4];
  finally
    VarClear(InData);
    VarClear(OutData);
  end;

  if Result then
  begin
    for Loop := Low(Filters.Filters) to High(Filters.Filters) do
    begin
      Filters.Filters[Loop].Active := False;
      Filters.Filters[Loop].CountDetected := 0;
      Filters.Filters[Loop].CountCheckedOut := 0;
      Filters.Filters[Loop].CountCalled := 0;
    end;

    ToLog(format('StartDVB: %d buffers used for buffering mechanism.', [Buffers]), $02);

    // Start the thread which handles the data reception
    if Pos('saa7146', LowerCase(CardName)) <> 0 then
      PacketThread := TDataThreadSaa7146a.Create(True)
    else
      if Pos('flexcop', Lowercase(CardName)) <> 0 then
        PacketThread := TDataThreadFlexCop.Create(True)
    else
      PacketThread := nil;
    if Assigned(PacketThread) then
    begin
      PacketThread.FDecodeCallback := @ProcessTransportStreamData;
      PacketThread.FCardNumber     := CardNumber;
      PacketThread.FBuffers        := Buffers;
      PacketThread.FBufferId       := BufferId;
      PacketThread.FHasStopped     := False;
      PacketThread.Resume;
    end;
  end
  else
    ToLog('StartDVB error: Could not setup buffering mechanism.', $02);
end;


{------------------------------------------------------------------------------
  Params  : -
  Returns : <Result>  True if success
                      False if any error

  Descript: De-initialize driver and reception.
  Notes   :
 ------------------------------------------------------------------------------}
function StopDVB: Boolean; cdecl;
var
  Loop   : Integer;
  Counts1: Integer;
  Counts2: Integer;
  Counts3: Integer;
  InData : OleVariant;
  OutData: OleVariant;
begin
  ToLog('StopDVB.', $04);
  Result := False;

  if not Assigned(Script) then
  begin
    ToLog('StopDVB error: Script not active.', $02);
    Exit;
  end;
  if not Assigned(PacketThread) then
  begin
    ToLog('StopDVB error: Buffering not active.', $02);
    Exit;
  end;
  
  Counts1 := 0;
  Counts2 := 0;
  Counts3 := 0;
  for Loop := Low(Filters.Filters) to High(Filters.Filters) do
  begin
    Counts1 := Counts1 + Filters.Filters[Loop].CountDetected;
    Counts2 := Counts2 + Filters.Filters[Loop].CountCheckedOut;
    Counts3 := Counts3 + Filters.Filters[Loop].CountCalled;
    DvbStopFilter(@Filters, Loop);
  end;
  ToLog(format('StopDVB total filter counts at %d of which %d had a correct mask, resulting in %d callbacks.', [Counts1, Counts2, Counts3]), $04);


  if (not PacketThread.FHasStopped) then
  begin
    // Note: The behaviour of the thread (during finalization) is different
    //       if called from the DLL finalizepart. It seems the thread is
    //       then already 'stalled'. Waiting with 'sleeps' is also slow
    //       because the finalize here seems to get very low priority.
    //       Therefore no waiting in a loop or simular.
    PacketThread.FProgrammedStop := True;
    PacketThread.Terminate;                                // Mark it for termination
    if PacketThread.Suspended then
      PacketThread.Resume;
    PacketThread.WaitFor;
    PacketThread.Free;
  end;
  PacketThread := nil;

  // Call script function
  VarClear(InData);
  VarClear(OutData);
  try
    OutData    := VarArrayCreate([0, 0], varVariant);
    OutData[0] := varAsType(0, varInteger);
    if not Script.ScriptExecute('StopDvb', InData, OutData) then
    begin
      ToLog(format('Script function "StopDvb" failed [%s --> %s].', [ScriptLocation, Script.FMessage]), $02);
      Exit;
    end;
    Result := (OutData[0] = -1);
    if not Result then
      ToLog('StopDvb could not de-initialize.', $02);
  finally
    VarClear(InData);
    VarClear(OutData);
  end;
end;


{******************************************************************************}
{                               API FUNCTIONS END                              }
{******************************************************************************}


{******************************************************************************}
{                              INITIALIZE AND FINALIZE                         }
{******************************************************************************}
{------------------------------------------------------------------------------
  Params  : -
  Returns : -

  Descript: Initialization of unit
  Notes   :
 ------------------------------------------------------------------------------}
procedure Initialize;
var
  Parameter    : string;
  Error        : Integer;
  LogClear     : Boolean;
begin
  // Set initial values
  IniFile      := nil;
  PacketThread := nil;
  FilterLock   := TCriticalSection.Create;
  PassAll      := False;
  LogStream    := nil;
  LogLevel     := 0;
  LogClear     := True;

  if FileExists('StreamReader.ini') then
  begin
    IniFile := TMemIniFile.Create('StreamReader.ini');
    // Only with a local INI file we allow logging
    Parameter := GetParameter('Interface', 'LogLevel', '0');
    Val(Parameter, LogLevel, Error);
    if Error <> 0 then
      LogLevel := 0;
    Parameter := GetParameter('Interface', 'LogClear', 'Yes');
    if LowerCase(Parameter) = 'no' then
      LogClear := False
    else
      LogClear := True;
  end;
  if LogLevel in [1..5] then
  begin
    try
      if (not LogClear) and
         FileExists('StreamReader.log') then
      begin
        LogStream := TFileStream.Create('StreamReader.log', fmOpenReadWrite);
        // Go to end of file (we will be appending)
        LogStream.Seek(0, soFromEnd);
      end
      else
        LogStream := TFileStream.Create('StreamReader.log', fmCreate);
      ToLog('-------------------------------------------------------------', $00);
      ToLog(format('Log level: %d', [LogLevel]), $00);
    except
      FreeAndNil(LogStream);
    end;
  end;

  // Get forcing single packets option
  Parameter := LowerCase(GetParameter('Interface', 'OnlySinglePackets', 'No'));
  if Parameter = 'yes' then
    ForceSinglePacket := True
  else
    ForceSinglePacket := False;

  // Get packet size
  Parameter := LowerCase(GetParameter('Interface', 'PacketSize', '184'));
  Val(Parameter, PacketSize, Error);
  if Error <> 0 then
    PacketSize := 184;
  if PacketSize = 0 then
    PacketSize := 188;
  if PacketSize > 188 then
    PacketSize := 188;

  // PassAllPid
  Parameter := LowerCase(GetParameter('Interface', 'PassAllPid', '8192'));
  Val(Parameter, PassAllPid, Error);
  if Error <> 0 then
    PassAllPid := 8192;

  // ScriptLocation
  ScriptLocation := LowerCase(GetParameter('Interface', 'ScriptLocation', 'Scripts'));

  Script := TPicoScript.Create;
  if ScriptLocation <> '' then
    ScriptLocation := ScriptLocation + '\StreamReader.pico'
  else
    ScriptLocation := 'StreamReader.pico';
  try
    Script.ScriptLoad(ScriptLocation);
  except
    FreeAndNil(Script);
  end;
  if not Assigned(Script) then
    ToLog(format('Error loading script "%s".', [ScriptLocation]), $02)
  else
    ToLog(format('Script "%s" loaded.', [ScriptLocation]), $02)
end;


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

  Descript: Finalization of unit
  Notes   :
 ------------------------------------------------------------------------------}
procedure Finalize;
begin
  if Assigned(PacketThread) then
  begin
    ToLog('Calling StopDVB internally.', $04);
    StopDvb;
  end;
  ToLog('StreamReader Finalizing.', $03);
  if Assigned(Script) then
    Script.Free;
  if Assigned(LogStream) then
    FreeAndNil(LogStream);
  if Assigned(IniFile) then
    FreeAndNil(IniFile);
  FilterLock.Free;
end;


initialization
  Initialize;

  finalization
    Finalize;
end.

