unit PrecompUtils;

interface

uses
  InitCode,
  Utils, Threading, XXHASHLIB, ZSTDLib,
  WinAPI.Windows,
  System.SysUtils, System.Classes, System.StrUtils, System.Types, System.Math,
  System.Generics.Defaults, System.Generics.Collections;

resourcestring
  SPrecompError1 = 'Method ''%s'' not found';
  SPrecompError2 = 'Failed to initialise ''%s''';
  SPrecompError3 = 'Error in the method ''%s''';
  SPrecompSep1 = '+';
  SPrecompSep2 = ':';
  SPrecompSep3 = ',';
  SPrecompSep4 = '/';
  SPrecompSep5 = '\';

const
  SuccessStatus = 4;

  DEFAULT_STREAM = 0;
  EXTENDED_STREAM = 1;
  NESTED_STREAM = 2;
  DUPLICATED_STREAM = 4;

  PRECOMP_FCOUNT = 128;

type
  PPrecompStr = ^TPrecompStr;

  TPrecompStr = array [0 .. 255] of Char;

  TStreamStatus = (None, Invalid, Predicted, Database);

  PDepthStream = ^TDepthStream;

  TDepthStream = record
    Position: Int64;
    OldSize, NewSize: Integer;
    Resource: Integer;
    Codec: Byte;
    Option: Integer;
  end;

  PEncodeSI = ^TEncodeSI;

  TEncodeSI = record
    ActualPosition: NativeInt;
    StorePosition: NativeInt;
    OldSize, NewSize, Thread: Integer;
    ExtPosition: NativeInt;
    ExtSize, ExtThread: Integer;
    Resource: Integer;
    Codec: Byte;
    Scan2: Boolean;
    Option: Integer;
    Checksum: XXH128_hash_t;
    Status: TStreamStatus;
    DepthStreams: TArray<TDepthStream>;
  end;

  PFutureSI = ^TFutureSI;

  TFutureSI = record
    Position: Int64;
    OldSize, NewSize: Integer;
    Resource: Integer;
    Codec: Byte;
    Scan2: Boolean;
    Option: Integer;
    Status: TStreamStatus;
    DepthStreams: TArray<TDepthStream>;
  end;

  PStreamHeader = ^TStreamHeader;

  TStreamHeader = packed record
    Kind: Byte;
    OldSize, NewSize: Integer;
    Resource: Integer;
    Codec: Byte;
    Option: Integer;
  end;

  PStrInfo1 = ^_StrInfo1;

  _StrInfo1 = packed record
    Position: Int64;
    OldSize, NewSize: Integer;
    Resource: Integer;
    Status: TStreamStatus;
    Option: Integer;
  end;

  PStrInfo2 = ^_StrInfo2;

  _StrInfo2 = packed record
    OldSize, NewSize: Integer;
    Resource: Integer;
    Status: TStreamStatus;
    Option: Integer;
  end;

  PStrInfo3 = ^_StrInfo3;

  _StrInfo3 = packed record
    OldSize, NewSize, ExtSize: Integer;
    Resource: Integer;
    Option: Integer;
  end;

  PExecOutput = ^_ExecOutput;

  _ExecOutput = reference to procedure(Instance: Integer; const Buffer: Pointer;
    Size: Integer)cdecl;

  PPrecompFuncs = ^_PrecompFuncs;

  _PrecompFuncs = record
    Allocator: function(Index: Integer; Size: Integer): Pointer cdecl;
    GetCodec: function(Cmd: PChar; Index: Integer; Param: Boolean)
      : TPrecompStr cdecl;
    GetParam: function(Cmd: PChar; Index: Integer; Param: PChar)
      : TPrecompStr cdecl;
    AddDepthStream: procedure(Instance: Integer; Position: Int64;
      OldSize, NewSize: Integer; Codec: PChar; Option, Resource: Integer)cdecl;
    Compress: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
      OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer)
      : Integer cdecl; // 5
    Decompress: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
      OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer)
      : Integer cdecl;
    Encrypt: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
      KeyBuff: Pointer; KeySize: Integer): Boolean cdecl;
    Decrypt: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
      KeyBuff: Pointer; KeySize: Integer): Boolean cdecl;
    Hash: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
      HashBuff: Pointer; HashSize: Integer): Boolean cdecl;
    EncodePatch: function(OldBuff: Pointer; OldSize: Integer; NewBuff: Pointer;
      NewSize: Integer; PatchBuff: Pointer; PatchSize: Integer): Integer cdecl;
    // 10
    DecodePatch: function(PatchBuff: Pointer; PatchSize: Integer;
      OldBuff: Pointer; OldSize: Integer; NewBuff: Pointer; NewSize: Integer)
      : Integer cdecl;
    AddResource: function(FileName: PChar): Integer cdecl;
    GetResource: function(ID: Integer; Data: Pointer; Size: PInteger)
      : Boolean cdecl;
    SearchBinary: function(SrcMem: Pointer; SrcPos, SrcSize: NativeInt;
      SearchMem: Pointer; SearchSize: NativeInt; ResultPos: PNativeInt)
      : Boolean cdecl;
    SwapBinary: procedure(Source, Dest: Pointer; Size: NativeInt)cdecl; // 15
    Swap16: function(Value: ShortInt): ShortInt cdecl;
    Swap32: function(Value: Integer): Integer cdecl;
    Swap64: function(Value: Int64): Int64 cdecl;
    FileOpen: function(FileName: PChar; Create: Boolean): THandle cdecl;
    FileClose: procedure(Handle: THandle)cdecl; // 20
    FileSeek: function(Handle: THandle; Offset: Int64; Origin: Integer)
      : Int64 cdecl;
    FileSize: function(Handle: THandle): Int64 cdecl;
    FileRead: function(Handle: THandle; Buffer: Pointer; Count: Integer)
      : Integer cdecl;
    FileWrite: function(Handle: THandle; Buffer: Pointer; Count: Integer)
      : Integer cdecl;
    IniRead: function(Section, Key, Default, FileName: PChar)
      : TPrecompStr cdecl;
    // 25
    IniWrite: procedure(Section, Key, Value, FileName: PChar)cdecl;
    Exec: function(Executable, CommandLine, WorkDir: PChar): Boolean cdecl;
    ExecStdin: function(Executable, CommandLine, WorkDir: PChar;
      InBuff: Pointer; InSize: Integer): Boolean cdecl;
    ExecStdout: function(Instance: Integer;
      Executable, CommandLine, WorkDir: PChar; Output: _ExecOutput)
      : Boolean cdecl;
    ExecStdio: function(Instance: Integer;
      Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
      Output: _ExecOutput): Boolean cdecl; // 30
    ExecStdioSync: function(Instance: Integer;
      Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
      Output: _ExecOutput): Boolean cdecl;
    GetDepthCodec: function(Cmd: PChar): TPrecompStr cdecl;
    ReadFuture: function(Index: Integer; Position: NativeInt; Buffer: Pointer;
      Count: Integer): Integer cdecl;
    LogScan1: procedure(Codec: PChar; Position: Int64;
      InSize, OutSize: Integer)cdecl;
    LogScan2: procedure(Codec: PChar; InSize, OutSize: Integer)cdecl; // 35
    LogProcess: procedure(Codec, Method: PChar; Size1, Size2, Size3: Integer;
      Status: Boolean)cdecl;
    LogRestore: procedure(Codec, Method: PChar; Size1, Size2, Size3: Integer;
      Status: Boolean)cdecl;
    LogPatch1: procedure(OldSize, NewSize, PatchSize: Integer;
      Status: Boolean)cdecl;
    LogPatch2: procedure(OldSize, NewSize, PatchSize: Integer;
      Status: Boolean)cdecl;
    AcceptPatch: function(OldSize, NewSize, PatchSize: Integer): Boolean cdecl;
    // 40
    Transfer: procedure(Instance: Integer; Codec: PChar)cdecl;
    Storage: function(Instance: Integer; Size: PInteger): Pointer cdecl;
    AddResourceEx: function(Data: Pointer; Size: Integer): Integer cdecl;
    Reserved: array [0 .. (PRECOMP_FCOUNT - 1) - 43] of Pointer;
  end;

  _PrecompOutput = procedure(Instance: Integer; const Buffer: Pointer;
    Size: Integer)cdecl;
  _PrecompAdd = procedure(Instance: Integer; Info: PStrInfo1; Codec: PChar;
    Reserved: Pointer)cdecl;

  _PrecompInit = function(Command: PChar; Count: Integer;
    Funcs: PPrecompFuncs): Boolean;
  _PrecompFree = procedure(Funcs: PPrecompFuncs);
  _PrecompParse = function(Command: PChar; Option: PInteger;
    Funcs: PPrecompFuncs): Boolean;
  _PrecompScan1 = procedure(Instance, Depth: Integer; Input: Pointer;
    Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd;
    Funcs: PPrecompFuncs);
  _PrecompScan2 = function(Instance, Depth: Integer; Input: Pointer;
    Size: NativeInt; StreamInfo: PStrInfo2; Offset: PInteger;
    Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
  _PrecompProcess = function(Instance, Depth: Integer;
    OldInput, NewInput: Pointer; StreamInfo: PStrInfo2; Output: _PrecompOutput;
    Funcs: PPrecompFuncs): Boolean;
  _PrecompRestore = function(Instance, Depth: Integer; Input, InputExt: Pointer;
    StreamInfo: _StrInfo3; Output: _PrecompOutput;
    Funcs: PPrecompFuncs): Boolean;

  TPrecompressor = record
    Names: TArray<String>;
    Initialised: Boolean;
    Init: _PrecompInit;
    Free: _PrecompFree;
    Parse: _PrecompParse;
    Scan1: _PrecompScan1;
    Scan2: _PrecompScan2;
    Process: _PrecompProcess;
    Restore: _PrecompRestore;
  end;

  TEncodeSIComparer = class(TComparer<TEncodeSI>)
  public
    function Compare(const Left, Right: TEncodeSI): Integer; override;
  end;

  TFutureSIComparer = class(TComparer<TFutureSI>)
  public
    function Compare(const Left, Right: TFutureSI): Integer; override;
  end;

  PDatabase = ^TDatabase;

  TDatabase = packed record
    Size: Integer;
    Codec: Byte;
    Option: Integer;
    Checksum: XXH128_hash_t;
    Status: TStreamStatus;
  end;

  PDuplicate1 = ^TDuplicate1;

  TDuplicate1 = packed record
    Size: Integer;
    Checksum: XXH128_hash_t;
    Index1, Index2: Integer;
    Count: Integer;
  end;

  PDuplicate2 = ^TDuplicate2;

  TDuplicate2 = packed record
    Index: Integer;
    Count: Integer;
  end;

  PDuplicate3 = ^TDuplicate3;

  TDuplicate3 = packed record
    Size: Integer;
    Index: Integer;
    Count: Integer;
  end;

  TPrecompVMStream = class(TStream)
  private const
    FSuffix = '-vm.tmp';
  protected
    procedure SetSize(const NewSize: Int64); override;
    procedure SetSize(NewSize: Longint); override;
  private
    FInitialised, FDone: Boolean;
    FStream: TStream;
    FFilename: String;
    procedure Initialise;
  public
    constructor Create;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    procedure Done;
    property FileName: String read FFilename;
  end;

  PResData = ^TResData;

  TResData = record
    Name: String;
    Data: Pointer;
    Size: Integer;
  end;

procedure _Init(Count: Integer);
procedure _Free;

procedure AddMethod(Method: String);
procedure ClearMethods;

function RegisterResources(Cmd: String): Integer;
procedure FreeResources;

function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean)
  : TPrecompStr cdecl;
