unit PrecompINI;

interface

uses
  InitCode,
  Utils, ParseExpr,
  PrecompUtils,
  WinAPI.Windows,
  System.SysUtils, System.Classes, System.StrUtils,
  System.Types, System.Math, System.IOUtils, System.IniFiles;

var
  Codec: TPrecompressor;

implementation

type
  PCfgStruct = ^TCfgStruct;

  TCfgStruct = record
    Name: String;
    Data: Pointer;
    Position, Size: NativeInt;
    Value: Double;
    BeforeStream: Boolean;
  end;

  PConfigRec = ^TConfigRec;

  TConfigRec = record
    Parser: TExpressionParser;
    Name, Codec: String;
    Resource: Integer;
    BigEndian: Boolean;
    Structure: TArray<TCfgStruct>;
    StreamOffset, OldSize, NewSize, DepthSize: String;
    Names, Exprs: TArray<String>;
    Values: TArray<Double>;
    Conditions: TArray<String>;
  end;

  PCfgRecDynArray = ^TCfgRecDynArray;
  TCfgRecDynArray = TArray<TConfigRec>;

var
  CfgList: TStringDynArray;
  CodecCfg: TArray<TArray<TCfgRecDynArray>>;
  CodecAvailable, CodecEnabled: TArray<TArray<Boolean>>;

procedure EndianMove(Source, Dest: Pointer; Size: NativeInt;
  BigEndian: Boolean = False);
begin
  if BigEndian then
    ReverseBytes(Source, Dest, Size)
  else
    Move(Source^, Dest^, Size);
end;

function ConfigInit(Command: PChar; Count: Integer;
  Funcs: PPrecompFuncs): Boolean;
var
  I, J: Integer;
  X, Y, Z: Integer;
  S: String;
  SList: TStringDynArray;
  ParamsSet: Boolean;
begin
  Result := True;
  for X := Low(CodecAvailable) to High(CodecAvailable) do
    for Y := Low(CodecAvailable[X]) to High(CodecAvailable[X]) do
    begin
      CodecAvailable[X, Y] := True;
      CodecEnabled[X, Y] := False;
    end;
  SetLength(CodecCfg, Count);
  for I := 1 to High(CodecCfg) do
  begin
    SetLength(CodecCfg[I], Length(CodecCfg[0]));
    for J := Low(CodecCfg[I]) to High(CodecCfg[I]) do
      SetLength(CodecCfg[I, J], Length(CodecCfg[0, J]));
  end;
  for I := Low(CodecCfg) to High(CodecCfg) do
    for J := Low(CodecCfg[I]) to High(CodecCfg[I]) do
      for X := Low(CodecCfg[I, J]) to High(CodecCfg[I, J]) do
        with CodecCfg[I, J, X] do
        begin
          if I = 0 then
            Resource := RegisterResources(Codec);
          if I > 0 then
          begin
            Parser := TExpressionParser.Create;
            Name := CodecCfg[0, J, X].Name;
            Codec := CodecCfg[0, J, X].Codec;
            Resource := CodecCfg[0, J, X].Resource;
            BigEndian := CodecCfg[0, J, X].BigEndian;
            SetLength(Structure, Length(CodecCfg[0, J, X].Structure));
            for Y := Low(Structure) to High(Structure) do
            begin
              Structure[Y].Name := CodecCfg[0, J, X].Structure[Y].Name;
              Structure[Y].Position := CodecCfg[0, J, X].Structure[Y].Position;
              Structure[Y].Size := CodecCfg[0, J, X].Structure[Y].Size;
              Structure[Y].Value := CodecCfg[0, J, X].Structure[Y].Value;
              Structure[Y].BeforeStream := CodecCfg[0, J, X].Structure[Y]
                .BeforeStream;
              GetMem(Structure[Y].Data, Structure[Y].Size);
              Move(CodecCfg[0, J, X].Structure[Y].Data^, Structure[Y].Data^,
                Structure[Y].Size);
            end;
            StreamOffset := CodecCfg[0, J, X].StreamOffset;
            OldSize := CodecCfg[0, J, X].OldSize;
            NewSize := CodecCfg[0, J, X].NewSize;
            DepthSize := CodecCfg[0, J, X].DepthSize;
            SetLength(Names, Length(CodecCfg[0, J, X].Names));
            SetLength(Exprs, Length(CodecCfg[0, J, X].Exprs));
            SetLength(Values, Length(CodecCfg[0, J, X].Values));
            for Y := Low(Names) to High(Names) do
            begin
              Names[Y] := CodecCfg[0, J, X].Names[Y];
              Exprs[Y] := CodecCfg[0, J, X].Exprs[Y];
              Values[Y] := CodecCfg[0, J, X].Values[Y];
            end;
            SetLength(Conditions, Length(CodecCfg[0, J, X].Conditions));
            for Y := Low(Conditions) to High(Conditions) do
              Conditions[Y] := CodecCfg[0, J, X].Conditions[Y];
            for Y := Low(Names) to High(Names) do
              Parser.DefineVariable(Names[Y], @Values[Y]);
            for Y := Low(Structure) to High(Structure) do
              Parser.DefineVariable(Structure[Y].Name, @Structure[Y].Value);
          end;
        end;
  X := 0;
  while Funcs^.GetCodec(Command, X, False) <> '' do
  begin
    S := Funcs^.GetCodec(Command, X, False);
    for Y := Low(Codec.Names) to High(Codec.Names) do
    begin
      ParamsSet := False;
      if CompareText(S, Codec.Names[Y]) = 0 then
      begin
        for I := Low(CodecEnabled[Y]) to High(CodecEnabled[Y]) do
          CodecEnabled[Y, I] := True;
        for Z := Low(CodecCfg[0, Y]) to High(CodecCfg[0, Y]) do
        begin
          SList := DecodeStr(CodecCfg[0, Y, Z].Name, ',');
          for J := Low(SList) to High(SList) do
            if Funcs^.GetParam(Command, X, PChar(SList[J])) <> '' then
            begin
              if not ParamsSet then
              begin
                for I := Low(CodecEnabled[Y]) to High(CodecEnabled[Y]) do
                  CodecEnabled[Y, I] := False;
                ParamsSet := True;
              end;
              CodecEnabled[Y, Z] := True;
              break;
            end;
        end;
        break;
      end;
    end;
    Inc(X);
  end;
  for X := Low(CodecEnabled) to High(CodecEnabled) do
    for Y := Low(CodecEnabled[X]) to High(CodecEnabled[X]) do
      if CodecEnabled[X, Y] then
        AddMethod(PrecompGetCodec(PChar(CodecCfg[0, X, Y].Codec), 0, False));
