Vichingo455-RePacks/xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

update to 0.6.9

Browse Source
This commit is contained in:
Razor12911
2022-12-22 10:03:17 +02:00
parent 5c4cd7a5b0
commit 722279aad5
31 changed files with 8425 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
precompressor/PrecompDLL.pas
View File

@@ -4,6 +4,7 @@ interface
uses
Utils,
UIMain,
PrecompUtils,
WinAPI.Windows,
System.SysUtils, System.Classes, System.StrUtils,
@@ -375,6 +376,9 @@ begin
@DLLStruct^.Scan2 := GetProcAddress(DLLHandle, 'PrecompScan2');
@DLLStruct^.Process := GetProcAddress(DLLHandle, 'PrecompProcess');
@DLLStruct^.Restore := GetProcAddress(DLLHandle, 'PrecompRestore');
if UIMain.DLLLoaded then
XTLAddplugin(ChangeFileExt(ExtractFileName(DLLList[I]), ''),
PLUGIN_LIBRARY);
Insert(DLLStruct^, CodecDLL, Length(CodecDLL));
J := 0;
while Assigned(CodecDLL[Pred(Length(CodecDLL))].Codec(J)) do
@@ -383,6 +387,8 @@ begin
Insert(S, CodecDLL[Pred(Length(CodecDLL))].Names,
Length(CodecDLL[Pred(Length(CodecDLL))].Names));
Insert(S, Codec.Names, Length(Codec.Names));
if UIMain.DLLLoaded then
XTLAddCodec(S);
Inc(J);
end;
if J = 0 then
@@ -392,6 +398,8 @@ begin
Length(CodecDLL[Pred(Length(CodecDLL))].Names));
Insert(ChangeFileExt(ExtractFileName(DLLList[I]), ''), Codec.Names,
Length(Codec.Names));
if UIMain.DLLLoaded then
XTLAddCodec(ChangeFileExt(ExtractFileName(DLLList[I]), ''));
end;
end;
end;

45
precompressor/PrecompINI.pas
View File

@@ -4,6 +4,7 @@ interface
uses
Utils, ParseExpr,
UIMain,
PrecompUtils,
WinAPI.Windows,
System.SysUtils, System.Classes, System.StrUtils,
@@ -136,7 +137,7 @@ begin
if CompareText(S, Codec.Names[Y]) = 0 then
begin
for I := Low(CodecEnabled[Y]) to High(CodecEnabled[Y]) do
CodecEnabled[Y][I] := True;
CodecEnabled[Y, I] := True;
for Z := Low(CodecCfg[0, Y]) to High(CodecCfg[0, Y]) do
if Funcs^.GetParam(Command, X, PChar(CodecCfg[0, Y, Z].Name)) <> ''
then
@@ -144,7 +145,7 @@ begin
if not ParamsSet then
begin
for I := Low(CodecEnabled[Y]) to High(CodecEnabled[Y]) do
CodecEnabled[Y][I] := False;
CodecEnabled[Y, I] := False;
ParamsSet := True;
end;
CodecEnabled[Y, Z] := True;
@@ -292,11 +293,13 @@ begin
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);
@@ -362,7 +365,7 @@ begin
end;
var
I, J, X, Y: Integer;
I, J, K, X, Y: Integer;
SL: TStringList;
Bytes: TBytes;
S1, S2: String;
@@ -373,8 +376,6 @@ var
CfgRecArray: PCfgRecDynArray;
CfgStruct: PCfgStruct;
SList: TStringDynArray;
PStr1: PAnsiChar;
PStr2: PString;
initialization
@@ -390,13 +391,20 @@ begin
begin
S1 := ChangeFileExt(ExtractFileName(CfgList[I]), '');
Insert(S1, Codec.Names, Length(Codec.Names));
New(CfgRecArray);
if UIMain.DLLLoaded 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
New(CfgRec);
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 UIMain.DLLLoaded then
XTLAddCodec(CfgRec^.Name);
CfgRec^.Codec := ReadString('Stream' + X.ToString, 'Codec', '');
CfgRec^.BigEndian := ReadBool('Stream' + X.ToString,
'BigEndian', False);
@@ -406,7 +414,11 @@ begin
BStream := True;
for Y := Low(SList) to High(SList) do
begin
New(CfgStruct);
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;
@@ -422,6 +434,8 @@ begin
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)));
@@ -437,8 +451,6 @@ begin
CfgStruct^.Position := Pos;
CfgStruct^.Value := 0;
CfgStruct^.BeforeStream := BStream;
if (CfgStruct^.Name = 'Stream') or (CfgStruct^.Size > 0) then
Insert(CfgStruct^, CfgRec^.Structure, Length(CfgRec^.Structure));
Inc(Pos, CfgStruct^.Size);
if CfgStruct^.Name = 'Stream' then
begin
@@ -462,11 +474,10 @@ begin
while ReadString('Stream' + X.ToString, 'Condition' + Y.ToString,
'') <> '' do
begin
New(PStr2);
PStr2^ := ReadString('Stream' + X.ToString,
S2 := ReadString('Stream' + X.ToString,
'Condition' + Y.ToString, '');
ConvertHexChr(PStr2^);
Insert(PStr2^, CfgRec^.Conditions, Length(CfgRec^.Conditions));
ConvertHexChr(S2);
Insert(S2, CfgRec^.Conditions, Length(CfgRec^.Conditions));
Inc(Y);
end;
ReadSectionValues('Stream' + X.ToString, SL);
@@ -489,10 +500,8 @@ begin
CfgRec^.Exprs[J] := S2;
CfgRec^.Values[J] := 0;
end;
Insert(CfgRec^, CfgRecArray^, Length(CfgRecArray^));
Inc(X);
end;
Insert(CfgRecArray^, CodecCfg[0], Length(CodecCfg[0]));
end;
finally
Free;
@@ -504,10 +513,10 @@ for J := Low(CodecCfg[0]) to High(CodecCfg[0]) do
begin
with CodecCfg[0, J, X] do
begin
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);
for Y := Low(Names) to High(Names) do
Parser.DefineVariable(Names[Y], @Values[Y]);
end;
end;