function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar)
  : TPrecompStr cdecl;
function PrecompGetDepthCodec(Cmd: PChar): TPrecompStr cdecl;
function PrecompCompress(Codec: PChar; InBuff: Pointer; InSize: Integer;
  OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer)
  : Integer cdecl;
function PrecompDecompress(Codec: PChar; InBuff: Pointer; InSize: Integer;
  OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer)
  : Integer cdecl;
function PrecompEncrypt(Codec: PChar; InBuff: Pointer; InSize: Integer;
  KeyBuff: Pointer; KeySize: Integer): Boolean cdecl;
function PrecompDecrypt(Codec: PChar; InBuff: Pointer; InSize: Integer;
  KeyBuff: Pointer; KeySize: Integer): Boolean cdecl;
function PrecompHash(Codec: PChar; InBuff: Pointer; InSize: Integer;
  HashBuff: Pointer; HashSize: Integer): Boolean cdecl;
function PrecompEncodePatch(OldBuff: Pointer; OldSize: Integer;
  NewBuff: Pointer; NewSize: Integer; PatchBuff: Pointer; PatchSize: Integer)
  : Integer cdecl;
function PrecompEncodePatchEx(Instance: Integer; OldBuff: Pointer;
  OldSize: Integer; NewBuff: Pointer; NewSize: Integer; Output: _PrecompOutput)
  : Integer cdecl;
function PrecompDecodePatch(PatchBuff: Pointer; PatchSize: Integer;
  OldBuff: Pointer; OldSize: Integer; NewBuff: Pointer; NewSize: Integer)
  : Integer cdecl;