end;

procedure ConfigFree(Funcs: PPrecompFuncs);
var
  I, J: Integer;
  X, Y: Integer;
begin
  for I := Low(CodecCfg) to High(CodecCfg) do
    for J := Low(CodecCfg[I]) to High(CodecCfg[I]) do
      for X := Low(CodecCfg[I, J]) to High(CodecCfg[I, J]) do
        with CodecCfg[I, J, X] do
        begin
          if I > 0 then
          begin
            for Y := Low(Structure) to High(Structure) do
              FreeMem(Structure[Y].Data);
          end;
        end;
end;

function ConfigParse(Command: String; Option: PInteger;
  Funcs: PPrecompFuncs): Boolean;
begin
  Result := False;
end;

procedure ConfigScan1(Instance, Depth: Integer; Input: PByte;
  Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd;
  Funcs: PPrecompFuncs);
type
  TScanStatus = (None, Success, Fail);
var
  Status: TScanStatus;
  A, B: Integer;
  I, J: Integer;
  X, Y: Integer;
  Pos, Pos2: NativeInt;
  NI: NativeInt;
  I64: Int64;
  StreamPosInt, StreamOffsetInt, OldSizeInt, NewSizeInt,
    DepthSizeInt: NativeInt;
  SI: _StrInfo1;
  DS: TPrecompStr;