707
precompressor/PrecompINIEx.pas Normal file
View File

@@ -0,0 +1,707 @@
unit PrecompINIEx;
interface
uses
Utils, ParseExpr,
UIMain,
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;
PCfgCounter = ^TCfgCounter;
TCfgCounter = record
StartS, EndS, StepS: String;
StartV, EndV, StepV: Double;
Current, Min, Max: Double;
end;
PConfigRec = ^TConfigRec;
TConfigRec = record
Parser: TExpressionParser;
Name, Codec: String;
Resource: Integer;
BigEndian: Boolean;
Structure: array [0 .. 2] of TArray<TCfgStruct>;
Counter: TArray<TCfgCounter>;
StreamPosition, 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;
ParamsSet: Boolean;
begin
Result := True;
ParamsSet := False;
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;
for Z := Low(Structure) to High(Structure) do
begin
SetLength(Structure[Z], Length(CodecCfg[0, J, X].Structure[Z]));
for Y := Low(Structure[Z]) to High(Structure[Z]) do
begin
Structure[Z, Y].Name := CodecCfg[0, J, X].Structure[Z, Y].Name;
Structure[Z, Y].Position := CodecCfg[0, J, X].Structure[Z]
[Y].Position;
Structure[Z, Y].Size := CodecCfg[0, J, X].Structure[Z, Y].Size;
Structure[Z, Y].Value := CodecCfg[0, J, X].Structure
[Z, Y].Value;
Structure[Z, Y].BeforeStream := CodecCfg[0, J, X].Structure
[Z, Y].BeforeStream;
GetMem(Structure[Z, Y].Data, Structure[Z, Y].Size);
Move(CodecCfg[0, J, X].Structure[Z, Y].Data^,
Structure[Z, Y].Data^, Structure[Z, Y].Size);
end;
end;
SetLength(Counter, Length(CodecCfg[0, J, X].Counter));
for Y := Low(Counter) to High(Counter) do
begin
Counter[Y].StartS := CodecCfg[0, J, X].Counter[Y].StartS;
Counter[Y].EndS := CodecCfg[0, J, X].Counter[Y].EndS;
Counter[Y].StepS := CodecCfg[0, J, X].Counter[Y].StepS;
Counter[Y].StartV := CodecCfg[0, J, X].Counter[Y].StartV;
Counter[Y].EndV := CodecCfg[0, J, X].Counter[Y].EndV;
Counter[Y].StepV := CodecCfg[0, J, X].Counter[Y].StepV;
Counter[Y].Current := CodecCfg[0, J, X].Counter[Y].Current;
Counter[Y].Min := CodecCfg[0, J, X].Counter[Y].Min;
Counter[Y].Max := CodecCfg[0, J, X].Counter[Y].Max;
end;
StreamPosition := CodecCfg[0, J, X].StreamPosition;
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 Z := Low(Structure) to High(Structure) do
for Y := Low(Structure[Z]) to High(Structure[Z]) do
Parser.DefineVariable(Structure[Z, Y].Name,
@Structure[Z, Y].Value);
for Y := Low(Counter) to High(Counter) do
begin
Parser.DefineVariable('Counter' + Succ(Y).ToString,
@Counter[Y].Current);
Parser.DefineVariable('CounterMin' + Succ(Y).ToString,
@Counter[Y].Min);
Parser.DefineVariable('CounterMax' + Succ(Y).ToString,
@Counter[Y].Max);
end;
for Y := Low(Names) to High(Names) do
Parser.DefineVariable(Names[Y], @Values[Y]);
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
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
if Funcs^.GetParam(Command, X, PChar(CodecCfg[0, Y, Z].Name)) <> ''
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;
end;
break;
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, Z: 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 Z := Low(Structure) to High(Structure) do
for Y := Low(Structure[Z]) to High(Structure[Z]) do
FreeMem(Structure[Z, 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: NativeInt;
NI: NativeInt;
I64: Int64;
LoopPosInt, StreamPosInt1, StreamPosInt2, StreamOffsetInt, OldSizeInt,
NewSizeInt, DepthSizeInt: NativeInt;
LoopContinue: Boolean;
SI: _StrInfo1;
DI: TDepthInfo;
DS: TPrecompStr;
procedure UpdateCounters(var C: TConfigRec);
var
Z: Integer;
begin
with C do
for Z := Low(Counter) to High(Counter) do
begin
Counter[Z].StartV := Parser.Evaluate(Counter[Z].StartS);
Counter[Z].EndV := Parser.Evaluate(Counter[Z].EndS);
Counter[Z].StepV := Parser.Evaluate(Counter[Z].StepS);
end;
end;
function CheckCounters(C: TConfigRec): Boolean;
var
Z: Integer;
begin
Result := True;
with C do
for Z := Low(Counter) to High(Counter) do
if not InRange(Round(Counter[Z].Current), Min(Round(Counter[Z].StartV),
Round(Counter[Z].EndV)), Max(Round(Counter[Z].StartV),
Round(Counter[Z].EndV))) then
Exit(False);
end;
procedure DoAddStream(C: TConfigRec);
begin
with C do
begin
Output(Instance, nil, -1);
SI.Position := StreamPosInt1 + 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;
DS := Funcs^.GetDepthCodec(PChar(Codec));
Move(DS[0], DI.Codec, SizeOf(DI.Codec));
DI.OldSize := NewSizeInt;
DI.NewSize := DepthSizeInt;
Add(Instance, @SI, PChar(Codec), @DI);
Status := TScanStatus.Success;
end;
end;
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[0]) to High(Structure[0]) do
if Structure[0, X].Name = 'Signature' then
begin
Pos := 0;
while BinarySearch(Input, Pos, Size, Structure[0, X].Data,
Structure[0, X].Size, Pos) do
begin
Status := TScanStatus.None;
LoopPosInt := Pos + Structure[0, X].Size;
for Y := Low(Structure[0]) to High(Structure[0]) do
begin
if (X <> Y) then
begin
NI := Structure[0, Y].Position - Structure[0, X].Position;
LoopPosInt := Pos + Structure[0, Y].Size + NI;
if InRange(Pos + NI, 0, SizeEx - Structure[0, Y].Size) then
begin
Move((Input + Pos + NI)^, Structure[0, Y].Data^,
Structure[0, Y].Size);
I64 := 0;
EndianMove(Structure[0, Y].Data, @I64,
Min(Structure[0, Y].Size, I64.Size), BigEndian);
Structure[0, 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;
UpdateCounters(CodecCfg[Instance, I, J]);
for Y := Low(Counter) to High(Counter) do
begin
Counter[Y].Current := Counter[Y].StartV;
Counter[Y].Min := Min(Counter[Y].StepV,
Counter[Y].EndV - Counter[Y].Current);
Counter[Y].Max := Max(Counter[Y].StepV,
Counter[Y].EndV - Counter[Y].Current);
end;
while CheckCounters(CodecCfg[Instance, I, J]) do
begin
Status := TScanStatus.None;
for Y := Low(Structure[1]) to High(Structure[1]) do
begin
if InRange(LoopPosInt, 0, SizeEx - Structure[1, Y].Size)
then
begin
Move((Input + LoopPosInt)^, Structure[1, Y].Data^,
Structure[1, Y].Size);
I64 := 0;
EndianMove(Structure[1, Y].Data, @I64,
Min(Structure[1, Y].Size, I64.Size), BigEndian);
Structure[1, Y].Value := I64.ToDouble;
end
else
begin
Status := TScanStatus.Fail;
break;
end;
Inc(LoopPosInt, Structure[1, Y].Size);
end;
if Status = TScanStatus.Fail then
break;
StreamPosInt1 := Pos + Round(Parser.Evaluate(StreamPosition));
StreamPosInt2 := StreamPosInt1;
for Y := Low(Structure[2]) to High(Structure[2]) do
begin
if (Structure[2, Y].BeforeStream = True) then
begin
if Structure[2, Y].Name = 'Stream' then
begin
StreamPosInt1 := StreamPosInt2;
continue;
end;
Funcs^.ReadFuture(Instance, StreamPosInt2,
Structure[2, Y].Data, Structure[2, Y].Size);
I64 := 0;
EndianMove(Structure[2, Y].Data, @I64,
Min(Structure[2, Y].Size, I64.Size), BigEndian);
Structure[2, Y].Value := I64.ToDouble;
Inc(StreamPosInt2, Structure[2, Y].Size);
end;
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;
StreamOffsetInt := Round(Parser.Evaluate(StreamOffset));
OldSizeInt := Round(Parser.Evaluate(OldSize));
NewSizeInt := Round(Parser.Evaluate(NewSize));
DepthSizeInt := Round(Parser.Evaluate(DepthSize));
for Y := Low(Structure[2]) to High(Structure[2]) do
begin
if (Structure[2, Y].BeforeStream = False) then
begin
Funcs^.ReadFuture(Instance, StreamPosInt2 + OldSizeInt,
Structure[2, Y].Data, Structure[2, Y].Size);
I64 := 0;
EndianMove(Structure[2, Y].Data, @I64,
Min(Structure[2, Y].Size, I64.Size), BigEndian);
Structure[2, Y].Value := I64.ToDouble;
Inc(StreamPosInt2, Structure[2, Y].Size);
end;
end;
if Length(Conditions) = 0 then
DoAddStream(CodecCfg[Instance, I, J])
else
for Y := Low(Conditions) to High(Conditions) do
begin
if (Round(Parser.Evaluate(Conditions[Y])) <> 0) and
(Y = High(Conditions)) then
DoAddStream(CodecCfg[Instance, I, J])
else
break;
end;
UpdateCounters(CodecCfg[Instance, I, J]);
for Y := Low(Counter) to High(Counter) do
begin
Counter[Y].Current := Counter[Y].Current + Counter[Y].StepV;
Counter[Y].Min :=
Min(Counter[Y].StepV,
Counter[Y].EndV - Counter[Y].Current);
Counter[Y].Max :=
Max(Counter[Y].StepV,
Counter[Y].EndV - Counter[Y].Current);
end;
end;
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;
Bytes: TBytes;
S1, S2, S3: String;
Pos: Integer;
BStream: Boolean;
HexValue: Boolean;
CfgRec: PConfigRec;
CfgRecArray: PCfgRecDynArray;
CfgStruct: PCfgStruct;
CfgCounter: PCfgCounter;
SList: TStringDynArray;
initialization
CfgList := TDirectory.GetFiles(ExtractFilePath(Utils.GetModuleName), '*.ini',
TSearchOption.soTopDirectoryOnly);
SL := TStringList.Create;
SetLength(CodecCfg, 1);
for I := Low(CfgList) to High(CfgList) do
begin
with TIniFile.Create(CfgList[I]) do
try
if ReadString('StreamList1', 'Name', '') <> '' then
begin
S1 := ChangeFileExt(ExtractFileName(CfgList[I]), '');
Insert(S1, Codec.Names, Length(Codec.Names));
if UIMain.DLLLoaded then
XTLAddplugin(S1, PLUGIN_CONFIG);
SetLength(CodecCfg[0], Succ(Length(CodecCfg[0])));
CfgRecArray := @CodecCfg[0, Pred(Length(CodecCfg[0]))];
X := 1;
while ReadString('StreamList' + 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('StreamList' + X.ToString, 'Name', '');
if UIMain.DLLLoaded then
XTLAddCodec(CfgRec^.Name);
CfgRec^.Codec := ReadString('StreamList' + X.ToString, 'Codec', '');
CfgRec^.BigEndian := ReadBool('StreamList' + X.ToString,
'BigEndian', False);
for Z := Low(CfgRec^.Structure) to High(CfgRec^.Structure) do
begin
case Z of
0:
S3 := 'Structure1';
1:
S3 := 'StructureN';
2:
S3 := 'StructureS';
end;
SList := DecodeStr(ReadString('StreamList' + X.ToString, S3,
''), ',');
Pos := 0;
BStream := True;
for Y := Low(SList) to High(SList) do
begin
K := Length(CodecCfg[0, Pred(Length(CodecCfg[0])),
J].Structure[Z]);
SetLength(CodecCfg[0, Pred(Length(CodecCfg[0])), J].Structure
[Z], Succ(K));
CfgStruct := @CodecCfg[0, Pred(Length(CodecCfg[0])), J]
.Structure[Z, 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);
if (Z = 0) and (CfgStruct^.Name = 'Signature') then
begin
S1 := ReplaceStr(ReadString('StreamList' + X.ToString,
'Signature', '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 (Z = 2) and (CfgStruct^.Name = 'Stream') then
begin
Pos := 0;
BStream := False;
end;
end;
end;
Y := 1;
while ReadString('StreamList' + X.ToString,
'CounterStart' + Y.ToString, '') <> '' do
begin
K := Length(CodecCfg[0, Pred(Length(CodecCfg[0])), J].Counter);
SetLength(CodecCfg[0, Pred(Length(CodecCfg[0])),
J].Counter, Succ(K));
CfgCounter := @CodecCfg[0, Pred(Length(CodecCfg[0])), J].Counter[K];
CfgCounter^.StartS := ReadString('StreamList' + X.ToString,
'CounterStart' + Y.ToString, '');
CfgCounter^.EndS := ReadString('StreamList' + X.ToString,
'CounterEnd' + Y.ToString, '');
CfgCounter^.StepS := ReadString('StreamList' + X.ToString,
'CounterStep' + Y.ToString, '');
CfgCounter^.StartV := 0;
CfgCounter^.EndV := 0;
CfgCounter^.StepV := 0;
CfgCounter^.Current := 0;
CfgCounter^.Min := 0;
CfgCounter^.Max := 0;
Inc(Y);
end;
CfgRec^.StreamPosition := ReadString('StreamList' + X.ToString,
'StreamPosition', '');
CfgRec^.StreamOffset := ReadString('StreamList' + X.ToString,
'StreamOffset', '0');
ConvertHexChr(CfgRec^.StreamOffset);
CfgRec^.OldSize := ReadString('StreamList' + X.ToString,
'CompressedSize', '0');
ConvertHexChr(CfgRec^.OldSize);
CfgRec^.NewSize := ReadString('StreamList' + X.ToString,
'DecompressedSize', '0');
ConvertHexChr(CfgRec^.NewSize);
CfgRec^.DepthSize := ReadString('StreamList' + X.ToString,
'DepthSize', '0');
ConvertHexChr(CfgRec^.DepthSize);
Y := 1;
while ReadString('StreamList' + X.ToString, 'Condition' + Y.ToString,
'') <> '' do
begin
S2 := ReadString('StreamList' + X.ToString,
'Condition' + Y.ToString, '');
ConvertHexChr(S2);
Insert(S2, CfgRec^.Conditions, Length(CfgRec^.Conditions));
Inc(Y);
end;
ReadSectionValues('StreamList' + 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',
'Structure1', 'StructureN', 'StructureS']) >= 0) or
S1.StartsWith('Condition', True) or S1.StartsWith('CounterStart',
True) or S1.StartsWith('CounterEnd', True) or
S1.StartsWith('CounterStep', 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('=')).TrimRight;
S2 := SL[J].Substring(Succ(SL[J].IndexOf('='))).TrimLeft;
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 Z := Low(Structure) to High(Structure) do
for Y := Low(Structure[Z]) to High(Structure[Z]) do
Parser.DefineVariable(Structure[Z, Y].Name, @Structure[Z, Y].Value);
for Y := Low(Counter) to High(Counter) do
begin
Parser.DefineVariable('Counter' + Succ(Y).ToString,
@Counter[Y].Current);
Parser.DefineVariable('CounterMin' + Succ(Y).ToString, @Counter[Y].Min);
Parser.DefineVariable('CounterMax' + Succ(Y).ToString, @Counter[Y].Max);
end;
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.

52
precompressor/PrecompMain.pas
View File

@@ -7,7 +7,8 @@ interface
uses
Threading, Utils, SynCommons, ParseClass, ParseExpr, FLZMA2DLL,
PrecompUtils, PrecompCrypto, PrecompZLib, PrecompLZ4, PrecompLZO, PrecompZSTD,
PrecompOodle, PrecompMedia, PrecompINI, PrecompSearch, PrecompDLL, PrecompEXE,
PrecompOodle, PrecompMedia, PrecompINI, PrecompINIEx, PrecompSearch,
PrecompDLL, PrecompEXE,
WinAPI.Windows, WinAPI.ShlObj,
System.SysUtils, System.Classes, System.SyncObjs, System.Math, System.Types,
System.StrUtils, System.RTLConsts, System.TimeSpan, System.Diagnostics,
@@ -103,12 +104,15 @@ var
Codecs: array of TPrecompressor;
DBFile: String = '';
ExtDir: String = '';
SrepMemCfg: String;
UseDB: Boolean = False;
StoreDD: Integer = -2;
VERBOSE: Boolean = False;
EXTRACT: Boolean = False;
NOVERIFY: Boolean = False;
DupSysMem: Int64 = 0;
EncInfo: TEncInfo;
EncFreed: Boolean = False;
ConTask: TTask;
Stopwatch: TStopwatch;
@@ -186,18 +190,24 @@ begin
Options.Depth := EnsureRange(Succ(ArgParse.AsInteger('-d', 0, 0)), 1, 10);
Options.LowMem := ArgParse.AsBoolean('-lm');
UseDB := ArgParse.AsBoolean('-db') or ArgParse.AsBoolean('--dbase');
Options.DBaseFile := ArgParse.AsString('--dbase=');
Options.DBaseFile := ArgParse.AsString('--dbase=', 0, '');
Options.DBaseFile := ArgParse.AsString('-db', 0, Options.DBaseFile);
if Options.DBaseFile <> '' then
UseDB := True;
StoreDD := -2;
if ArgParse.AsBoolean('-dd') or ArgParse.AsBoolean('--dedup') then
StoreDD := -1;
if FileExists(ExtractFilePath(Utils.GetModuleName) + 'srep.exe') then
begin
StoreDD := ArgParse.AsInteger('--dedup=', 0, StoreDD);
StoreDD := ArgParse.AsInteger('-dd', 0, StoreDD);
end;
S := ArgParse.AsString('--diff=', 0, '5p');
S := ArgParse.AsString('-df', 0, S);
S := ReplaceText(S, 'p', '%');
DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S));
VERBOSE := ArgParse.AsBoolean('-v') or ArgParse.AsBoolean('--verbose');
NOVERIFY := ArgParse.AsBoolean('-s') or ArgParse.AsBoolean('--skip');
Options.ExtractDir := ArgParse.AsString('--extract=');
if Options.ExtractDir <> '' then
EXTRACT := DirectoryExists(Options.ExtractDir);
@@ -244,10 +254,11 @@ begin
Options.DedupSysMem := Max(0, Round(ExpParse.Evaluate(S)));
if B then
Options.DedupSysMem := -Options.DedupSysMem;
VERBOSE := ArgParse.AsBoolean('--verbose');
S := ArgParse.AsString('--compress=', 0, 't50p');
VERBOSE := ArgParse.AsBoolean('-v') or ArgParse.AsBoolean('--verbose');
S := ArgParse.AsString('--compress=', 0, 't25p');
S := ReplaceText(S, SPrecompSep3, SPrecompSep2);
Options.CompressCfg := S;
SrepMemCfg := ArgParse.AsString('--srepmem=', 0, '75p');
finally
ArgParse.Free;
ExpParse.Free;
@@ -317,6 +328,7 @@ var
begin
SetLength(Codecs, 0);
Insert(PrecompINI.Codec, Codecs, Length(Codecs));
Insert(PrecompINIEx.Codec, Codecs, Length(Codecs));
Insert(PrecompSearch.Codec, Codecs, Length(Codecs));
Insert(PrecompDLL.Codec, Codecs, Length(Codecs));
Insert(PrecompEXE.Codec, Codecs, Length(Codecs));
@@ -992,10 +1004,13 @@ begin
CurCodec[Index] := SI2.Codec;
CurDepth[Index] := Depth;
try
Result := Codecs[SI2.Codec].Process(Index, Depth,
PByte(DataStore.Slot(ThreadIndex).Memory) + SI2.ActualPosition,
PByte(MemOutput1[ThreadIndex].Memory) + SI2.StorePosition, @SI1,
@PrecompOutput1, @PrecompFunctions);
if NOVERIFY and not(SI2.Codec in [5]) then
Result := True
else
Result := Codecs[SI2.Codec].Process(Index, Depth,
PByte(DataStore.Slot(ThreadIndex).Memory) + SI2.ActualPosition,
PByte(MemOutput1[ThreadIndex].Memory) + SI2.StorePosition, @SI1,
@PrecompOutput1, @PrecompFunctions);
except
Result := False;
end;
@@ -1274,11 +1289,10 @@ begin
DataStore := TDataStore2.Create(Length(InfoStore1));
end;
CodecInit(Options^.Threads, Options^.Method);
DBFile := Options^.DBaseFile;
if FileExists(ExtractFilePath(Utils.GetModuleName) + DBFile) then
DBFile := ExpandPath(Options^.DBaseFile);
if FileExists(DBFile) then
begin
with TFileStream.Create(ExtractFilePath(Utils.GetModuleName) + DBFile,
fmShareDenyNone) do
with TFileStream.Create(DBFile, fmShareDenyNone) do
begin
Position := 0;
if WorkStream[0].Size < Size then
@@ -1309,6 +1323,8 @@ begin
if (IndexText(PrecompGetCodec(PChar(Options^.Method), I, False),
PrecompINI.Codec.Names) < 0) and
(IndexText(PrecompGetCodec(PChar(Options^.Method), I, False),
PrecompINIEx.Codec.Names) < 0) and
(IndexText(PrecompGetCodec(PChar(Options^.Method), I, False),
PrecompSearch.Codec.Names) < 0) then
begin
if S = '' then
@@ -1359,6 +1375,7 @@ var
UI32: UInt32;
I, J, K: Integer;
begin
EncFreed := True;
if Length(Tasks) > 1 then
WaitForAll(Tasks);
CodecFree(Length(Tasks));
@@ -1684,8 +1701,7 @@ begin
end;
end;
end;
with TFileStream.Create(ExtractFilePath(Utils.GetModuleName) + DBFile,
fmCreate) do
with TFileStream.Create(DBFile, fmCreate) do
begin
WriteBuffer(WorkStream[0].Memory^, WorkStream[0].Position);
Free;
@@ -1734,7 +1750,7 @@ begin
end;
end
else
Output.CopyFrom(TempOutput, 0);
Output.CopyFrom(TBufferedStream(TempOutput).Instance, 0);
TempOutput.Free;
DeleteFile(S);
end
@@ -2098,7 +2114,8 @@ begin
if (Depth = 0) and (StoreDD >= 0) then
begin
LStream := TProcessStream.Create(ExtractFilePath(Utils.GetModuleName) +
'srep.exe', '-d -s - -', GetCurrentDir, Input, nil);
'srep.exe', '-d -s -mem' + SrepMemCfg + ' - -', GetCurrentDir,
Input, nil);
if not LStream.Execute then
raise EReadError.CreateRes(@SReadError);
DecInput[Index] := TBufferedStream.Create(LStream, True, 4194304);
@@ -2350,7 +2367,8 @@ begin
if Options.DoCompress then
LOutput.Free;
try
// EncFree;
if not EncFreed then
EncFree;
finally
Stopwatch.Stop;
end;