function PrecompDecodePatchEx(Instance: Integer; PatchBuff: Pointer;
  PatchSize: Integer; OldBuff: Pointer; OldSize: Integer;
  Output: _PrecompOutput): Integer cdecl;
function PrecompAddResource(FileName: PChar): Integer cdecl;
function PrecompGetResource(Index: Integer; Data: Pointer; Size: PInteger)
  : Boolean cdecl;
function PrecompSearchBinary(SrcMem: Pointer; SrcPos, SrcSize: NativeInt;
  SearchMem: Pointer; SearchSize: NativeInt; ResultPos: PNativeInt)
  : Boolean cdecl;
procedure PrecompSwapBinary(Source, Dest: Pointer; Size: NativeInt)cdecl;
function PrecompSwap16(Int: Int16): Int16 cdecl;
function PrecompSwap32(Int: Int32): Int32 cdecl;
function PrecompSwap64(Int: Int64): Int64 cdecl;
function PrecompFileOpen(FileName: PChar; Create: Boolean): THandle cdecl;
procedure PrecompFileClose(Handle: THandle)cdecl;
function PrecompFileSeek(Handle: THandle; Offset: Int64; Origin: Integer)
  : Int64 cdecl;
function PrecompFileSize(Handle: THandle): Int64 cdecl;
function PrecompFileRead(Handle: THandle; Buffer: Pointer; Count: Integer)
  : Integer cdecl;
function PrecompFileWrite(Handle: THandle; Buffer: Pointer; Count: Integer)
  : Integer cdecl;
function PrecompIniRead(Section, Key, Default, FileName: PChar)
  : TPrecompStr cdecl;
procedure PrecompIniWrite(Section, Key, Value, FileName: PChar)cdecl;
function PrecompExec(Executable, CommandLine, WorkDir: PChar): Boolean cdecl;
function PrecompExecStdin(Executable, CommandLine, WorkDir: PChar;
  InBuff: Pointer; InSize: Integer): Boolean cdecl;
function PrecompExecStdout(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; Output: _ExecOutput): Boolean cdecl;
function PrecompExecStdio(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
  Output: _ExecOutput): Boolean cdecl;
function PrecompExecStdioSync(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
  Output: _ExecOutput): Boolean cdecl;
function PrecompAcceptPatch(OldSize, NewSize, PatchSize: Integer)
  : Boolean cdecl;

var
  Codec: TPrecompressor;
  PrecompFunctions: _PrecompFuncs;
  DIFF_TOLERANCE: Single = 0.05;
  DIFF_CLEVEL: Integer = 1;
  OPTIMISE_DEC: Boolean = False;
  FULLSCAN: Boolean = False;
  REPROCESSED: Boolean = False;
  FORCEDMETHOD: Boolean = False;
  EncodeSICmp: TEncodeSIComparer;
  FutureSICmp: TFutureSIComparer;
  StockMethods, ExternalMethods: TStringList;
  Resources: array of TResData;

implementation

uses
  ZLibDLL, LZ4DLL, LZODLL, ZSTDDLL, OodleDLL,
  SynCommons, SynCrypto;

const
  DummyCodecs: array of PChar = ['none'];
  CODEC_COUNT = 1;
  NONE_CODEC = 0;

type
  TPrecompVar = record
    ZSTDCtx1: ZSTD_CCtx;
    ZSTDCtx2: ZSTD_DCtx;
  end;

var
  _PrecompVar: TArray<TPrecompVar>;

procedure _Init(Count: Integer);
var
  I: Integer;
begin
  SetLength(_PrecompVar, Count);
  for I := Low(_PrecompVar) to High(_PrecompVar) do
  begin
    _PrecompVar[I].ZSTDCtx1 := ZSTDLib.ZSTD_createCCtx;
    _PrecompVar[I].ZSTDCtx2 := ZSTDLib.ZSTD_createDCtx;
  end;
end;

procedure _Free;
var
  I: Integer;
begin
  for I := Low(_PrecompVar) to High(_PrecompVar) do
  begin
    ZSTDLib.ZSTD_freeCCtx(_PrecompVar[I].ZSTDCtx1);
    ZSTDLib.ZSTD_freeDCtx(_PrecompVar[I].ZSTDCtx2);
  end;
end;

function TEncodeSIComparer.Compare(const Left, Right: TEncodeSI): Integer;
begin
  Result := Integer(CompareValue(Left.ActualPosition, Right.ActualPosition));
end;

function TFutureSIComparer.Compare(const Left, Right: TFutureSI): Integer;
begin
  Result := Integer(CompareValue(Left.Position, Right.Position));
end;

procedure AddMethod(Method: String);
begin
  if (StockMethods.IndexOf(Method) < 0) and (ExternalMethods.IndexOf(Method) < 0)
  then
    ExternalMethods.Add(Method);
end;

procedure ClearMethods;
begin
  ExternalMethods.Clear;
end;

function ResourceExists(FileName: String): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := Low(Resources) to High(Resources) do
  begin
    Result := SameText(Resources[I].Name, ExtractFileName(FileName));
    if Result then
      break;
  end;
end;

function RegisterResources(Cmd: String): Integer;
var
  List0, List1, List2: System.Types.TStringDynArray;
  I, J: Integer;
begin
  Result := -1;
  if Cmd <> '' then
  begin
    List0 := DecodeStr(Cmd, SPrecompSep4);
    List1 := DecodeStr(List0[0], SPrecompSep1);
    for I := Low(List1) to High(List1) do
    begin
      List2 := DecodeStr(List1[I], SPrecompSep2);
      for J := Succ(Low(List2)) to High(List2) do
      begin
        if FileExists(ExpandPath(PluginsPath + List2[J], True)) then
        begin
          Result := PrecompAddResource(PChar(List2[J]));
          break;
        end;
      end;
    end;
  end;
end;

procedure FreeResources;
var
  I: Integer;
begin
  for I := Low(Resources) to High(Resources) do
    FreeMem(Resources[I].Data);
  SetLength(Resources, 0);
end;

constructor TPrecompVMStream.Create;
begin
  inherited Create;
  FInitialised := False;
  FDone := False;
end;

destructor TPrecompVMStream.Destroy;
begin
  if FInitialised then
  begin
    if not FDone then
      FStream.Free;
    DeleteFile(FFilename);
  end;
  inherited Destroy;
end;

procedure TPrecompVMStream.Initialise;
begin
  if FInitialised then
    exit;
  FFilename := LowerCase(ChangeFileExt(ExtractFileName(Utils.GetModuleName),
    FSuffix));
  if FileExists(FFilename) then
    DeleteFile(FFilename);
  FStream := TFileStreamEx.Create(FFilename, $4000000);
  FInitialised := True;
end;

procedure TPrecompVMStream.SetSize(const NewSize: Int64);
begin
  if not FInitialised then
    if NewSize > 0 then
      Initialise
    else
      exit;
  FStream.Size := NewSize;
end;

procedure TPrecompVMStream.SetSize(NewSize: Longint);
begin
  SetSize(Int64(NewSize));
end;

function TPrecompVMStream.Read(var Buffer; Count: Longint): Longint;
begin
  if FInitialised then
    Result := FStream.Read(Buffer, Count)
  else
    Result := 0;
end;

function TPrecompVMStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := 0;
  if not FInitialised then
    if Count > 0 then
      Initialise
    else
      exit;
  Result := FStream.Write(Buffer, Count);
end;

function TPrecompVMStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  if FInitialised then
    Result := FStream.Seek(Offset, Origin)
  else
    Result := 0;
end;

procedure TPrecompVMStream.Done;
begin
  FStream.Free;
  FDone := True;
end;

function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean)
  : TPrecompStr;
var
  List0, List1, List2: System.Types.TStringDynArray;
  I: Integer;
  S: String;
begin
  Result := '';
  S := '';
  if Cmd <> nil then
  begin
    List0 := DecodeStr(Cmd, SPrecompSep4);
    List1 := DecodeStr(List0[0], SPrecompSep1);
    if InRange(Index, Low(List1), High(List1)) then
      if WithParams then
      begin
        List2 := DecodeStr(List1[Index], SPrecompSep2);
        S := List2[0] + SPrecompSep2;
        for I := Succ(Low(List2)) to High(List2) do
          if not ResourceExists(List2[I]) then
            S := S + List2[I] + SPrecompSep2;
        if Length(S) > 0 then
          S := S.Remove(Pred(Length(S)));
      end
      else
        S := DecodeStr(List1[Index], SPrecompSep2, 1)[0];
  end;
  StringToWideChar(S, @Result, Length(Result));
end;

function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar): TPrecompStr;
var
  List0, List1, List2: System.Types.TStringDynArray;
  I: Integer;
  S: String;
begin
  Result := '';
  if Cmd <> '' then
  begin
    List0 := DecodeStr(Cmd, SPrecompSep4);
    List1 := DecodeStr(List0[0], SPrecompSep1);
    if InRange(Index, Low(List1), High(List1)) then
    begin
      List2 := DecodeStr(List1[Index], SPrecompSep2);
      if Param = '' then
      begin
        S := '';
        for I := Succ(Low(List2)) to High(List2) do
          if ResourceExists(List2[I]) = False then
          begin
            if S <> '' then
              S := S + SPrecompSep2;
            S := S + List2[I];
          end;
        if S = '' then
          S := ' ';
      end
      else
      begin
        for I := Succ(Low(List2)) to High(List2) do
          if List2[I].StartsWith(Param, True) and
            (ResourceExists(List2[I]) = False) then
          begin
            S := List2[I].Substring(Length(Param));
            if S = '' then
              S := ' ';
          end;
      end;
    end;
  end;
  StringToWideChar(S, @Result, Length(Result));
end;

function PrecompGetDepthCodec(Cmd: PChar): TPrecompStr cdecl;
var
  List: System.Types.TStringDynArray;
  I: Integer;
  S: String;
begin
  Result := '';
  S := '';
  if Cmd <> nil then
  begin
    List := DecodeStr(Cmd, SPrecompSep4);
    for I := Succ(Low(List)) to High(List) do
      S := S + List[I] + SPrecompSep4;
    if Length(S) > 0 then
      S := S.Remove(Pred(Length(S)));
  end;
  StringToWideChar(S, @Result, Length(Result));
end;

function PrecompCompress(Codec: PChar; InBuff: Pointer; InSize: Integer;
  OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer;
  DictSize: Integer): Integer;
var
  ZStream: z_stream;
  LZ4FT: LZ4F_preferences_t;
  I, X: Integer;
  S: String;
  dst: NativeUInt;
  WrkMem: array [0 .. $7FFFF] of Byte;
begin
  Result := 0;
  X := IndexText(PrecompGetCodec(Codec, 0, False),
    ['zlib', 'lz4', 'lz4hc', 'lz4f', 'lzo1c', 'lzo1x', 'lzo2a', 'zstd', 'lzna',
    'kraken', 'mermaid', 'selkie', 'hydra', 'leviathan']);
  case X of
    0:
      if ZLibDLL.DLLLoaded then
      begin
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '68';
        I := EnsureRange(StrToInt(S), 1, 99);
        I := IfThen(I < 10, I * 10, I);
        I := IfThen(I mod 10 = 0, I + 8, I);
        S := PrecompGetParam(Codec, 0, 'w');
        if S = '' then
          S := '15';
        FillChar(ZStream, SizeOf(z_stream), 0);
        ZStream.next_in := InBuff;
        ZStream.avail_in := InSize;
        ZStream.next_out := OutBuff;
        ZStream.avail_out := OutSize;
        deflateInit2(ZStream, I div 10, Z_DEFLATED, -StrToInt(S), I mod 10,
          Z_DEFAULT_STRATEGY);
        try
          if deflate(ZStream, Z_FINISH) = Z_STREAM_END then
            Result := ZStream.total_out;
        finally
          deflateEnd(ZStream);
        end;
      end;
    1:
      if LZ4DLL.DLLLoaded then
        Result := LZ4_compress_default(InBuff, OutBuff, InSize, OutSize);
    2:
      if LZ4DLL.DLLLoaded then
      begin
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '9';
        Result := LZ4_compress_HC(InBuff, OutBuff, InSize, OutSize,
          StrToInt(S));
      end;
    3:
      if LZ4DLL.DLLLoaded then
      begin
        FillChar(LZ4FT, SizeOf(LZ4F_preferences_t), 0);
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '9';
        LZ4FT.compressionLevel := S.ToInteger;
        S := PrecompGetParam(Codec, 0, 'b');
        if S = '' then
          S := '4';
        LZ4FT.frameInfo.blockSizeID := LZ4F_blockSizeID_t(S.ToInteger);
        S := PrecompGetParam(Codec, 0, 'd');
        if S = '' then
          S := '0';
        LZ4FT.frameInfo.blockMode := LZ4F_blockMode_t(S.ToInteger);
        Result := LZ4F_compressFrame(OutBuff, OutSize, InBuff, InSize, @LZ4FT);
      end;
    4:
      if LZODLL.DLLLoaded then
      begin
        dst := OutSize;
        if lzo1c_999_compress(InBuff, InSize, OutBuff, @dst, @WrkMem[0]) = 0
        then
          Result := dst;
      end;
    5:
      if LZODLL.DLLLoaded then
      begin
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '8';
        dst := OutSize;
        if lzo1x_999_compress_level(InBuff, InSize, OutBuff, @dst, @WrkMem[0],
          nil, 0, nil, StrToInt(S)) = 0 then
          Result := dst;
      end;
    6:
      if LZODLL.DLLLoaded then
      begin
        dst := OutSize;
        if lzo2a_999_compress(InBuff, InSize, OutBuff, @dst, @WrkMem[0]) = 0
        then
          Result := dst;
      end;
    7:
      if ZSTDDLL.DLLLoaded then
      begin
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '19';
        Result := ZSTD_compress(OutBuff, OutSize, InBuff, InSize, StrToInt(S));
      end;
    8 .. 13:
      if OodleDLL.DLLLoaded then
      begin
        case X of
          8:
            I := 7;
          9:
            I := 8;
          10:
            I := 9;
          11:
            I := 11;
          12:
            I := 12;
          13:
            I := 13;
        else
          I := 8;
        end;
        S := PrecompGetParam(Codec, 0, 'l');
        if S = '' then
          S := '4';
        Result := OodleLZ_Compress(I, InBuff, InSize, OutBuff, StrToInt(S));
      end;
  end;
end;

function PrecompDecompress(Codec: PChar; InBuff: Pointer; InSize: Integer;
  OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer;
  DictSize: Integer): Integer;
var
  ZStream: z_stream;
  S: String;
  dst: NativeUInt;
begin
  Result := 0;
  case IndexText(PrecompGetCodec(Codec, 0, False),
    ['zlib', 'lz4', 'lz4hc', 'lz4f', 'lzo1c', 'lzo1x', 'lzo2a', 'zstd', 'lzna',
    'kraken', 'mermaid', 'selkie', 'hydra', 'leviathan']) of
    0:
      if ZLibDLL.DLLLoaded then
      begin
        S := PrecompGetParam(Codec, 0, 'w');
        if S = '' then
          S := '15';
        FillChar(ZStream, SizeOf(z_stream), 0);
        inflateInit2(ZStream, -StrToInt(S));
        try
          ZStream.next_in := InBuff;
          ZStream.avail_in := InSize;
          ZStream.next_out := OutBuff;
          ZStream.avail_out := OutSize;
          if inflate(ZStream, Z_FINISH) = Z_STREAM_END then
            Result := ZStream.total_out;
        finally
          inflateEnd(ZStream);
        end;
      end;
    1, 2:
      if LZ4DLL.DLLLoaded then
        Result := LZ4_decompress_safe(InBuff, OutBuff, InSize, OutSize);
    3:
      if LZ4DLL.DLLLoaded then
        Result := LZ4F_decompress_safe(InBuff, OutBuff, InSize, OutSize);
    4:
      if LZODLL.DLLLoaded then
      begin
        dst := OutSize;
        if lzo1c_decompress_safe(InBuff, InSize, OutBuff, @dst) = 0 then
          Result := dst;
      end;
    5:
      if LZODLL.DLLLoaded then
      begin
        dst := OutSize;
        if lzo1x_decompress_safe(InBuff, InSize, OutBuff, @dst) = 0 then
          Result := dst;
      end;
    6:
      if LZODLL.DLLLoaded then
      begin
        dst := OutSize;
        if lzo2a_decompress_safe(InBuff, InSize, OutBuff, @dst) = 0 then
          Result := dst;
      end;
    7:
      if ZSTDDLL.DLLLoaded then
        Result := ZSTD_decompress(OutBuff, OutSize, InBuff, InSize);
    8 .. 13:
      if OodleDLL.DLLLoaded then
        Result := OodleLZ_Decompress(InBuff, InSize, OutBuff, OutSize);
  end;
end;

function PrecompEncrypt(Codec: PChar; InBuff: Pointer; InSize: Integer;
  KeyBuff: Pointer; KeySize: Integer): Boolean;
var
  AES: TAESAbstract;
  RC4: TRC4;
begin
  Result := False;
  case IndexText(Codec, ['xor', 'aes', 'rc4']) of
    0:
      begin
        XorBuffer(InBuff, InSize, KeyBuff, KeySize);
        Result := True;
      end;
    1:
      begin
        AES := TAESECB.Create(KeyBuff^, KeySize * 8);
        try
          AES.Encrypt(InBuff, InBuff, InSize);
          Result := True;
        finally
          AES.Free;
        end;
      end;
    2:
      begin
        RC4.Init(KeyBuff^, KeySize);
        RC4.Encrypt(InBuff^, InBuff^, InSize);
        Result := True;
      end;
  end;
end;

function PrecompDecrypt(Codec: PChar; InBuff: Pointer; InSize: Integer;
  KeyBuff: Pointer; KeySize: Integer): Boolean;
var
  AES: TAESAbstract;
  RC4: TRC4;
begin
  Result := False;
  case IndexText(Codec, ['xor', 'aes', 'rc4']) of
    0:
      begin
        XorBuffer(InBuff, InSize, KeyBuff, KeySize);
        Result := True;
      end;
    1:
      begin
        AES := TAESECB.Create(KeyBuff^, KeySize * 8);
        try
          AES.Decrypt(InBuff, InBuff, InSize);
          Result := True;
        finally
          AES.Free;
        end;
      end;
    2:
      begin
        RC4.Init(KeyBuff^, KeySize);
        RC4.Encrypt(InBuff^, InBuff^, InSize);
        Result := True;
      end;
  end;
end;

function PrecompHash(Codec: PChar; InBuff: Pointer; InSize: Integer;
  HashBuff: Pointer; HashSize: Integer): Boolean;
var
  LMD5: TMD5;
  LMD5Digest: TMD5Digest;
  LSHA1: TSHA1;
  LSHA1Digest: TSHA1Digest;
  xxSeed32: XXH32_hash_t;
  xxSeed64: XXH32_hash_t;
begin
  Result := False;
  case IndexText(Codec, ['crc32', 'adler32', 'crc64', 'md5', 'sha1', 'xxh32',
    'xxh64', 'xxh128', 'xxh3', 'xxh3_128']) of
    0:
      if HashSize = SizeOf(Cardinal) then
      begin
        PCardinal(HashBuff)^ := crc32c(PCardinal(HashBuff)^, InBuff, InSize);
        Result := True;
      end;
    1:
      if HashSize = SizeOf(Cardinal) then
      begin
        PCardinal(HashBuff)^ := Adler32Asm(PCardinal(HashBuff)^,
          InBuff, InSize);
        Result := True;
      end;
    2:
      if HashSize = SizeOf(Int64) then
      begin
        PInt64(HashBuff)^ := crc64c(InBuff, InSize);
        Result := True;
      end;
    3:
      if HashSize = SizeOf(TMD5Digest) then
      begin
        LMD5.Full(InBuff, InSize, LMD5Digest);
        Move(LMD5Digest, HashBuff^, HashSize);
        Result := True;
      end;
    4:
      if HashSize = SizeOf(TSHA1Digest) then
      begin
        LSHA1.Full(InBuff, InSize, LSHA1Digest);
        Move(LSHA1Digest, HashBuff^, HashSize);
        Result := True;
      end;
    5:
      if HashSize = SizeOf(XXH32_hash_t) then
      begin
        xxSeed32 := 0;
        PXXH32_hash_t(HashBuff)^ := XXH32(InBuff, InSize, xxSeed32);
        Result := True;
      end;
    6:
      if HashSize = SizeOf(XXH64_hash_t) then
      begin
        xxSeed64 := 0;
        PXXH64_hash_t(HashBuff)^ := XXH64(InBuff, InSize, xxSeed64);
        Result := True;
      end;
    7:
      if HashSize = SizeOf(XXH128_hash_t) then
      begin
        xxSeed64 := 0;
        PXXH128_hash_t(HashBuff)^ := XXH128(InBuff, InSize, xxSeed64);
        Result := True;
      end;
    8:
      if HashSize = SizeOf(XXH64_hash_t) then
      begin
        PXXH64_hash_t(HashBuff)^ := XXH3_64bits(InBuff, InSize);
        Result := True;
      end;
    9:
      if HashSize = SizeOf(XXH128_hash_t) then
      begin
        PXXH128_hash_t(HashBuff)^ := XXH3_128bits(InBuff, InSize);
        Result := True;
      end;
  end;
end;

function PrecompEncodePatch(OldBuff: Pointer; OldSize: Integer;
  NewBuff: Pointer; NewSize: Integer; PatchBuff: Pointer;
  PatchSize: Integer): Integer;
begin
  Result := EncodePatch(OldBuff, OldSize, NewBuff, NewSize, PatchBuff,
    PatchSize);
end;

function PrecompEncodePatchEx(Instance: Integer; OldBuff: Pointer;
  OldSize: Integer; NewBuff: Pointer; NewSize: Integer;
  Output: _PrecompOutput): Integer;

  function highbit64(V: UInt64): Cardinal;
  var
    Count: Cardinal;
  begin
    Count := 0;
    Assert(V <> 0);
    V := V shr 1;
    while V <> 0 do
    begin
      V := V shr 1;
      Inc(Count);
    end;
    Result := Count;
  end;

var
  Buffer: array [0 .. $40000 - 1] of Byte;
  BufferSize: Integer;
  Ctx: ZSTD_CCtx;
  Inp: ZSTDLib.ZSTD_inBuffer;
  Oup: ZSTDLib.ZSTD_outBuffer;
  Res: NativeInt;

  procedure DoWrite;
  begin
    Output(Instance, @Buffer[0], Oup.Pos);
    Inc(Result, Oup.Pos);
    Oup.dst := @Buffer[0];
    Oup.Size := BufferSize;
    Oup.Pos := 0;
  end;

begin
  Result := 0;
  BufferSize := Min(ZSTDLib.ZSTD_CStreamOutSize, Length(Buffer));
  Ctx := _PrecompVar[Instance].ZSTDCtx1;
  Oup.dst := @Buffer[0];
  Oup.Size := BufferSize;
  Oup.Pos := 0;
  Inp.src := OldBuff;
  Inp.Size := OldSize;
  Inp.Pos := 0;
  ZSTDLib.ZSTD_initCStream(Ctx, DIFF_CLEVEL);
  ZSTDLib.ZSTD_CCtx_setParameter(Ctx, ZSTDLib.ZSTD_cParameter.ZSTD_c_windowLog,
    highbit64(NewSize) + 1);
  ZSTDLib.ZSTD_CCtx_setParameter(Ctx,
    ZSTDLib.ZSTD_cParameter.ZSTD_c_enableLongDistanceMatching, 1);
  ZSTDLib.ZSTD_CCtx_refPrefix(Ctx, NewBuff, NewSize);
  while Inp.Pos < Inp.Size do
  begin
    Res := ZSTDLib.ZSTD_compressStream(Ctx, Oup, Inp);
    if Res < 0 then
      exit(0)
    else if Res > 0 then
      DoWrite
    else
      break;
  end;
  ZSTDLib.ZSTD_flushStream(Ctx, Oup);
  DoWrite;
  ZSTDLib.ZSTD_endStream(Ctx, Oup);
  DoWrite;
end;

function PrecompDecodePatch(PatchBuff: Pointer; PatchSize: Integer;
  OldBuff: Pointer; OldSize: Integer; NewBuff: Pointer;
  NewSize: Integer): Integer;
begin
  Result := DecodePatch(PatchBuff, PatchSize, OldBuff, OldSize,
    NewBuff, NewSize);
end;

function PrecompDecodePatchEx(Instance: Integer; PatchBuff: Pointer;
  PatchSize: Integer; OldBuff: Pointer; OldSize: Integer;
  Output: _PrecompOutput): Integer;

  function highbit64(V: UInt64): Cardinal;
  var
    Count: Cardinal;
  begin
    Count := 0;
    Assert(V <> 0);
    V := V shr 1;
    while V <> 0 do
    begin
      V := V shr 1;
      Inc(Count);
    end;
    Result := Count;
  end;

var
  Buffer: array [0 .. $40000 - 1] of Byte;
  BufferSize: Integer;
  Ctx: ZSTD_DCtx;
  Inp: ZSTDLib.ZSTD_inBuffer;
  Oup: ZSTDLib.ZSTD_outBuffer;
  Res: NativeInt;

  procedure DoWrite;
  begin
    Output(Instance, @Buffer[0], Oup.Pos);
    Inc(Result, Oup.Pos);
    Oup.dst := @Buffer[0];
    Oup.Size := BufferSize;
    Oup.Pos := 0;
  end;

begin
  Result := 0;
  BufferSize := Min(ZSTDLib.ZSTD_DStreamOutSize, Length(Buffer));
  Ctx := _PrecompVar[Instance].ZSTDCtx2;
  Oup.dst := @Buffer[0];
  Oup.Size := BufferSize;
  Oup.Pos := 0;
  Inp.src := PatchBuff;
  Inp.Size := PatchSize;
  Inp.Pos := 0;
  ZSTDLib.ZSTD_DCtx_setParameter(Ctx,
    ZSTDLib.ZSTD_dParameter.ZSTD_d_windowLogMax, highbit64(OldSize) + 1);
  ZSTDLib.ZSTD_DCtx_refPrefix(Ctx, OldBuff, OldSize);
  while Inp.Pos < Inp.Size do
  begin
    Res := ZSTDLib.ZSTD_decompressStream(Ctx, Oup, Inp);
    if Res < 0 then
      exit(0)
    else if Res >= 0 then
    begin
      DoWrite;
      if Res = 0 then
        break;
    end;
  end;
end;

function PrecompAddResource(FileName: PChar): Integer;
var
  I: Integer;
  Exists: Boolean;
begin
  Result := -1;
  Exists := False;
  for I := Low(Resources) to High(Resources) do
  begin
    Exists := SameText(Resources[I].Name, ExtractFileName(FileName));
    if Exists then
    begin
      Result := I;
      break;
    end;
  end;
  if not Exists then
  begin
    with TFileStream.Create(ExpandPath(PluginsPath + FileName, True),
      fmOpenRead or fmShareDenyNone) do
      try
        I := Length(Resources);
        SetLength(Resources, Succ(I));
        Resources[I].Name := ExtractFileName(FileName);
        Resources[I].Size := Size;
        GetMem(Resources[I].Data, Resources[I].Size);
        ReadBuffer(Resources[I].Data^, Resources[I].Size);
        Result := I;
      finally
        Free;
      end;
  end;
end;

function PrecompGetResource(Index: Integer; Data: Pointer;
  Size: PInteger): Boolean;
begin
  Result := False;
  if (InRange(Index, 0, Pred(Length(Resources))) = False) or
    (Length(Resources) <= 0) then
  begin
    Size^ := -1;
    exit;
  end;
  if Assigned(Data) then
    Move(Resources[Index].Data^, Data^, Resources[Index].Size);
  Size^ := Resources[Index].Size;
  Result := True;
end;

function PrecompSearchBinary(SrcMem: Pointer; SrcPos, SrcSize: NativeInt;
  SearchMem: Pointer; SearchSize: NativeInt; ResultPos: PNativeInt): Boolean;
begin
  Result := BinarySearch(SrcMem, SrcPos, SrcSize, SearchMem, SearchSize,
    ResultPos^);
end;

procedure PrecompSwapBinary(Source, Dest: Pointer; Size: NativeInt);
begin
  ReverseBytes(Source, Dest, Size);
end;

function PrecompSwap16(Int: Int16): Int16;
begin
  Result := EndianSwap(Int);
end;

function PrecompSwap32(Int: Int32): Int32;
begin
  Result := EndianSwap(Int);
end;

function PrecompSwap64(Int: Int64): Int64;
begin
  Result := EndianSwap(Int);
end;

function PrecompFileOpen(FileName: PChar; Create: Boolean): THandle;
begin
  if Create then
    FileCreate(FileName)
  else
    FileOpen(FileName, fmOpenReadWrite or fmShareDenyNone);
end;

procedure PrecompFileClose(Handle: THandle);
begin
  FileClose(Handle);
end;

function PrecompFileSeek(Handle: THandle; Offset: Int64;
  Origin: Integer): Int64;
begin
  Result := FileSeek(Handle, Offset, Origin);
end;

function PrecompFileSize(Handle: THandle): Int64;
var
  LPos: Int64;
begin
  LPos := FileSeek(Handle, 0, FILE_CURRENT);
  Result := FileSeek(Handle, 0, FILE_END);
  FileSeek(Handle, LPos, FILE_BEGIN);
end;

function PrecompFileRead(Handle: THandle; Buffer: Pointer;
  Count: Integer): Integer;
begin
  Result := FileRead(Handle, Buffer^, Count);
end;

function PrecompFileWrite(Handle: THandle; Buffer: Pointer;
  Count: Integer): Integer;
begin
  Result := FileWrite(Handle, Buffer^, Count);
end;

function PrecompIniRead(Section, Key, Default, FileName: PChar): TPrecompStr;
var
  S: String;
begin
  S := GetIniString(Section, Key, Default, FileName);
  StringToWideChar(S, @Result, Length(Result));
end;

procedure PrecompIniWrite(Section, Key, Value, FileName: PChar);
begin
  SetIniString(Section, Key, Value, FileName);
end;

function PrecompExec(Executable, CommandLine, WorkDir: PChar): Boolean;
begin
  Result := Exec(Executable, CommandLine, WorkDir);
end;

function PrecompExecStdin(Executable, CommandLine, WorkDir: PChar;
  InBuff: Pointer; InSize: Integer): Boolean;
begin
  Result := ExecStdin(Executable, CommandLine, WorkDir, InBuff, InSize);
end;

function PrecompExecStdout(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; Output: _ExecOutput): Boolean;
const
  PipeSecurityAttributes: TSecurityAttributes =
    (nLength: SizeOf(PipeSecurityAttributes); bInheritHandle: True);
  BufferSize = 65536;
var
  hstdoutr, hstdoutw: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  dwExitCode: DWORD;
  Buffer: array [0 .. BufferSize - 1] of Byte;
  BytesRead: DWORD;
  LWorkDir: PChar;
begin
  Result := False;
  CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0);
  SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := hstdoutw;
  StartupInfo.hStdError := 0;
  ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
  if WorkDir <> '' then
    LWorkDir := Pointer(WorkDir)
  else
    LWorkDir := Pointer(GetCurrentDir);
  if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
    True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
  begin
    CloseHandleEx(ProcessInfo.hThread);
    CloseHandleEx(hstdoutw);
    try
      while ReadFile(hstdoutr, Buffer, Length(Buffer), BytesRead, nil) and
        (BytesRead > 0) do
        Output(Instance, @Buffer[0], BytesRead);
    finally
      CloseHandleEx(hstdoutr);
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
      CloseHandleEx(ProcessInfo.hProcess);
    end;
    Result := dwExitCode = 0;
  end
  else
  begin
    CloseHandleEx(hstdoutr);
    CloseHandleEx(hstdoutw);
    RaiseLastOSError;
  end;
end;

function PrecompExecStdio(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
  Output: _ExecOutput): Boolean;
const
  PipeSecurityAttributes: TSecurityAttributes =
    (nLength: SizeOf(PipeSecurityAttributes); bInheritHandle: True);
  BufferSize = 65536;
var
  Buffer: array [0 .. BufferSize - 1] of Byte;
  BytesRead: DWORD;
  hstdinr, hstdinw: THandle;
  hstdoutr, hstdoutw: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  dwExitCode: DWORD;
  LWorkDir: PChar;