begin
  if Depth > 0 then
    exit;
  for I := Low(CodecCfg[Instance]) to High(CodecCfg[Instance]) do
    for J := Low(CodecCfg[Instance, I]) to High(CodecCfg[Instance, I]) do
      if CodecEnabled[I, J] then
        with CodecCfg[Instance, I, J] do
          for X := Low(Structure) to High(Structure) do
            if Structure[X].Name = 'Signature' then
            begin
              Pos := 0;
              while BinarySearch(Input, Pos, Size, Structure[X].Data,
                Structure[X].Size, Pos) do
              begin
                Status := TScanStatus.None;
                StreamPosInt := Pos;
                for Y := Low(Structure) to High(Structure) do
                begin
                  if (Structure[Y].BeforeStream = True) and
                    (IndexText(Structure[Y].Name, ['Signature', 'Footer']) < 0)
                  then
                  begin
                    NI := Structure[Y].Position - Structure[X].Position;
                    if Structure[Y].Name = 'Stream' then
                    begin
                      StreamPosInt := Pos + NI;
                      continue;
                    end;
                    if InRange(Pos + NI, 0, SizeEx - Structure[Y].Size) then
                    begin
                      Move((Input + Pos + NI)^, Structure[Y].Data^,
                        Structure[Y].Size);
                      I64 := 0;
                      EndianMove(Structure[Y].Data, @I64,
                        Min(Structure[Y].Size, I64.Size), BigEndian);
                      Structure[Y].Value := I64.ToDouble;
                    end
                    else
                      Status := TScanStatus.Fail;
                  end;
                  if Status = TScanStatus.Fail then
                    break;
                end;
                if Status = TScanStatus.Fail then
                begin
                  Inc(Pos);
                  continue;
                end;
                for A := Low(Exprs) to High(Exprs) do
                begin
                  for B := Low(Exprs) to High(Exprs) do
                    try
                      if A = B then
                        continue;
                      Values[B] := Parser.Evaluate(Exprs[B]);
                    except
                    end;
                  try
                    Values[A] := Parser.Evaluate(Exprs[A]);
                  except
                  end;
                end;
                for Y := Low(Structure) to High(Structure) do
                begin
                  if (Structure[Y].BeforeStream = False) and
                    (Structure[Y].Name = 'Footer') then
                  begin
                    Structure[Y].Value := 0;
                    Pos2 := StreamPosInt;
                    if BinarySearch(Input, Pos2, SizeEx, Structure[Y].Data,
                      Structure[Y].Size, Pos2) then
                    begin
                      I64 := Pos2 - StreamPosInt;
                      Structure[Y].Value := I64.ToDouble;
                    end;
                  end;
                  if Status = TScanStatus.Fail then
                    break;
                end;
                StreamOffsetInt := Round(Parser.Evaluate(StreamOffset));
                OldSizeInt := Round(Parser.Evaluate(OldSize));
                NewSizeInt := Round(Parser.Evaluate(NewSize));
                DepthSizeInt := Round(Parser.Evaluate(DepthSize));
                for Y := Low(Structure) to High(Structure) do
                begin
                  if (Structure[Y].BeforeStream = False) and
                    (IndexText(Structure[Y].Name, ['Footer']) < 0) then
                  begin
                    NI := Structure[Y].Position - Structure[X].Position +
                      StreamOffsetInt + OldSizeInt;
                    if InRange(Pos + NI, 0, SizeEx - Structure[Y].Size) then
                    begin
                      Move((Input + Pos + NI)^, Structure[Y].Data^,
                        Structure[Y].Size);
                      I64 := 0;
                      EndianMove(Structure[Y].Data, @I64,
                        Min(Structure[Y].Size, I64.Size), BigEndian);
                      Structure[Y].Value := I64.ToDouble;
                    end
                    else
                      Status := TScanStatus.Fail;
                  end;
                  if Status = TScanStatus.Fail then
                    break;
                end;
                if Status = TScanStatus.Fail then
                begin
                  Inc(Pos);
                  continue;
                end;
                for Y := Low(Conditions) to High(Conditions) do
                begin
                  if Round(Parser.Evaluate(Conditions[Y])) = 0 then
                  begin
                    Status := TScanStatus.Fail;
                    break;
                  end;
                end;
                if Status = TScanStatus.None then
                begin
                  Output(Instance, nil, -1);
                  SI.Position := StreamPosInt + StreamOffsetInt;
                  SI.OldSize := OldSizeInt;
                  SI.NewSize := NewSizeInt;
                  SI.Resource := Resource;
                  SI.Option := 0;
                  if System.Pos(SPrecompSep2, Codec) > 0 then
                    SI.Status := TStreamStatus.Predicted
                  else
                    SI.Status := TStreamStatus.None;
                  Add(Instance, @SI, PChar(Codec), nil);
                  DS := Funcs^.GetDepthCodec(PChar(Codec));
                  if DS <> '' then
                    Funcs^.AddDepthStream(Instance, 0, NewSizeInt, DepthSizeInt,
                      DS, 0, 0);
                  Inc(Pos, Max(OldSizeInt, 1));
                  Status := TScanStatus.Success;
                end;
                if Status <> TScanStatus.Success then
                  Inc(Pos);
              end;
            end;
end;

function ConfigScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt;
  StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput;
  Funcs: PPrecompFuncs): Boolean;
begin
  Result := False;
end;

function ConfigProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
  StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
begin
  Result := False;
end;

function ConfigRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
  StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
begin
  Result := False;
end;

procedure DecodeHeader(const Header: String; out Name, Value: String);
begin
  if (Pos('(', Header) > 0) and (Pos(')', Header) > 0) then
  begin
    Name := ReplaceStr(Header.Substring(0, Header.IndexOf('(')), ' ', '');
    Value := Header.Substring(Succ(Header.IndexOf('(')),
      Header.IndexOf(')') - Succ(Header.IndexOf('(')));
  end
  else
    Name := Header;
end;

procedure ConvertHexChr(var S: String);
begin
  S := ReplaceStr(S, '0x', '$');
  S := ReplaceStr(S, '#', '$');
end;

var
  I, J, K, X, Y, Z: Integer;
  SL: TStringList;
  Ini: TMemIniFile;
  Bytes: TBytes;
  S1, S2: String;
  Pos: Integer;
  BStream: Boolean;
  HexValue: Boolean;
  CfgRec: PConfigRec;
  CfgRecArray: PCfgRecDynArray;
  CfgStruct: PCfgStruct;
  SList: TStringDynArray;
  RStream: TResourceStream;

initialization

SL := TStringList.Create;
SetLength(CodecCfg, 1);
CfgList := TDirectory.GetFiles(ExpandPath(PluginsPath, True), '*.ini',
  TSearchOption.soTopDirectoryOnly);
for I := Low(CfgList) to High(CfgList) do
begin
  Ini := TMemIniFile.Create(CfgList[I]);
  with Ini do
    try
      if ReadString('Stream1', 'Name', '') <> '' then
      begin
        if SameText(ChangeFileExt(ExtractFileName(CfgList[I]), ''),
          ChangeFileExt(ExtractFileName(Utils.GetModuleName), '')) then
          FORCEDMETHOD := True;
        S1 := ChangeFileExt(ExtractFileName(CfgList[I]), '');
        Insert(S1, Codec.Names, Length(Codec.Names));
        if not SameText(ChangeFileExt(ExtractFileName(CfgList[I]), ''),
          ChangeFileExt(ExtractFileName(Utils.GetModuleName), '')) then
          if InitCode.UIDLLLoaded then
            XTLAddplugin(S1, PLUGIN_CONFIG);
        SetLength(CodecCfg[0], Succ(Length(CodecCfg[0])));
        CfgRecArray := @CodecCfg[0, Pred(Length(CodecCfg[0]))];
        X := 1;
        while ReadString('Stream' + X.ToString, 'Name', '') <> '' do
        begin
          J := Length(CodecCfg[0, Pred(Length(CodecCfg[0]))]);
          SetLength(CodecCfg[0, Pred(Length(CodecCfg[0]))], Succ(J));
          CfgRec := @CodecCfg[0, Pred(Length(CodecCfg[0])), J];
          CfgRec^.Parser := TExpressionParser.Create;
          CfgRec^.Name := ReadString('Stream' + X.ToString, 'Name', '');
          if InitCode.UIDLLLoaded then
          begin
            SList := DecodeStr(CfgRec^.Name, ',');
            for Y := Low(SList) to High(SList) do
              XTLAddCodec(SList[Y]);
          end;
          CfgRec^.Codec := ReadString('Stream' + X.ToString, 'Codec', '');
          CfgRec^.BigEndian := ReadBool('Stream' + X.ToString,
            'BigEndian', False);
          SList := DecodeStr(ReadString('Stream' + X.ToString, 'Structure',
            ''), ',');
          Pos := 0;
          BStream := True;
          for Y := Low(SList) to High(SList) do
          begin
            K := Length(CodecCfg[0, Pred(Length(CodecCfg[0])), J].Structure);
            SetLength(CodecCfg[0, Pred(Length(CodecCfg[0])),
              J].Structure, Succ(K));
            CfgStruct := @CodecCfg[0, Pred(Length(CodecCfg[0])), J]
              .Structure[K];
            DecodeHeader(SList[Y], S1, S2);
            ConvertHexChr(S2);
            CfgStruct^.Name := S1;
            CfgStruct^.Size :=
              Round(IfThen(S2 <> '', CfgRec^.Parser.Evaluate(S2), 0));
            GetMem(CfgStruct^.Data, CfgStruct^.Size);
            Z := IndexText(CfgStruct^.Name, ['Signature', 'Footer']);
            if Z >= 0 then
            begin
              S1 := ReplaceStr(ReadString('Stream' + X.ToString,
                CaseStr(Z, ['Signature', 'Footer']), '0'), ' ', '');
              ConvertHexChr(S1);
              HexValue := S1[1] = '$';
              if HexValue then
              begin
                S1 := S1.Substring(1);
                while S1.Length < (CfgStruct^.Size * 2) do
                  S1.Insert(0, '0');
                SetLength(Bytes, CfgStruct^.Size);
                SetLength(Bytes, HexToBin(BytesOf(S1), 0, Bytes, 0,
                  Length(Bytes)));
                ReverseBytes(@Bytes[0], CfgStruct^.Data, CfgStruct^.Size);
              end
              else
              begin
                Bytes := BytesOf(S1);
                SetLength(Bytes, CfgStruct^.Size);
                Move(Bytes[0], CfgStruct^.Data^, CfgStruct^.Size);
              end;
            end;
            CfgStruct^.Position := Pos;
            CfgStruct^.Value := 0;
            CfgStruct^.BeforeStream := BStream;
            Inc(Pos, CfgStruct^.Size);
            if CfgStruct^.Name = 'Stream' then
            begin
              Pos := 0;
              BStream := False;
            end;
          end;
          CfgRec^.StreamOffset := ReadString('Stream' + X.ToString,
            'StreamOffset', '0');
          ConvertHexChr(CfgRec^.StreamOffset);
          CfgRec^.OldSize := ReadString('Stream' + X.ToString,
            'CompressedSize', '0');
          ConvertHexChr(CfgRec^.OldSize);
          CfgRec^.NewSize := ReadString('Stream' + X.ToString,
            'DecompressedSize', '0');
          ConvertHexChr(CfgRec^.NewSize);
          CfgRec^.DepthSize := ReadString('Stream' + X.ToString,
            'DepthSize', '0');
          ConvertHexChr(CfgRec^.DepthSize);
          Y := 1;
          while ReadString('Stream' + X.ToString, 'Condition' + Y.ToString,
            '') <> '' do
          begin
            S2 := ReadString('Stream' + X.ToString,
              'Condition' + Y.ToString, '');
            ConvertHexChr(S2);
            Insert(S2, CfgRec^.Conditions, Length(CfgRec^.Conditions));
            Inc(Y);
          end;
          ReadSectionValues('Stream' + X.ToString, SL);
          for J := SL.Count - 1 downto 0 do
          begin
            S1 := SL[J].Substring(0, SL[J].IndexOf('=')).TrimRight;
            S2 := SL[J].Substring(Succ(SL[J].IndexOf('='))).TrimLeft;
            if (IndexText(S1, ['Name', 'Codec', 'BigEndian', 'Signature',
              'Footer', 'Structure']) >= 0) or S1.StartsWith('Condition', True)
            then
              SL.Delete(J);
          end;
          SetLength(CfgRec^.Names, SL.Count);
          SetLength(CfgRec^.Exprs, SL.Count);
          SetLength(CfgRec^.Values, SL.Count);
          for J := 0 to SL.Count - 1 do
          begin
            S1 := SL[J].Substring(0, SL[J].IndexOf('=')).Trim;
            S2 := SL[J].Substring(Succ(SL[J].IndexOf('='))).Trim;
            CfgRec^.Names[J] := S1;
            CfgRec^.Exprs[J] := S2;
            CfgRec^.Values[J] := 0;
          end;
          Inc(X);
        end;
      end;
    finally
      Free;
    end;
end;

for J := Low(CodecCfg[0]) to High(CodecCfg[0]) do
  for X := Low(CodecCfg[0, J]) to High(CodecCfg[0, J]) do
  begin
    with CodecCfg[0, J, X] do
    begin
      for Y := Low(Structure) to High(Structure) do
        Parser.DefineVariable(Structure[Y].Name, @Structure[Y].Value);
      for Y := Low(Names) to High(Names) do
        Parser.DefineVariable(Names[Y], @Values[Y]);
    end;
  end;

Codec.Initialised := False;
Codec.Init := @ConfigInit;
Codec.Free := @ConfigFree;
Codec.Parse := @ConfigParse;
Codec.Scan1 := @ConfigScan1;
Codec.Scan2 := @ConfigScan2;
Codec.Process := @ConfigProcess;
Codec.Restore := @ConfigRestore;
SetLength(CodecAvailable, Length(CodecCfg[0]));
SetLength(CodecEnabled, Length(CodecCfg[0]));
for I := Low(CodecCfg[0]) to High(CodecCfg[0]) do
begin
  SetLength(CodecAvailable[I], Length(CodecCfg[0, I]));
  SetLength(CodecEnabled[I], Length(CodecCfg[0, I]));
end;

end.