25
precompressor/PrecompOodle.pas
View File

@@ -513,16 +513,27 @@ begin
Pos := 0;
while Pos < Size do
begin
GetOodleSI(Input + Pos, SizeEx - Pos, @OodleSI);
if (OodleSI.CSize > 0) then
begin
if GetOodleUS(Instance, Input, Pos, @OodleSI, Output, Add, Funcs) > 0 then
try
while Pos < Size do
begin
Inc(Pos, OodleSI.CSize);
continue;
GetOodleSI(Input + Pos, SizeEx - Pos, @OodleSI);
if (OodleSI.CSize > 0) then
begin
try
if GetOodleUS(Instance, Input, Pos, @OodleSI, Output, Add, Funcs) > 0
then
begin
Inc(Pos, OodleSI.CSize);
continue;
end;
except
end;
end;
Inc(Pos);
end;
except
Inc(Pos);
end;
Inc(Pos);
end;
end;

3
precompressor/PrecompSearch.pas
View File

@@ -4,6 +4,7 @@ interface
uses
Utils, SynCommons, SynCrypto,
UIMain,
PrecompUtils,
WinAPI.Windows,
System.SysUtils, System.Classes, System.StrUtils,
@@ -281,6 +282,8 @@ begin
SetLength(CodecSearch, Succ(J));
S := ChangeFileExt(ExtractFileName(SearchList[I]), '');
Insert(S, Codec.Names, Length(Codec.Names));
if UIMain.DLLLoaded then
XTLAddplugin(S, PLUGIN_DATABASE);
end;
while FStream.Position < FStream.Size do
begin