begin
  Result := True;
  CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0);
  CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0);
  SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0);
  SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.hStdInput := hstdinr;
  StartupInfo.hStdOutput := hstdoutw;
  StartupInfo.hStdError := 0;
  ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
  if WorkDir <> '' then
    LWorkDir := Pointer(WorkDir)
  else
    LWorkDir := Pointer(GetCurrentDir);
  if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
    True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
  begin
    CloseHandleEx(ProcessInfo.hThread);
    CloseHandleEx(hstdinr);
    CloseHandleEx(hstdoutw);
    try
      FileWriteBuffer(hstdinw, InBuff^, InSize);
      CloseHandleEx(hstdinw);
      while ReadFile(hstdoutr, Buffer[0], Length(Buffer), BytesRead, nil) and
        (BytesRead > 0) do
        Output(Instance, @Buffer[0], BytesRead);
    finally
      CloseHandleEx(hstdinw);
      CloseHandleEx(hstdoutr);
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
      CloseHandleEx(ProcessInfo.hProcess);
    end;
    Result := dwExitCode = 0;
  end
  else
  begin
    CloseHandleEx(hstdinr);
    CloseHandleEx(hstdinw);
    CloseHandleEx(hstdoutr);
    CloseHandleEx(hstdoutw);
    RaiseLastOSError;
  end;
end;

procedure ExecReadTask(Instance, Handle, Stream: IntPtr);
const
  BufferSize = 65536;
var
  Buffer: array [0 .. BufferSize - 1] of Byte;
  BytesRead: DWORD;
begin
  while ReadFile(Handle, Buffer[0], Length(Buffer), BytesRead, nil) and
    (BytesRead > 0) do
    PExecOutput(Pointer(Stream))^(Instance, @Buffer[0], BytesRead);
end;

function PrecompExecStdioSync(Instance: Integer;
  Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
  Output: _ExecOutput): Boolean;
const
  PipeSecurityAttributes: TSecurityAttributes =
    (nLength: SizeOf(PipeSecurityAttributes); bInheritHandle: True);
var
  hstdinr, hstdinw: THandle;
  hstdoutr, hstdoutw: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  dwExitCode: DWORD;
  LWorkDir: PChar;
  LTask: TTask;
  LDone: Boolean;
begin
  Result := True;
  CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0);
  CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0);
  SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0);
  SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.hStdInput := hstdinr;
  StartupInfo.hStdOutput := hstdoutw;
  StartupInfo.hStdError := 0;
  ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
  if WorkDir <> '' then
    LWorkDir := Pointer(WorkDir)
  else
    LWorkDir := Pointer(GetCurrentDir);
  if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
    True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
  begin
    CloseHandleEx(ProcessInfo.hThread);
    CloseHandleEx(hstdinr);
    CloseHandleEx(hstdoutw);
    LTask := TTask.Create(Instance, hstdoutr, NativeInt(@Output),
      NativeInt(@LDone));
    LTask.Perform(ExecReadTask);
    LTask.Start;
    try
      FileWriteBuffer(hstdinw, InBuff^, InSize);
    finally
      CloseHandleEx(hstdinw);
      LTask.Wait;
      if LTask.Status <> TThreadStatus.tsErrored then
        LTask.Free;
      CloseHandleEx(hstdoutr);
    end;
    if Assigned(LTask) then
      if LTask.Status <> TThreadStatus.tsErrored then
        try
          LTask.RaiseLastError;
        finally
          LTask.Free;
        end;
    Result := dwExitCode = 0;
  end
  else
  begin
    CloseHandleEx(hstdinr);
    CloseHandleEx(hstdinw);
    CloseHandleEx(hstdoutr);
    CloseHandleEx(hstdoutw);
    RaiseLastOSError;
  end;
end;

function PrecompAcceptPatch(OldSize, NewSize, PatchSize: Integer): Boolean;
begin
  Result := False;
  if PatchSize > 0 then
    if DIFF_TOLERANCE <= 1 then
      Result := (PatchSize / Max(OldSize, NewSize)) <= DIFF_TOLERANCE
    else
      Result := PatchSize <= DIFF_TOLERANCE;
end;

function DummyInit(Command: PChar; Count: Integer;
  Funcs: PPrecompFuncs): Boolean;
begin
  Result := True;
end;

procedure DummyFree(Funcs: PPrecompFuncs);
begin

end;

function DummyParse(Command: PChar; Option: PInteger;
  Funcs: PPrecompFuncs): Boolean;
var
  S: String;
  I: Integer;
begin
  Result := False;
  Option^ := 0;
  I := 0;
  while Funcs^.GetCodec(Command, I, False) <> '' do
  begin
    S := Funcs^.GetCodec(Command, I, False);
    if (CompareText(S, DummyCodecs[NONE_CODEC]) = 0) then
    begin
      SetBits(Option^, NONE_CODEC, 0, 3);
      Result := True;
    end;
    Inc(I);
  end;
end;

procedure DummyScan1(Instance, Depth: Integer; Input: PByte;
  Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd;
  Funcs: PPrecompFuncs);
begin

end;

function DummyScan2(Instance, Depth: Integer; Input: Pointer; Size: Cardinal;
  StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput;
  Funcs: PPrecompFuncs): Boolean;
begin
  Result := StreamInfo^.OldSize > 0;
  StreamInfo^.NewSize := StreamInfo^.OldSize;
  if Result then
    Output(Instance, Input, StreamInfo^.OldSize);
  Funcs^.LogScan2(DummyCodecs[GetBits(StreamInfo^.Option, 0, 3)],
    StreamInfo^.OldSize, -1);
end;

function DummyProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
  StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
begin
  Result := StreamInfo.OldSize > 0;
end;

function DummyRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
  StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
begin
  Output(Instance, Input, StreamInfo.OldSize);
  Result := True;
end;

var
  I: Integer;

initialization

EncodeSICmp := TEncodeSIComparer.Create;
FutureSICmp := TFutureSIComparer.Create;
StockMethods := TStringList.Create;
ExternalMethods := TStringList.Create;

Codec.Names := [];
for I := Low(DummyCodecs) to High(DummyCodecs) do
begin
  Codec.Names := Codec.Names + [DummyCodecs[I]];
  StockMethods.Add(DummyCodecs[I]);
end;
Codec.Initialised := False;
Codec.Init := @DummyInit;
Codec.Free := @DummyFree;
Codec.Parse := @DummyParse;
Codec.Scan1 := @DummyScan1;
Codec.Scan2 := @DummyScan2;
Codec.Process := @DummyProcess;
Codec.Restore := @DummyRestore;

end.