18
precompressor/PrecompZLib.pas
View File

@@ -444,7 +444,8 @@ begin
exit;
end
else if BoolArray(CodecEnabled, False) then
exit;
if Assigned(Add) then
exit;
Pos := 0;
Buffer := Funcs^.Allocator(Instance, Z_WORKMEM);
IsZlib := False;
@@ -487,7 +488,7 @@ begin
(EndianSwap(PWord(Input + Pos - 2)^) mod $1F = 0) then
begin
WinBits := (Input + Pos - 2)^ shr 4;
if WinBits in [0 .. 7] then
if WinBits = ZWinBits then
begin
ZStream := @ZStream2[Instance, WinBits];
Level := (Input + Pos - 1)^ shr $6;
@@ -569,7 +570,8 @@ begin
if (I = ZLIB_CODEC) and (WinBits = 0) then
SetBits(SI.Option, 1, 12, 3);
SetBits(SI.Option, I, 0, 5);
if CodecEnabled[I] or (I = X) then
if CodecEnabled[I] or (I = X) or
(CodecAvailable[I] and not Assigned(Add)) then
begin
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
@@ -751,8 +753,7 @@ begin
L := EnsureRange(L, 1, 9);
M := 0;
I := 0;
Params := 'l' + L.ToString + ':' + 'w' +
(GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
Params := 'l' + L.ToString;
raw2hif_Init(HR, L);
while True do
begin
@@ -793,7 +794,7 @@ begin
Res1 := StreamInfo^.NewSize;
Res2 := P_HIFSIZE;
Buffer := Funcs^.Allocator(Instance, Res2);
Params := 'w' + (GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
Params := '';
if preflate_decode(OldInput, StreamInfo^.OldSize, NewInput, @Res1,
Buffer, @Res2) then
begin
@@ -868,8 +869,7 @@ begin
I := 0;
J := 0;
M := 0;
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + 'w' +
(GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString;
hif2raw_Init(HR, GetBits(StreamInfo.Option, 5, 7));
while True do
begin
@@ -904,7 +904,7 @@ begin
begin
Res1 := StreamInfo.OldSize;
Buffer := Funcs^.Allocator(Instance, Res1);
Params := 'w' + (GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
Params := '';
if preflate_reencode(Input, StreamInfo.NewSize, InputExt,
StreamInfo.ExtSize, Buffer, @Res1) then
begin

2
precompressor/PrecompZSTD.pas
View File

@@ -320,8 +320,6 @@ begin
if Result or (StreamInfo^.Status >= TStreamStatus.Predicted) then
break;
end;
if Res1 < 0 then
exit;
if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin