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

update to 0.4.7

Browse Source
This commit is contained in:
Razor12911
2022-03-29 04:36:39 +02:00
parent d7fdc2b45c
commit ba0b997871
23 changed files with 1370 additions and 732 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
precompressor/PrecompCrypto.pas
View File

@@ -63,8 +63,37 @@ end;
procedure CryptoScan1(Instance, Depth: Integer; Input: PByte;
Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd;
Funcs: PPrecompFuncs);
var
X: Integer;
SI: _StrInfo1;
DI1, DI2: TDepthInfo;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
if DS <> '' then
begin
X := IndexTextW(@DS[0], CryptoCodecs);
if (X < 0) or (DI1.OldSize <> SizeEx) then
exit;
Output(Instance, Input, DI1.OldSize);
SI.Position := 0;
SI.OldSize := DI1.OldSize;
SI.NewSize := DI1.NewSize;
SI.Option := 0;
SetBits(SI.Option, X, 0, 5);
if System.Pos(SPrecompSep2, DI1.Codec) > 0 then
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(CryptoCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
end;
function CryptoScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt;
@@ -74,13 +103,15 @@ var
Res: Integer;
begin
Result := False;
Res := -1;
Res := 0;
if not Funcs^.GetResource(StreamInfo^.Resource, nil, @Res) then
exit;
if (Res > 0) and (StreamInfo^.OldSize > 0) then
begin
StreamInfo^.NewSize := StreamInfo^.OldSize;
Output(Instance, Input, StreamInfo^.OldSize);
Funcs^.LogScan2(CryptoCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
@@ -100,11 +131,6 @@ begin
Buffer := Funcs^.Allocator(Instance, Res);
if Funcs^.GetResource(StreamInfo^.Resource, Buffer, @Res) then
begin
with TFileStream.Create('xtest1', fmCreate) do
begin
WriteBuffer(NewInput^, StreamInfo^.NewSize);
Free;
end;
case X of
XOR_CODEC:
Funcs^.Decrypt('xor', NewInput, StreamInfo^.NewSize, Buffer, Res);
@@ -115,13 +141,9 @@ begin
else
exit;
end;
with TFileStream.Create('xtest2', fmCreate) do
begin
WriteBuffer(NewInput^, StreamInfo^.NewSize);
Free;
end;
ShowMessage('');
Result := True;
Funcs^.LogProcess(CryptoCodecs[GetBits(StreamInfo^.Option, 0, 5)], nil,
StreamInfo^.OldSize, StreamInfo^.NewSize, StreamInfo^.OldSize, Result);
end;
end;
@@ -152,6 +174,8 @@ begin
end;
Output(Instance, Input, StreamInfo.OldSize);
Result := True;
Funcs^.LogRestore(CryptoCodecs[GetBits(StreamInfo.Option, 0, 5)], nil,
StreamInfo.OldSize, StreamInfo.NewSize, StreamInfo.OldSize, Result);
end;
end;

345
precompressor/PrecompEXE.pas
View File

@@ -13,8 +13,6 @@ uses
const
FILE_IN = 'data.in';
FILE_OUT = 'data.out';
FILE_RES = 'data.res';
FILE_STORE = 'data.tmp';
FILE_MODE = 0;
STDIN_MODE = 1;
STDOUT_MODE = 2;
@@ -29,7 +27,7 @@ type
Exec, Param: array [0 .. 1] of String;
WorkDir: array of array [0 .. 1] of String;
Mode: array [0 .. 1] of Byte;
InFile, OutFile: String;
InFile, OutFile: array [0 .. 1] of String;
IsLib: array [0 .. 1] of Boolean;
Ctx: array of array [0 .. 1] of Pointer;
end;
@@ -100,12 +98,9 @@ begin
FWorkDir := WorkDir
else
FWorkDir := GetCurrentDir;
FTask := TTask.Create;
FTask.Perform(ExecReadTask);
MTask := TTask.Create(IntPtr(@ProcessInfo.hProcess), IntPtr(@hstdinw),
IntPtr(@hstdoutr));
MTask.Perform(ExecMonTask);
ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
FTask := nil;
MTask := nil;
end;
end;
@@ -115,15 +110,18 @@ begin
begin
TerminateProcess(ProcessInfo.hProcess, 0);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
FTask.Free;
MTask.Wait;
MTask.Free;
if Assigned(FTask) then
begin
FTask.Free;
MTask.Wait;
MTask.Free;
end;
end;
Dispose(Ctx);
end;
function ExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer; InSize: Integer;
Output: _ExecOutput): Boolean;
function ExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer;
var InSize, OutSize: Integer; Output: _ExecOutput): Boolean;
function ProcessLib(Instance: Integer; Stdin, Stdout: THandle): Boolean;
const
@@ -131,23 +129,25 @@ function ExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer; InSize: Integer;
var
Buffer: array [0 .. BufferSize - 1] of Byte;
BytesRead: DWORD;
OutSize: Integer;
X: Integer;
begin
Result := False;
try
FileWriteBuffer(Stdin, InSize, InSize.Size);
FileWriteBuffer(Stdin, OutSize, OutSize.Size);
FileWriteBuffer(Stdin, InBuff^, InSize);
FileReadBuffer(Stdout, OutSize, OutSize.Size);
if OutSize <= 0 then
exit
else
begin
while OutSize > 0 do
X := OutSize;
while X > 0 do
begin
BytesRead := Min(OutSize, Length(Buffer));
BytesRead := Min(X, Length(Buffer));
FileReadBuffer(Stdout, Buffer[0], BytesRead);
Output(Instance, @Buffer[0], BytesRead);
Dec(OutSize, BytesRead);
Dec(X, BytesRead);
end;
Result := True;
end;
@@ -175,6 +175,14 @@ begin
Result := ProcessLib(FInstance, hstdinw, hstdoutr)
else
begin
if not Assigned(FTask) then
begin
FTask := TTask.Create;
FTask.Perform(ExecReadTask);
MTask := TTask.Create(IntPtr(@ProcessInfo.hProcess), IntPtr(@hstdinw),
IntPtr(@hstdoutr));
MTask.Perform(ExecMonTask);
end;
CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0);
CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0);
SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0);
@@ -197,7 +205,7 @@ begin
if FLib then
begin
MTask.Start;
Result := ProcessLib(FInstance, hstdinw, hstdoutr)
Result := ProcessLib(FInstance, hstdinw, hstdoutr);
end
else
begin
@@ -209,10 +217,11 @@ begin
CloseHandleEx(hstdinw);
FTask.Wait;
CloseHandleEx(hstdoutr);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
CloseHandleEx(ProcessInfo.hProcess);
end;
Result := GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode) and
(dwExitCode = 0);
CloseHandleEx(ProcessInfo.hProcess);
Result := dwExitCode = 0;
end;
end
else
@@ -246,8 +255,11 @@ end;
function ExeEncode(Index, Instance: Integer; Input: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
X: Integer;
Executed: Boolean;
S, T: String;
Res: Integer;
begin
Result := False;
CodecSize[Instance] := 0;
@@ -256,32 +268,54 @@ begin
begin
if not DirectoryExists(WorkDir[Instance, 0]) then
CreateDir(WorkDir[Instance, 0]);
DeleteFile(WorkDir[Instance, 0] + InFile);
DeleteFile(WorkDir[Instance, 0] + OutFile);
DeleteFile(WorkDir[Instance, 0] + InFile[0]);
DeleteFile(WorkDir[Instance, 0] + OutFile[0]);
S := Param[0];
S := ReplaceText(S, '<insize>', StreamInfo^.OldSize.ToString);
S := ReplaceText(S, '<outsize>', StreamInfo^.NewSize.ToString);
Res := 0;
Res := 0;
if ContainsText(S, '<fileres>') and Funcs^.GetResource(StreamInfo^.Resource,
nil, @Res) and (Res > 0) then
begin
T := StreamInfo^.Resource.ToHexString.ToLower + '.res';
S := ReplaceText(S, '<fileres>', T);
S := ReplaceText(S, '<ressize>', Res.ToString);
T := WorkDir[Instance, 0] + T;
if not FileExists(T) then
with TFileStream.Create(T, fmCreate) do
try
Buffer := Funcs^.Allocator(Instance, Res);
if Funcs^.GetResource(StreamInfo^.Resource, Buffer, @Res) then
WriteBuffer(Buffer^, Res);
finally
Free;
end;
end;
case Mode[0] of
FILE_MODE, STDOUT_MODE:
begin
with TFileStream.Create(WorkDir[Instance, 0] + InFile, fmCreate) do
with TFileStream.Create(WorkDir[Instance, 0] + InFile[0], fmCreate) do
try
WriteBuffer(Input^, StreamInfo^.OldSize);
finally
Free;
end;
if Mode[0] = FILE_MODE then
Executed := PrecompExec(PChar(Exec[0]), PChar(Param[0]),
Executed := PrecompExec(PChar(Exec[0]), PChar(S),
PChar(WorkDir[Instance, 0]))
else
Executed := PrecompExecStdout(Instance, PChar(Exec[0]),
PChar(Param[0]), PChar(WorkDir[Instance, 0]), ExecOutput1);
Executed := PrecompExecStdout(Instance, PChar(Exec[0]), PChar(S),
PChar(WorkDir[Instance, 0]), ExecOutput1);
end;
else
begin
if Mode[0] = STDIN_MODE then
Executed := PrecompExecStdin(PChar(Exec[0]), PChar(Param[0]),
Executed := PrecompExecStdin(PChar(Exec[0]), PChar(S),
PChar(WorkDir[Instance, 0]), Input, StreamInfo^.OldSize)
else
Executed := ExecStdioProcess(Ctx[Instance, 0], Input,
StreamInfo^.OldSize, ExecOutput1);
StreamInfo^.OldSize, StreamInfo^.NewSize, ExecOutput1);
end;
end;
if Executed then
@@ -289,7 +323,7 @@ begin
case Mode[0] of
FILE_MODE, STDIN_MODE:
begin
with TFileStream.Create(WorkDir[Instance, 0] + OutFile,
with TFileStream.Create(WorkDir[Instance, 0] + OutFile[0],
fmShareDenyNone) do
try
X := Read(WrkMem[Instance, 0], E_WORKMEM);
@@ -310,10 +344,13 @@ begin
end;
function ExeDecode(Index, Instance: Integer; Input: Pointer;
StreamInfo: _StrInfo2; Funcs: PPrecompFuncs): Boolean;
StreamInfo: PStrInfo2; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
X: Integer;
Executed: Boolean;
S, T: String;
Res: Integer;
begin
Result := False;
CodecSize[Instance] := 0;
@@ -322,32 +359,53 @@ begin
begin
if not DirectoryExists(WorkDir[Instance, 1]) then
CreateDir(WorkDir[Instance, 1]);
DeleteFile(WorkDir[Instance, 1] + InFile);
DeleteFile(WorkDir[Instance, 1] + OutFile);
DeleteFile(WorkDir[Instance, 1] + InFile[1]);
DeleteFile(WorkDir[Instance, 1] + OutFile[1]);
S := Param[1];
S := ReplaceText(S, '<insize>', StreamInfo^.NewSize.ToString);
S := ReplaceText(S, '<outsize>', StreamInfo^.OldSize.ToString);
Res := 0;
if ContainsText(S, '<fileres>') and Funcs^.GetResource(StreamInfo^.Resource,
nil, @Res) and (Res > 0) then
begin
T := StreamInfo^.Resource.ToHexString.ToLower + '.res';
S := ReplaceText(S, '<fileres>', T);
S := ReplaceText(S, '<ressize>', Res.ToString);
T := WorkDir[Instance, 0] + T;
if not FileExists(T) then
with TFileStream.Create(T, fmCreate) do
try
Buffer := Funcs^.Allocator(Instance, Res);
if Funcs^.GetResource(StreamInfo^.Resource, Buffer, @Res) then
WriteBuffer(Buffer^, Res);
finally
Free;
end;
end;
case Mode[1] of
FILE_MODE, STDOUT_MODE:
begin
with TFileStream.Create(WorkDir[Instance, 1] + OutFile, fmCreate) do
with TFileStream.Create(WorkDir[Instance, 1] + InFile[1], fmCreate) do
try
WriteBuffer(Input^, StreamInfo.NewSize);
WriteBuffer(Input^, StreamInfo^.NewSize);
finally
Free;
end;
if Mode[1] = FILE_MODE then
Executed := PrecompExec(PChar(Exec[1]), PChar(Param[1]),
Executed := PrecompExec(PChar(Exec[1]), PChar(S),
PChar(WorkDir[Instance, 1]))
else
Executed := PrecompExecStdout(Instance, PChar(Exec[1]),
PChar(Param[1]), PChar(WorkDir[Instance, 1]), ExecOutput2);
Executed := PrecompExecStdout(Instance, PChar(Exec[1]), PChar(S),
PChar(WorkDir[Instance, 1]), ExecOutput2);
end;
else
begin
if Mode[1] = STDIN_MODE then
Executed := PrecompExecStdin(PChar(Exec[1]), PChar(Param[1]),
PChar(WorkDir[Instance, 1]), Input, StreamInfo.NewSize)
Executed := PrecompExecStdin(PChar(Exec[1]), PChar(S),
PChar(WorkDir[Instance, 1]), Input, StreamInfo^.NewSize)
else
Executed := ExecStdioProcess(Ctx[Instance, 1], Input,
StreamInfo.NewSize, ExecOutput2);
StreamInfo^.NewSize, StreamInfo^.OldSize, ExecOutput2);
end;
end;
if Executed then
@@ -355,7 +413,7 @@ begin
case Mode[1] of
FILE_MODE, STDIN_MODE:
begin
with TFileStream.Create(WorkDir[Instance, 1] + InFile,
with TFileStream.Create(WorkDir[Instance, 1] + OutFile[1],
fmShareDenyNone) do
try
X := Read(WrkMem[Instance, 0], E_WORKMEM);
@@ -417,7 +475,7 @@ begin
if CodecExe[X].Mode[Z] = STDIO_MODE then
ExecStdioFree(CodecExe[X].Ctx[Y, Z]);
if DirectoryExists(CodecExe[X].WorkDir[Y, Z]) then
RemoveDir(CodecExe[X].WorkDir[Y, Z]);
TDirectory.Delete(CodecExe[X].WorkDir[Y, Z], True);
end;
end;
@@ -444,11 +502,11 @@ procedure ExeScan1(Instance, Depth: Integer; Input: PByte;
Funcs: PPrecompFuncs);
var
Buffer: PByte;
X, Y: Integer;
X: Integer;
SI1: _StrInfo1;
SI2: _StrInfo2;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@@ -457,23 +515,24 @@ begin
X := IndexText(DS, Codec.Names);
if (X < 0) or (DI1.OldSize <> SizeEx) then
exit;
SI2.OldSize := SizeEx;
SI2.NewSize := 0;
SI2.OldSize := DI1.OldSize;
SI2.NewSize := DI1.NewSize;
if ExeEncode(X, Instance, Input, @SI2, Output, Funcs) then
begin
Output(Instance, Buffer, Y);
SI1.Position := 0;
SI1.OldSize := DI1.OldSize;
SI1.NewSize := Y;
ShowMessage(SI1.OldSize.ToString + ' >> ' + SI1.NewSize.ToString);
SI1.OldSize := SI2.OldSize;
SI1.NewSize := CodecSize[Instance];
SetBits(SI1.Option, CodecExe[X].ID, 0, 31);
if System.Pos(SPrecompSep2, DI1.Codec) > 0 then
SI1.Status := TStreamStatus.Predicted
else
SI1.Status := TStreamStatus.None;
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI1.NewSize;
DI2.NewSize := SI1.NewSize;
DI2.NewSize := 0;
Funcs^.LogScan1(PChar(Codec.Names[X]), SI1.Position, SI1.OldSize,
SI1.NewSize);
Add(Instance, @SI1, DI1.Codec, @DI2);
end;
exit;
@@ -498,6 +557,9 @@ begin
end;
end;
Result := ExeEncode(X, Instance, Input, StreamInfo, Output, Funcs);
if Result then
Funcs^.LogScan2(PChar(Codec.Names[X]), StreamInfo^.OldSize,
StreamInfo^.NewSize);
end;
function ExeProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
@@ -519,18 +581,22 @@ begin
break;
end;
end;
if ExeDecode(X, Instance, NewInput, StreamInfo^, Funcs) then
if ExeDecode(X, Instance, NewInput, StreamInfo, Funcs) then
begin
Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]);
Res1 := CodecSize[Instance];
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(PChar(Codec.Names[X]), nil, StreamInfo^.OldSize,
StreamInfo^.NewSize, Res1, Result);
if Result = False then
begin
Buffer := Funcs^.Allocator(Instance,
Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, Res1));
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, (Res2 > 0) and
((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE));
if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <=
DIFF_TOLERANCE) then
begin
@@ -539,7 +605,10 @@ begin
Result := True;
end;
end;
end;
end
else
Funcs^.LogProcess(PChar(Codec.Names[X]), nil, StreamInfo^.OldSize,
StreamInfo^.NewSize, Res1, Result);
end;
function ExeRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
@@ -566,10 +635,13 @@ begin
SI.NewSize := StreamInfo.NewSize;
SI.Resource := StreamInfo.Resource;
SI.Option := StreamInfo.Option;
if ExeDecode(X, Instance, Input, SI, Funcs) then
if ExeDecode(X, Instance, Input, @SI, Funcs) then
begin
Funcs^.LogRestore(PChar(Codec.Names[X]), nil, StreamInfo.OldSize,
StreamInfo.NewSize, Res1, True);
Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]);
Res1 := CodecSize[Instance];
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
@@ -587,17 +659,31 @@ begin
Output(Instance, Buffer, StreamInfo.OldSize);
Result := True;
end;
end;
end
else
Funcs^.LogRestore(PChar(Codec.Names[X]), nil, StreamInfo.OldSize,
StreamInfo.NewSize, Res1, False);
end;
function ExtractStr(SubStr, Str: String): String;
var
I: Integer;
begin
Result := Str.Substring(Str.IndexOf(SubStr));
I := Result.IndexOf(' ');
if I >= 0 then
Result := Result.Substring(0, Result.IndexOf(' '));
end;
var
I, J, X: Integer;
S1, S2: String;
I, J, K, X: Integer;
S1, S2, S3: String;
Bytes: TBytes;
Ini: TMemIniFile;
SL: TStringList;
ExeStruct: PExeStruct;
Y, Z: Integer;
List: TStringDynArray;
initialization
@@ -608,75 +694,96 @@ begin
SL := TStringList.Create;
Ini.ReadSections(SL);
for I := 0 to SL.Count - 1 do
begin
List := DecodeStr(SL[I], ',');
if FileExists(ExtractFilePath(Utils.GetModuleName) +
GetCmdStr(Ini.ReadString(SL[I], 'Decode', ''), 0)) then
begin
New(ExeStruct);
Insert(SL[I], Codec.Names, Length(Codec.Names));
ExeStruct^.Name := SL[I];
Bytes := BytesOf(ExeStruct^.Name);
ExeStruct^.ID := Utils.Hash32(0, @Bytes[0], Length(Bytes));
for X := 0 to 1 do
for K := Low(List) to High(List) do
begin
ExeStruct^.IsLib[X] := False;
if X = 0 then
S1 := Ini.ReadString(SL[I], 'Encode', '')
else
S1 := Ini.ReadString(SL[I], 'Decode', '');
ExeStruct^.Exec[X] := ExtractFilePath(Utils.GetModuleName) +
GetCmdStr(S1, 0);
ExeStruct^.Param[X] := '';
ExeStruct^.Mode[X] := 0;
for J := 1 to GetCmdCount(S1) do
New(ExeStruct);
Insert(List[K], Codec.Names, Length(Codec.Names));
ExeStruct^.Name := List[K];
Bytes := BytesOf(ExeStruct^.Name);
ExeStruct^.ID := Utils.Hash32(0, @Bytes[0], Length(Bytes));
for X := 0 to 1 do
begin
S2 := GetCmdStr(S1, J);
if ContainsText(S2, '<library>') then
ExeStruct^.IsLib[X] := False;
if X = 0 then
S1 := Ini.ReadString(SL[I], 'Encode', '')
else
S1 := Ini.ReadString(SL[I], 'Decode', '');
S1 := ReplaceText(S1, '<codec>', List[K]);
ExeStruct^.Exec[X] := ExtractFilePath(Utils.GetModuleName) +
GetCmdStr(S1, 0);
ExeStruct^.Param[X] := '';
ExeStruct^.Mode[X] := 0;
for J := 1 to GetCmdCount(S1) - 1 do
begin
SetBits(ExeStruct^.Mode[X], STDIO_MODE, 0, 2);
ExeStruct^.IsLib[X] := True;
continue;
end
else if ContainsText(S2, '<stdin>') then
begin
SetBits(ExeStruct^.Mode[X], 1, 0, 1);
continue;
end
else if ContainsText(S2, '<stdout>') then
begin
SetBits(ExeStruct^.Mode[X], 1, 1, 1);
continue;
end
else if ContainsText(S2, '<filein>') or ContainsText(S2, '[filein]')
then
begin
SetBits(ExeStruct^.Mode[X], 0, 0, 1);
ExeStruct^.InFile := S2;
ExeStruct^.InFile := ReplaceStr(ExeStruct^.InFile,
'<filein>', FILE_IN);
ExeStruct^.InFile := ReplaceStr(ExeStruct^.InFile,
'[filein]', FILE_IN);
if ContainsText(S2, '[filein]') then
S2 := GetCmdStr(S1, J);
if ContainsText(S2, '<library>') then
begin
SetBits(ExeStruct^.Mode[X], STDIO_MODE, 0, 2);
ExeStruct^.IsLib[X] := True;
continue;
end
else if ContainsText(S2, '<fileout>') or ContainsText(S2, '[fileout]')
then
begin
SetBits(ExeStruct^.Mode[X], 0, 1, 1);
ExeStruct^.OutFile := S2;
ExeStruct^.OutFile := ReplaceStr(ExeStruct^.OutFile, '<fileout>',
FILE_OUT);
ExeStruct^.OutFile := ReplaceStr(ExeStruct^.OutFile, '[fileout]',
FILE_OUT);
if ContainsText(S2, '[fileout]') then
end
else if ContainsText(S2, '<stdin>') then
begin
SetBits(ExeStruct^.Mode[X], 1, 0, 1);
continue;
end
else if ContainsText(S2, '<stdout>') then
begin
SetBits(ExeStruct^.Mode[X], 1, 1, 1);
continue;
end
else if ContainsText(S2, '<filein>') or ContainsText(S2, '[filein]')
then
begin
S3 := IfThen(X = 0, FILE_IN, FILE_OUT);
SetBits(ExeStruct^.Mode[X], 0, 0, 1);
if ContainsText(S2, '<filein>') then
begin
ExeStruct^.InFile[X] := ExtractStr('<filein>', S2);
S2 := ReplaceText(S2, ExeStruct^.InFile[X], S3);
ExeStruct^.InFile[X] := ReplaceText(ExeStruct^.InFile[X],
'<filein>', S3);
end
else
begin
ExeStruct^.InFile[X] := ExtractStr('[filein]', S2);
S2 := ReplaceText(S2, ExeStruct^.InFile[X], '');
ExeStruct^.InFile[X] := ReplaceText(ExeStruct^.InFile[X],
'[filein]', S3);
end;
end
else if ContainsText(S2, '<fileout>') or
ContainsText(S2, '[fileout]') then
begin
S3 := IfThen(X = 0, FILE_OUT, FILE_IN);
SetBits(ExeStruct^.Mode[X], 0, 1, 1);
if ContainsText(S2, '<fileout>') then
begin
ExeStruct^.OutFile[X] := ExtractStr('<fileout>', S2);
S2 := ReplaceText(S2, ExeStruct^.OutFile[X], S3);
ExeStruct^.OutFile[X] := ReplaceText(ExeStruct^.OutFile[X],
'<fileout>', S3);
end
else
begin
ExeStruct^.OutFile[X] := ExtractStr('[fileout]', S2);
S2 := ReplaceText(S2, ExeStruct^.OutFile[X], '');
ExeStruct^.OutFile[X] := ReplaceText(ExeStruct^.OutFile[X],
'[fileout]', S3);
end;
end;
S2 := IfThen((Pos(' ', S2) > 0) or (S2 = ''), '"' + S2 + '"', S2);
ExeStruct^.Param[X] := ExeStruct^.Param[X] + ' ' + S2;
end;
S2 := IfThen(Pos(' ', S2) > 0, '"' + S2 + '"', S2);
ExeStruct^.Param[X] := ExeStruct^.Param[X] + ' ' + S2;
ExeStruct^.Param[X] := Trim(ExeStruct^.Param[X]);
end;
ExeStruct^.Param[X] := Trim(ExeStruct^.Param[X]);
Insert(ExeStruct^, CodecExe, Length(CodecExe));
end;
Insert(ExeStruct^, CodecExe, Length(CodecExe));
end;
end;
SL.Free;
Ini.Free;
end;
@@ -695,6 +802,6 @@ for X := Low(CodecExe) to High(CodecExe) do
for Z := 0 to 1 do
for Y := Low(CodecSize) to High(CodecSize) do
if DirectoryExists(CodecExe[X].WorkDir[Y, Z]) then
RemoveDir(CodecExe[X].WorkDir[Y, Z]);
TDirectory.Delete(CodecExe[X].WorkDir[Y, Z], True);
end.

37
precompressor/PrecompINI.pas
View File

@@ -33,7 +33,7 @@ type
Resource: Integer;
BigEndian: Boolean;
Structure: TArray<TCfgStruct>;
StreamOffset, OldSize, NewSize: String;
StreamOffset, OldSize, NewSize, DepthSize: String;
Names, Exprs: TArray<String>;
Values: TArray<Double>;
Conditions: TArray<String>;
@@ -109,6 +109,7 @@ begin
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));
@@ -195,8 +196,11 @@ var
Pos: NativeInt;
NI: NativeInt;
I64: Int64;
StreamPosInt, StreamOffsetInt, OldSizeInt, NewSizeInt: NativeInt;
StreamPosInt, StreamOffsetInt, OldSizeInt, NewSizeInt,
DepthSizeInt: NativeInt;
SI: _StrInfo1;
DI: TDepthInfo;
DS: TPrecompStr;
begin
if Depth > 0 then
exit;
@@ -260,6 +264,7 @@ begin
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 (X <> Y) and (Structure[Y].BeforeStream = False) then
@@ -281,12 +286,18 @@ begin
if Status = TScanStatus.Fail then
break;
end;
for Y := Low(Conditions) to High(Conditions) do
if Status = TScanStatus.Fail then
begin
if Round(Parser.Evaluate(Conditions[Y])) = 0 then
break;
Inc(Pos);
continue;
end;
if (Length(Conditions) = 0) or (Y = High(Conditions)) then
for Y := Low(Conditions) to High(Conditions) do
if Round(Parser.Evaluate(Conditions[Y])) = 0 then
begin
Status := TScanStatus.Fail;
break;
end;
if Status = TScanStatus.None then
begin
Output(Instance, nil, -1);
SI.Position := StreamPosInt + StreamOffsetInt;
@@ -298,7 +309,11 @@ begin
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
Add(Instance, @SI, PChar(Codec), nil);
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);
Inc(Pos, Max(OldSizeInt, 1));
// fix this
Status := TScanStatus.Success;
@@ -410,10 +425,7 @@ begin
SetLength(Bytes, CfgStruct^.Size);
SetLength(Bytes, HexToBin(BytesOf(S1), 0, Bytes, 0,
Length(Bytes)));
if CfgRec^.BigEndian then
Move(Bytes[0], CfgStruct^.Data^, CfgStruct^.Size)
else
ReverseBytes(@Bytes[0], CfgStruct^.Data, CfgStruct^.Size);
ReverseBytes(@Bytes[0], CfgStruct^.Data, CfgStruct^.Size);
end
else
begin
@@ -443,6 +455,9 @@ begin
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

104
precompressor/PrecompLZ4.pas
View File

@@ -22,10 +22,14 @@ const
const
L_MAXSIZE = 16 * 1024 * 1024;
L_BLOCKSIZE = 0;
L_BLOCKDEPENDENCY = 0;
var
SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList;
CodecAvailable, CodecEnabled: TArray<Boolean>;
LBlockSize: Integer = L_BLOCKSIZE;
LBlockDependency: Integer = L_BLOCKDEPENDENCY;
function LZ4Init(Command: PChar; Count: Integer; Funcs: PPrecompFuncs): Boolean;
var
@@ -53,7 +57,6 @@ begin
if (CompareText(S, LZ4Codecs[LZ4_CODEC]) = 0) and LZ4DLL.DLLLoaded then
begin
CodecEnabled[LZ4_CODEC] := True;
SOList[I][LZ4_CODEC].Update([1], True);
end
else if (CompareText(S, LZ4Codecs[LZ4HC_CODEC]) = 0) and LZ4DLL.DLLLoaded
then
@@ -72,16 +75,28 @@ begin
for I := Low(SOList) to High(SOList) do
SOList[I][LZ4F_CODEC].Update
([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True);
if Funcs^.GetParam(Command, X, 'b') <> '' then
LBlockSize := StrToInt(Funcs^.GetParam(Command, X, 'b')) - 4;
if Funcs^.GetParam(Command, X, 'd') <> '' then
LBlockDependency := StrToInt(Funcs^.GetParam(Command, X, 'd'));
end;
Inc(X);
end;
for X := Low(SOList) to High(SOList) do
if SOList[X, LZ4_CODEC].Count = 0 then
SOList[X, LZ4_CODEC].Update([1]);
SetLength(Options, 0);
for I := 3 to 12 do
Insert(I, Options, Length(Options));
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
if SOList[X, Y].Count = 0 then
SOList[X, Y].Update(Options);
if SOList[X, LZ4HC_CODEC].Count = 0 then
SOList[X, LZ4HC_CODEC].Update(Options);
SetLength(Options, 0);
for I := 2 to 12 do
Insert(I, Options, Length(Options));
for X := Low(SOList) to High(SOList) do
if SOList[X, LZ4F_CODEC].Count = 0 then
SOList[X, LZ4F_CODEC].Update(Options);
end;
procedure LZ4Free(Funcs: PPrecompFuncs);
@@ -101,6 +116,8 @@ var
begin
Result := False;
Option^ := 0;
SetBits(Option^, LBlockSize, 12, 2);
SetBits(Option^, LBlockDependency, 14, 1);
I := 0;
while Funcs^.GetCodec(Command, I, False) <> '' do
begin
@@ -124,6 +141,10 @@ begin
SetBits(Option^, 2, 0, 5);
if Funcs^.GetParam(Command, I, 'l') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'l')), 5, 7);
if Funcs^.GetParam(Command, I, 'b') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'b')) - 4, 12, 2);
if Funcs^.GetParam(Command, I, 'd') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'd')), 14, 1);
Result := True;
end;
Inc(I);
@@ -138,7 +159,7 @@ var
X, Y: Integer;
SI: _StrInfo1;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@@ -165,20 +186,24 @@ begin
SI.NewSize := Y;
SI.Option := 0;
SetBits(SI.Option, X, 0, 5);
SetBits(SI.Option, LBlockSize, 12, 2);
SetBits(SI.Option, LBlockDependency, 14, 1);
if System.Pos(SPrecompSep2, DI1.Codec) > 0 then
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(LZ4Codecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
exit;
end;
if BoolArray(CodecEnabled, False) then
exit;
//
end;
function LZ4Scan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt;
@@ -207,6 +232,8 @@ begin
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
Funcs^.LogScan2(LZ4Codecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
@@ -215,6 +242,7 @@ function LZ4Process(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer, Ptr: PByte;
Params: String;
I: Integer;
X, Y: Integer;
Res1: Integer;
@@ -235,25 +263,37 @@ begin
continue;
case X of
LZ4_CODEC:
Res1 := LZ4_compress_default(NewInput, Buffer, StreamInfo^.NewSize, Y);
begin
Params := '';
Res1 := LZ4_compress_default(NewInput, Buffer,
StreamInfo^.NewSize, Y);
end;
LZ4HC_CODEC:
Res1 := LZ4_compress_HC(NewInput, Buffer, StreamInfo^.NewSize, Y, I);
begin
Params := 'l' + I.ToString;
Res1 := LZ4_compress_HC(NewInput, Buffer, StreamInfo^.NewSize, Y, I);
end;
LZ4F_CODEC:
begin
FillChar(LZ4FT, SizeOf(LZ4F_preferences_t), 0);
LZ4FT.compressionLevel := I;
LZ4FT.frameInfo.blockSizeID :=
LZ4F_blockSizeID_t(GetBits(StreamInfo^.Option, 12, 2) + 4);
LZ4FT.frameInfo.blockMode :=
LZ4F_blockMode_t(GetBits(StreamInfo^.Option, 14, 1));
Params := 'l' + I.ToString + ':' + 'b' +
(GetBits(StreamInfo^.Option, 12, 2) + 4).ToString + ':' + 'd' +
GetBits(StreamInfo^.Option, 14, 1).ToString;
Res1 := LZ4F_compressFrame(Buffer, Y, NewInput,
StreamInfo^.NewSize, LZ4FT);
StreamInfo^.NewSize, @LZ4FT);
end;
end;
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(LZ4Codecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
break;
end;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
@@ -261,6 +301,8 @@ begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, Res1));
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, (Res2 > 0) and
((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE));
if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE)
then
begin
@@ -270,12 +312,18 @@ begin
Result := True;
end;
end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
end;
end;
function LZ4Restore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
X: Integer;
Res1: Integer;
Res2: NativeUInt;
@@ -289,26 +337,42 @@ begin
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
case X of
LZ4_CODEC:
Res1 := LZ4_compress_default(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
begin
Params := '';
Res1 := LZ4_compress_default(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
end;
LZ4HC_CODEC:
Res1 := LZ4_compress_HC(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil),
GetBits(StreamInfo.Option, 5, 7));
begin
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString;
Res1 := LZ4_compress_HC(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil),
GetBits(StreamInfo.Option, 5, 7));
end;
LZ4F_CODEC:
begin
FillChar(LZ4FT, SizeOf(LZ4F_preferences_t), 0);
LZ4FT.compressionLevel := GetBits(StreamInfo.Option, 5, 7);
LZ4FT.frameInfo.blockSizeID :=
LZ4F_blockSizeID_t(GetBits(StreamInfo.Option, 12, 2) + 4);
LZ4FT.frameInfo.blockMode :=
LZ4F_blockMode_t(GetBits(StreamInfo.Option, 14, 1));
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + 'b' +
(GetBits(StreamInfo.Option, 12, 2) + 4).ToString + ':' + 'd' +
GetBits(StreamInfo.Option, 14, 1).ToString;
Res1 := LZ4F_compressFrame(Buffer,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil), Input,
StreamInfo.NewSize, LZ4FT);
StreamInfo.NewSize, @LZ4FT);
end;
end;
Funcs^.LogRestore(LZ4Codecs[GetBits(StreamInfo.Option, 0, 5)], PChar(Params),
StreamInfo.OldSize, StreamInfo.NewSize, Res1, True);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1,
Buffer + Res1, StreamInfo.OldSize);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 > 0 then
begin
Output(Instance, Buffer + Res1, StreamInfo.OldSize);

56
precompressor/PrecompLZO.pas
View File

@@ -186,7 +186,7 @@ var
LZOSI: TLZOSI;
SI: _StrInfo1;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@@ -216,9 +216,12 @@ begin
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(LZOCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
exit;
@@ -237,6 +240,8 @@ begin
SI.NewSize := LZOSI.DSize;
SI.Option := 0;
SI.Status := TStreamStatus.None;
Funcs^.LogScan1(LZOCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil);
Inc(Pos, LZOSI.CSize);
continue;
@@ -269,6 +274,8 @@ begin
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
Funcs^.LogScan2(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
@@ -277,6 +284,7 @@ function LZOProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
I: Integer;
X: Integer;
Res1: NativeUInt;
@@ -298,9 +306,13 @@ begin
LZO1X_CODEC:
case GetBits(StreamInfo^.Option, 12, 5) of
LZO1X_999:
if not lzo1x_999_compress_level(NewInput, StreamInfo^.NewSize,
Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, I) = 0 then
Res1 := 0;
begin
Params := 'l' + I.ToString + ':' + 'v' +
GetBits(StreamInfo^.Option, 12, 5).ToString;
if not lzo1x_999_compress_level(NewInput, StreamInfo^.NewSize,
Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, I) = 0 then
Res1 := 0;
end;
{ if not lzo1x_1_compress(NewInput, StreamInfo^.NewSize, Buffer,
@Res1, @WrkMem[Instance, 0]) = 0 then
Res1 := 0; }
@@ -308,17 +320,10 @@ begin
end;
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
break;
end;
case X of
LZO1X_CODEC:
if not GetBits(StreamInfo^.Option, 12, 5) in [0] then
break;
end;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
@@ -326,6 +331,8 @@ begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, Res1));
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, (Res2 > 0) and
((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE));
if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE)
then
begin
@@ -335,12 +342,18 @@ begin
Result := True;
end;
end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
end;
end;
function LZORestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
X: Integer;
Res1: NativeUInt;
Res2: NativeUInt;
@@ -355,17 +368,24 @@ begin
LZO1X_CODEC:
case GetBits(StreamInfo.Option, 12, 5) of
LZO1X_999:
if not lzo1x_999_compress_level(Input, StreamInfo.NewSize, Buffer,
@Res1, @WrkMem[Instance, 0], nil, 0, nil,
GetBits(StreamInfo.Option, 5, 7)) = 0 then
Res1 := 0;
begin
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' +
'v' + GetBits(StreamInfo.Option, 12, 5).ToString;
if not lzo1x_999_compress_level(Input, StreamInfo.NewSize, Buffer,
@Res1, @WrkMem[Instance, 0], nil, 0, nil,
GetBits(StreamInfo.Option, 5, 7)) = 0 then
Res1 := 0;
end;
end;
end;
Funcs^.LogRestore(LZOCodecs[GetBits(StreamInfo.Option, 0, 5)], PChar(Params),
StreamInfo.OldSize, StreamInfo.NewSize, Res1, True);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1,
Buffer + Res1, StreamInfo.OldSize);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 > 0 then
begin
Output(Instance, Buffer + Res1, StreamInfo.OldSize);

156
precompressor/PrecompMain.pas
View File

@@ -50,6 +50,17 @@ function PrecompAllocator(Instance: Integer; Size: Integer): Pointer cdecl;
function PrecompGetDepthInfo(Index: Integer): TDepthInfo cdecl;
function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer;
Count: Integer): Integer cdecl;
procedure PrecompLogScan1(Codec: PChar; Position: Int64;
InSize, OutSize: Integer)cdecl;
procedure PrecompLogScan2(Codec: PChar; InSize, OutSize: Integer)cdecl;
procedure PrecompLogProcess(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean)cdecl;
procedure PrecompLogRestore(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean)cdecl;
procedure PrecompLogPatch1(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
procedure PrecompLogPatch2(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer);
@@ -163,7 +174,7 @@ begin
S := ReplaceText(S, 'p', '%');
S := ReplaceText(S, '%', '%*' + CPUCount.ToString);
Options.Threads := Max(1, Round(ExpParse.Evaluate(S)));
Options.Depth := Succ(ArgParse.AsInteger('-d'));
Options.Depth := EnsureRange(Succ(ArgParse.AsInteger('-d')), 1, 10);
Options.LowMem := ArgParse.AsBoolean('-lm');
UseDB := ArgParse.AsBoolean('--dbase');
Options.DBaseFile := ArgParse.AsString('--dbase=');
@@ -174,10 +185,13 @@ begin
S := ArgParse.AsString('--diff=', 0, '5p');
S := ReplaceText(S, 'p', '%');
DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S));
VERBOSE := ArgParse.AsBoolean('--verbose');
finally
ArgParse.Free;
ExpParse.Free;
end;
if VERBOSE then
Options.Threads := 1;
end;
procedure Parse(ParamArg: TArray<string>; out Options: TDecodeOptions);
@@ -209,10 +223,13 @@ begin
Options.DedupSysMem := Max(0, Round(ExpParse.Evaluate(S)));
if B then
Options.DedupSysMem := -Options.DedupSysMem;
VERBOSE := ArgParse.AsBoolean('--verbose');
finally
ArgParse.Free;
ExpParse.Free;
end;
if VERBOSE then
Options.Threads := 1;
end;
function GetIndex(Scanned, Processed: TArray<Boolean>): Integer;
@@ -264,6 +281,8 @@ var
ThrIdx: TArray<Integer>;
WorkStream: TArray<TMemoryStream>;
Scanned1, Scanned2, Processed: TArray<Boolean>;
LogInt: Integer;
LogInt64: Int64;
procedure CodecInit(Count: Integer; Method: String);
var
@@ -323,7 +342,7 @@ var
begin
for I := Low(CurCodec) to High(CurCodec) do
begin
CurCodec[I] := X;
CurCodec[I] := 0;
CurDepth[I] := 0;
end;
for I := Low(Codecs) to High(Codecs) do
@@ -371,6 +390,98 @@ begin
end;
end;
procedure PrecompLogScan1(Codec: PChar; Position: Int64;
InSize, OutSize: Integer);
begin
if not VERBOSE then
exit;
with ComVars1[CurDepth[0]] do
begin
if (OutSize > 0) and (Position < DataStore.Size(0)) and
(MemOutput1[0].Position - CurPos1[0] = OutSize) then
WriteLn(ErrOutput, Format('[%d] Actual %s stream found at %s (%d >> %d)',
[CurDepth[0], Codec, (DataStore.Position(0) + Position).ToHexString,
InSize, OutSize]))
else
WriteLn(ErrOutput,
Format('[%d] Possible %s stream located at %s (%d >> %d)',
[CurDepth[0], Codec, (DataStore.Position(0) + Position).ToHexString,
InSize, OutSize]));
end;
end;
procedure PrecompLogScan2(Codec: PChar; InSize, OutSize: Integer);
begin
if not VERBOSE then
exit;
WriteLn(ErrOutput, Format('[%d] Confirmed %s stream at %s (%d >> %d)',
[CurDepth[0], Codec, LogInt64.ToHexString, InSize, OutSize]));
end;
procedure PrecompLogProcess(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean);
var
S: String;
begin
if not VERBOSE then
exit;
if Status then
S := '[%d] Processed %s stream at %s (%d >> %d >> %d)' +
IfThen(String(Method) <> '', ' using %s', '') + ' successfully'
else
S := '[%d] Processing %s stream at %s (%d >> %d >> %d)' +
IfThen(String(Method) <> '', ' using %s', '') + ' has failed';
WriteLn(ErrOutput, Format(S, [CurDepth[0], Codec, LogInt64.ToHexString,
OriginalSize, InSize, OutSize, Method]));
end;
procedure PrecompLogRestore(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean);
var
S: String;
begin
if not VERBOSE then
exit;
if Status then
S := '[%d] Restored %s stream at %s (%d >> %d >> %d)' +
IfThen(String(Method) <> '', ' using %s', '') + ' successfully'
else
S := '[%d] Restoring %s stream at %s (%d >> %d >> %d)' +
IfThen(String(Method) <> '', ' using %s', '') + ' has failed';
WriteLn(ErrOutput, Format(S, [CurDepth[0], Codec, LogInt64.ToHexString,
OriginalSize, InSize, OutSize, Method]));
end;
procedure PrecompLogPatch1(OldSize, NewSize, PatchSize: Integer;
Status: Boolean);
var
S: String;
begin
if not VERBOSE then
exit;
if Status then
S := '[%d] - Patched stream at %s (%d >> %d) [%d] successfully'
else
S := '[%d] - Patching stream at %s (%d >> %d) [%d] has failed';
WriteLn(ErrOutput, Format(S, [CurDepth[0], LogInt64.ToHexString, OldSize,
NewSize, PatchSize]));
end;
procedure PrecompLogPatch2(OldSize, NewSize, PatchSize: Integer;
Status: Boolean);
var
S: String;
begin
if not VERBOSE then
exit;
if Status then
S := '[%d] - Patched stream at %s (%d >> %d) [%d] successfully'
else
S := '[%d] - Patching stream at %s (%d >> %d) [%d] has failed';
WriteLn(ErrOutput, Format(S, [CurDepth[0], LogInt64.ToHexString, OldSize,
NewSize, PatchSize]));
end;
procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer);
begin
@@ -452,6 +563,7 @@ begin
SI1.Resource := Info^.Resource;
SI1.Thread := Instance;
SI1.Codec := LCodec;
SI1.Scan2 := False;
SI1.Option := LOption;
SI1.Checksum := Utils.Hash32(0, PByte(DataStore.Slot(Instance).Memory) +
SI1.ActualPosition, SI1.OldSize);
@@ -469,6 +581,7 @@ begin
SI2.NewSize := Info^.NewSize;
SI2.Resource := Info^.Resource;
SI2.Codec := LCodec;
SI2.Scan2 := True;
SI2.Option := LOption;
SI2.Status := Info^.Status;
if Assigned(DepthInfo) then
@@ -582,7 +695,7 @@ begin
I := InfoStore2[Index, ISIndex[Index].ToInteger].Get(SI2);
while I >= 0 do
begin
if InRange(SI2.Position, DataStore.Position(Index),
if SI2.Scan2 and InRange(SI2.Position, DataStore.Position(Index),
Pred(DataStore.Position(Index) + DataStore.Size(Index))) then
begin
CurPos1[Index] := MemOutput1[Index].Position;
@@ -596,6 +709,7 @@ begin
J := 0;
X := DataStore.ActualSize(Index) -
NativeInt(SI2.Position - DataStore.Position(Index));
LogInt64 := SI2.Position;
if (SI1.OldSize <= X) and Codecs[SI2.Codec].Scan2(Index, Depth,
PByte(DataStore.Slot(Index).Memory) +
NativeInt(SI2.Position - DataStore.Position(Index)), X, @SI1, @J,
@@ -617,6 +731,7 @@ begin
SI3.Resource := SI1.Resource;
SI3.Thread := Index;
SI3.Codec := SI2.Codec;
SI3.Scan2 := False;
SI3.Option := SI1.Option;
SI3.Status := SI1.Status;
SI3.Checksum :=
@@ -657,6 +772,7 @@ begin
SI1.Resource := SI2.Resource;
SI1.Option := SI2.Option;
SI1.Status := SI2.Status;
LogInt64 := DataStore.Position(0) + SI2.ActualPosition;
if UseDB and (SI2.Codec > 2) then
begin
DBBool := CheckDB(Database, SI2, DBTyp);
@@ -757,7 +873,15 @@ begin
begin
if InRange(Y, Low(InfoStore1), High(InfoStore1)) then
begin
if VERBOSE then
WriteLn(ErrOutput,
Format('[%d] Performing scan from block %s to %s (%d)',
[W, DataStore.Position(0).ToHexString,
(DataStore.Position(0) + Pred(DataStore.Size(0))).ToHexString,
DataStore.Size(0)]));
Scan1(Y, W);
if VERBOSE then
WriteLn(ErrOutput, '');
if W = 0 then
begin
Scanned1[Y] := True;
@@ -785,6 +909,12 @@ begin
end
else
Z := Y;
if VERBOSE and (InfoStore1[Z].Count > 0) then
WriteLn(ErrOutput,
Format('[%d] Processing streams on block %s to %s (%d)',
[W, DataStore.Position(0).ToHexString,
(DataStore.Position(0) + Pred(DataStore.Size(0))).ToHexString,
DataStore.Size(0)]));
X := AtomicIncrement(StrIdx[Z]);
while X < InfoStore1[Z].Count do
begin
@@ -803,6 +933,8 @@ begin
end;
X := AtomicIncrement(StrIdx[Z]);
end;
if VERBOSE and (InfoStore1[Z].Count > 0) then
WriteLn(ErrOutput, '');
if W = 0 then
begin
if Z < -1 then
@@ -1733,6 +1865,8 @@ var
UI32: UInt32;
I, J: Integer;
begin
if Depth = 0 then
LogInt64 := 0;
with ComVars2[Depth] do
begin
DecInput[Index] := Input;
@@ -1936,7 +2070,8 @@ begin
Stopwatch := TStopwatch.Create;
Stopwatch.Start;
ConTask.Perform(EncodeStats);
ConTask.Start;
if not VERBOSE then
ConTask.Start;
try
EncInit(Input, Output, @Options);
EncData(Input, Output, 0, 0);
@@ -1947,6 +2082,8 @@ begin
Stopwatch.Stop;
end;
end;
if VERBOSE then
EncodeStats;
ConTask.Wait;
ConTask.Free;
InternalSync.Leave;
@@ -1960,7 +2097,8 @@ begin
Stopwatch := TStopwatch.Create;
Stopwatch.Start;
ConTask.Perform(DecodeStats);
ConTask.Start;
if not VERBOSE then
ConTask.Start;
NStream := TArrayStream.Create;
try
DecInit(Input, Output, @Options);
@@ -1973,6 +2111,8 @@ begin
Stopwatch.Stop;
end;
end;
if VERBOSE then
DecodeStats;
ConTask.Wait;
ConTask.Free;
InternalSync.Leave;
@@ -2014,6 +2154,12 @@ PrecompFunctions.ExecStdio := @PrecompExecStdio;
PrecompFunctions.ExecStdioSync := @PrecompExecStdioSync;
PrecompFunctions.GetDepthCodec := @PrecompGetDepthCodec;
PrecompFunctions.ReadFuture := @PrecompReadFuture;
PrecompFunctions.LogScan1 := PrecompLogScan1;
PrecompFunctions.LogScan2 := PrecompLogScan2;
PrecompFunctions.LogProcess := PrecompLogProcess;
PrecompFunctions.LogRestore := PrecompLogRestore;
PrecompFunctions.LogPatch1 := PrecompLogPatch1;
PrecompFunctions.LogPatch2 := PrecompLogPatch2;
finalization

284
precompressor/PrecompOodle.pas
View File

@@ -6,7 +6,7 @@ uses
OodleDLL, XDeltaDLL,
Utils,
PrecompUtils,
System.SysUtils, System.Math;
System.SysUtils, System.Classes, System.Types, System.Math;
{ 8C 07 - 0:LZH
8C 00 - 1:LZHLW
@@ -40,11 +40,13 @@ const
LEVIATHAN_CODEC = 5;
const
O_COUNT = 0;
O_TRADEOFF = 256;
O_MAXSIZE = 16 * 1024 * 1024;
var
SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList;
OCount: Integer = O_COUNT;
OTradeOff: Integer = O_TRADEOFF;
CodecAvailable, CodecEnabled: TArray<Boolean>;
@@ -192,28 +194,23 @@ begin
case (Buff + 1)^ of
$06, $0A, $0C:
begin
if StreamInfo^.CSize + BlkSize + 2 <= Size then
if (StreamInfo^.CSize + BlkSize + 3 <= Size) and
((Buff + BlkSize + 2)^ in [$0C, $4C]) and
((Buff + BlkSize + 3)^ = (Buff + 1)^) then
begin
if (PWord(Buff + BlkSize + 2)^ = (((Buff + 1)^ shl 8) + $4C)) or
((First = True) and ((Buff + BlkSize + 2)^ in [$0C, $4C])) then
begin
Inc(StreamInfo^.CSize, BlkSize + 2);
Inc(StreamInfo^.DSize, BlkSize);
end;
Inc(StreamInfo^.CSize, BlkSize + 2);
Inc(StreamInfo^.DSize, BlkSize);
end
else if (First = False) and (StreamInfo^.CSize + 8 <= Size) then
begin
Inc(StreamInfo^.CSize, 8 + 2);
Inc(StreamInfo^.DSize, 8);
exit;
end
else
I := BlkSize + 2 - Size;
if StreamInfo^.CSize + I > Size then
begin
StreamInfo^.CSize := 0;
StreamInfo^.DSize := 0;
exit;
end;
Inc(StreamInfo^.CSize, Abs(I));
Inc(StreamInfo^.DSize, Abs(I) - 2);
Dec(MaxBlocks);
if I > 0 then
GetOodleSI(Buff + I, Size, StreamInfo, MaxBlocks, False);
GetOodleSI(Buff + BlkSize + 2, Size, StreamInfo, MaxBlocks, False);
end;
else
exit;
@@ -221,62 +218,149 @@ begin
end;
end;
{ procedure OodleDecompressCB(userdata: Pointer; rawBuf: PByte;
procedure OodleDecompressCB(userdata: Pointer; rawBuf: PByte;
rawLen: NativeUInt; compBuf: PByte; compBufferSize, rawDone,
compUsed: NativeUInt);
begin
end; }
begin
WriteLn(ErrOutput, rawDone);
end;
function CustomLZ_Decompress(src, dst: PByte; srcSize, dstCapacity: Integer;
Ident: Byte; var Res: Integer): Boolean;
function LocalLZ_Decompress(asrc, adst: PByte; asrcSize, adstCapacity: Integer;
aIdent: Byte; out Res: Integer): Integer;
const
BlkSize = 262144;
UpLen = 256;
DownLen = 16;
var
A, B, I, J, X: Integer;
Sizes: array [0 .. UpLen + DownLen - 1] of Integer;
A, B: Integer;
begin
B := IfThen(dstCapacity mod BlkSize = 0, Pred(dstCapacity div BlkSize),
dstCapacity div BlkSize) * BlkSize;
FillChar((dst + B)^, dstCapacity - B, Ident);
OodleLZ_Decompress(src, srcSize, dst, dstCapacity);
A := Pred(dstCapacity);
B := IfThen(adstCapacity mod BlkSize = 0, Pred(adstCapacity div BlkSize),
adstCapacity div BlkSize) * BlkSize;
FillChar((adst + B)^, adstCapacity - B, aIdent);
Res := OodleLZ_Decompress(asrc, asrcSize, adst, adstCapacity);
A := Pred(adstCapacity);
while A > B do
begin
if (dst + A)^ <> Ident then
if (adst + A)^ <> aIdent then
break;
Dec(A);
end;
Inc(A);
Result := A;
end;
function CustomLZ_Decompress0(src, dst: PByte; srcSize, dstCapacity: Integer;
var Res: Integer): Boolean;
type
T3Res = array [0 .. 2] of Integer;
procedure AddRes(const I: Integer; var Res: T3Res);
begin
Res[0] := Res[1];
Res[1] := Res[2];
Res[2] := I;
end;
const
MinSize = 64;
BlkSize = 262144;
Range = 262144;
function ValidSize(Res: T3Res): Boolean;
const
ThresSize = 32;
begin
Result := (Res[0] > 0) and (Res[0] < Res[1]) and
InRange(Res[0], Res[0], Res[2] + 32);
end;
var
LBuffer: array [0 .. BlkSize - 1] of Byte;
I, J, W, X, Y, Z: Integer;
LR1, LR2: T3Res;
begin
Result := False;
Y := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 0, Z),
LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 1, Z));
if Y > MinSize then
begin
W := IfThen(Y mod BlkSize = 0, Pred(Y div BlkSize), Y div BlkSize)
* BlkSize;
Move((dst + W)^, LBuffer[0], Y - W);
end;
if (Y = Z) and (Y = dstCapacity) then
begin
Res := Y;
I := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity - 1, 0, Z),
LocalLZ_Decompress(src, dst, srcSize, dstCapacity - 1, 1, Z));
if (Res <> I) and (Res <> Pred(I)) then
begin
Move(LBuffer[0], (dst + W)^, Res - W);
Result := True;
exit;
end;
end;
FillChar(LR1, SizeOf(T3Res), 0);
FillChar(LR2, SizeOf(T3Res), 0);
I := Y;
J := Min(dstCapacity, Y + Range);
while I < J do
begin
Y := Max(LocalLZ_Decompress(src, dst, srcSize, I, 0, Z),
LocalLZ_Decompress(src, dst, srcSize, I, 1, Z));
AddRes(Y, LR1);
AddRes(Z, LR2);
if (LR1[1] = LR2[1]) and ValidSize(LR1) then
begin
Res := LR1[1];
Move(LBuffer[0], (dst + W)^, Res - W);
Result := True;
break;
end;
if Y > MinSize then
begin
W := IfThen(Y mod BlkSize = 0, Pred(Y div BlkSize), Y div BlkSize)
* BlkSize;
Move((dst + W)^, LBuffer[0], Y - W);
end;
Inc(I);
end;
end;
function CustomLZ_DecompressN(src, dst: PByte; srcSize, dstCapacity: Integer;
var Res: TIntegerDynArray): Boolean;
const
BlkSize = 262144;
UpLen = 128;
DownLen = 16;
var
I, J, X, Y, Z: Integer;
Sizes: array [0 .. UpLen + DownLen - 1] of Integer;
begin
SetLength(Res, 0);
Y := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 0, Z),
LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 1, Z));
for I := Low(Sizes) to High(Sizes) do
Sizes[I] := -1;
J := Min(dstCapacity, A + UpLen);
I := Max(B, A - DownLen);
J := Min(dstCapacity, Y + UpLen);
I := Max(IfThen(dstCapacity mod BlkSize = 0, Pred(dstCapacity div BlkSize),
dstCapacity div BlkSize) * BlkSize, Y - DownLen);
X := J - I;
while (J > I) do
begin
FillChar((dst + I)^, X, Ident);
OodleLZ_Decompress(src, srcSize, dst, J);
A := Pred(J);
while A > B do
begin
if (dst + A)^ <> Ident then
break;
Dec(A);
end;
Inc(A);
Sizes[Length(Sizes) - (J - I)] := A;
Y := Max(LocalLZ_Decompress(src, dst, srcSize, J, 0, Z),
LocalLZ_Decompress(src, dst, srcSize, J, 1, Z));
Sizes[Length(Sizes) - (J - I)] := Z;
Dec(J);
end;
for I := Low(Sizes) to High(Sizes) do
begin
A := Sizes[I];
X := Sizes[I];
for J := Low(Sizes) to High(Sizes) do
begin
B := Sizes[J];
Y := Sizes[J];
if I <> J then
if A = B then
if X = Y then
begin
Sizes[I] := -1;
Sizes[J] := -1;
@@ -287,10 +371,11 @@ begin
if Sizes[I] > srcSize then
if OodleLZ_Decompress(src, srcSize, dst, Sizes[I]) = Sizes[I] then
begin
Res := Sizes[I];
Result := True;
break;
Insert(Sizes[I], Res, Length(Res));
if Length(Res) >= OCount then
break;
end;
Result := Length(Res) > 0;
end;
function GetOodleUS(Instance: Integer; Input: PByte; Pos: NativeInt;
@@ -300,22 +385,32 @@ const
MinSize = 64;
var
Buffer: PByte;
Res: Integer;
B: Boolean;
I: Integer;
ResultN: TIntegerDynArray;
SI: _StrInfo1;
begin
Result := 0;
if StreamInfo^.Codec = 3 then
exit;
{ if StreamInfo^.Codec = 3 then
exit; }
// StreamInfo^.DSize:=$8001;
Buffer := Funcs^.Allocator(Instance, StreamInfo^.DSize);
if CustomLZ_Decompress(Input + Pos, Buffer, StreamInfo^.CSize,
StreamInfo^.DSize, $32, Res) then
if OCount <= 0 then
B := CustomLZ_Decompress0(Input + Pos, Buffer, StreamInfo^.CSize,
StreamInfo^.DSize, Result)
else
begin
if (Res > MinSize) and (Res > StreamInfo^.CSize) then
B := CustomLZ_DecompressN(Input + Pos, Buffer, StreamInfo^.CSize,
StreamInfo^.DSize, ResultN);
if B then
Result := ResultN[0];
end;
If B then
if (Result > MinSize) and (Result > StreamInfo^.CSize) then
begin
Output(Instance, Buffer, Res);
Output(Instance, Buffer, Result);
SI.Position := Pos;
SI.OldSize := StreamInfo^.CSize;
SI.NewSize := Res;
SI.Option := 0;
SetBits(SI.Option, OTradeOff, 13, 11);
case StreamInfo^.Codec of
@@ -333,9 +428,25 @@ begin
SetBits(SI.Option, HYDRA_CODEC, 0, 5);
SetBits(SI.Option, Integer(StreamInfo^.HasCRC), 12, 1);
SI.Status := TStreamStatus.None;
Add(Instance, @SI, nil, nil);
if OCount <= 0 then
begin
SI.NewSize := Result;
Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil);
end
else
begin
if Length(ResultN) > 0 then
for I := Low(ResultN) to High(ResultN) do
begin
SI.NewSize := ResultN[I];
Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil);
end;
end;
end;
end;
end;
function GetOodleCodec(Index: Integer): Integer;
@@ -390,6 +501,8 @@ begin
for I := Low(SOList) to High(SOList) do
SOList[I][Y].Update
([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True);
if Funcs^.GetParam(Command, X, 'n') <> '' then
OCount := StrToInt(Funcs^.GetParam(Command, X, 'n'));
if Funcs^.GetParam(Command, X, 't') <> '' then
OTradeOff := StrToInt(Funcs^.GetParam(Command, X, 't'));
end;
@@ -453,7 +566,7 @@ var
SI: _StrInfo1;
OodleSI: TOodleSI;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@@ -476,7 +589,7 @@ begin
begin
if DI1.NewSize <= 0 then
begin
if not CustomLZ_Decompress(Input, Buffer, DI1.OldSize, Res, $32, Res)
if not CustomLZ_Decompress0(Input, Buffer, DI1.OldSize, Res, Res)
then
Res := 0;
end
@@ -503,9 +616,12 @@ begin
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
exit;
@@ -517,11 +633,13 @@ begin
begin
GetOodleSI(Input + Pos, SizeEx - Pos, @OodleSI);
if (OodleSI.CSize > 0) then
begin
if GetOodleUS(Instance, Input, Pos, @OodleSI, Output, Add, Funcs) > 0 then
begin
Inc(Pos, OodleSI.CSize);
continue;
end;
end;
Inc(Pos);
end;
end;
@@ -531,6 +649,9 @@ function OodleScan2(Instance, Depth: Integer; Input: Pointer; Size: cardinal;
Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
B: Boolean;
I: Integer;
ResultN: TIntegerDynArray;
X: Integer;
Res: Integer;
OodleSI: TOodleSI;
@@ -541,9 +662,7 @@ begin
begin
GetOodleSI(Input, Size, @OodleSI);
StreamInfo^.OldSize := OodleSI.CSize;
end
else
exit;
end;
if StreamInfo^.NewSize > 0 then
begin
Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize);
@@ -559,11 +678,13 @@ begin
then
begin
Buffer := Funcs^.Allocator(Instance, OodleSI.DSize);
if CustomLZ_Decompress(Input, Buffer, StreamInfo^.OldSize, OodleSI.DSize,
$32, Res) then
if CustomLZ_Decompress0(Input, Buffer, StreamInfo^.OldSize,
OodleSI.DSize, Res) then
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
Funcs^.LogScan2(OodleCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
@@ -573,6 +694,7 @@ function OodleProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
I: Integer;
X, Y: Integer;
Res1: Integer;
@@ -596,16 +718,16 @@ begin
SizeOf(TOodleLZ_CompressOptions));
COptions.sendQuantumCRCs := GetBits(StreamInfo^.Option, 12, 1) = 1;
COptions.spaceSpeedTradeoffBytes := GetBits(StreamInfo^.Option, 13, 11);
Params := 'l' + I.ToString + ':' + 'c' + GetBits(StreamInfo^.Option, 12, 1)
.ToString + ':' + 't' + GetBits(StreamInfo^.Option, 13, 11).ToString;
Res1 := OodleLZ_Compress(Y, NewInput, StreamInfo^.NewSize, Buffer, I,
@COptions);
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(OodleCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
break;
end;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
@@ -613,6 +735,8 @@ begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, Res1));
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, (Res2 > 0) and
((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE));
if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE)
then
begin
@@ -622,12 +746,18 @@ begin
Result := True;
end;
end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
end;
end;
function OodleRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
X, Y: Integer;
Res1: Integer;
Res2: NativeUInt;
@@ -644,13 +774,19 @@ begin
COptions, SizeOf(TOodleLZ_CompressOptions));
COptions.sendQuantumCRCs := GetBits(StreamInfo.Option, 12, 1) = 1;
COptions.spaceSpeedTradeoffBytes := GetBits(StreamInfo.Option, 13, 11);
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + 'c' +
GetBits(StreamInfo.Option, 12, 1).ToString + ':' + 't' +
GetBits(StreamInfo.Option, 13, 11).ToString;
Res1 := OodleLZ_Compress(Y, Input, StreamInfo.NewSize, Buffer,
GetBits(StreamInfo.Option, 5, 7), @COptions);
Funcs^.LogRestore(OodleCodecs[GetBits(StreamInfo.Option, 0, 5)],
PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize, Res1, True);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1,
Buffer + Res1, StreamInfo.OldSize);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 > 0 then
begin
Output(Instance, Buffer + Res1, StreamInfo.OldSize);

20
precompressor/PrecompSearch.pas
View File

@@ -23,9 +23,9 @@ const
type
PEntryStruct = ^TEntryStruct;
TEntryStruct = record
TEntryStruct = packed record
Position: Int64;
OldSize, NewSize: Integer;
OldSize, NewSize, DepthSize: Integer;
end;
PSearchStruct = ^TSearchStruct;
@@ -173,6 +173,7 @@ var
Pos, LSize: NativeInt;
SI: _StrInfo1;
DI: TDepthInfo;
DS: TPrecompStr;
SS: PSearchStruct;
CRC: Cardinal;
Checked: Boolean;
@@ -214,13 +215,14 @@ begin
SI.NewSize := SS^.EntryList[Y].NewSize;
SI.Option := 0;
SI.Resource := SS^.Resource;
if System.Pos(SPrecompSep2, SS^.Codec) > 0 then
if System.Pos(SPrecompSep2 + 'l', SS^.Codec) > 0 then
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DI.Codec := Funcs^.GetDepthCodec(PChar(SS^.Codec));
DI.OldSize := SI.NewSize;
DI.NewSize := SI.NewSize;
DS := Funcs^.GetDepthCodec(PChar(SS^.Codec));
Move(DS[0], DI.Codec, SizeOf(DI.Codec));
DI.OldSize := SS^.EntryList[Y].NewSize;
DI.NewSize := SS^.EntryList[Y].DepthSize;
Add(Instance, @SI, PChar(SS^.Codec), @DI);
end;
end;
@@ -291,7 +293,7 @@ begin
FStream.ReadBuffer(SearchStruct^.Hash, SearchStruct^.Hash.Size);
FStream.ReadBuffer(I32, I32.Size);
SetLength(HList, I32);
FStream.ReadBuffer(HList[0], I32 * sizeof(THashStruct));
FStream.ReadBuffer(HList[0], I32 * SizeOf(THashStruct));
FStream.ReadBuffer(I32, I32.Size);
SetLength(Bytes, I32);
FStream.ReadBuffer(Bytes[0], I32);
@@ -301,10 +303,10 @@ begin
K := Pred(Length(CodecSearch[J]));
SetLength(CodecSearch[J, K].HashList, Length(HList));
Move(HList[0], CodecSearch[J, K].HashList[0],
Length(HList) * sizeof(THashStruct));
Length(HList) * SizeOf(THashStruct));
SetLength(CodecSearch[J, K].EntryList, I32);
FStream.ReadBuffer(CodecSearch[J, K].EntryList[0],
I32 * sizeof(TEntryStruct));
I32 * SizeOf(TEntryStruct));
end;
end;
end;

160
precompressor/PrecompUtils.pas
View File

@@ -28,15 +28,16 @@ const
PRECOMP_FCOUNT = 128;
type
PPrecompCmd = ^TPrecompCmd;
TPrecompCmd = array [0 .. 63] of Char;
PPrecompStr = ^TPrecompStr;
TPrecompStr = array [0 .. 255] of Char;
TStreamStatus = (None, Invalid, Predicted);
PDepthInfo = ^TDepthInfo;
TDepthInfo = packed record
Codec: TPrecompCmd;
Codec: array [0 .. 31] of Char;
OldSize: Integer;
NewSize: Integer;
end;
@@ -51,6 +52,7 @@ type
ExtSize, ExtThread: Integer;
Resource: Integer;
Codec: Byte;
Scan2: Boolean;
Option: Integer;
Checksum: Cardinal;
Status: TStreamStatus;
@@ -64,6 +66,7 @@ type
OldSize, NewSize: Integer;
Resource: Integer;
Codec: Byte;
Scan2: Boolean;
Option: Integer;
Status: TStreamStatus;
DepthInfo: TDepthInfo;
@@ -116,9 +119,9 @@ type
_PrecompFuncs = record
Allocator: function(Index: Integer; Size: Integer): Pointer cdecl;
GetCodec: function(Cmd: PChar; Index: Integer; Param: Boolean)
: TPrecompCmd cdecl;
: TPrecompStr cdecl;
GetParam: function(Cmd: PChar; Index: Integer; Param: PChar)
: TPrecompCmd cdecl;
: TPrecompStr cdecl;
GetDepthInfo: function(Index: Integer): TDepthInfo cdecl;
Compress: function(Codec: PChar; InBuff: Pointer; InSize: Integer;
OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer)
@@ -158,7 +161,7 @@ type
FileWrite: function(Handle: THandle; Buffer: Pointer; Count: Integer)
: Integer cdecl;
IniRead: function(Section, Key, Default, FileName: PChar)
: TPrecompCmd cdecl;
: TPrecompStr cdecl;
// 25
IniWrite: procedure(Section, Key, Value, FileName: PChar)cdecl;
Exec: function(Executable, CommandLine, WorkDir: PChar): Boolean cdecl;
@@ -173,10 +176,21 @@ type
ExecStdioSync: function(Instance: Integer;
Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer;
Output: _ExecOutput): Boolean cdecl;
GetDepthCodec: function(Cmd: PChar): TPrecompCmd cdecl;
GetDepthCodec: function(Cmd: PChar): TPrecompStr cdecl;
ReadFuture: function(Index: Integer; Position: NativeInt; Buffer: Pointer;
Count: Integer): Integer cdecl;
Reserved: array [0 .. (PRECOMP_FCOUNT - 1) - 33] of Pointer;
LogScan1: procedure(Codec: PChar; Position: Int64;
InSize, OutSize: Integer)cdecl;
LogScan2: procedure(Codec: PChar; InSize, OutSize: Integer)cdecl; // 35
LogProcess: procedure(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean)cdecl;
LogRestore: procedure(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean)cdecl;
LogPatch1: procedure(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
LogPatch2: procedure(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
Reserved: array [0 .. (PRECOMP_FCOUNT - 1) - 39] of Pointer;
end;
_PrecompOutput = procedure(Instance: Integer; const Buffer: Pointer;
@@ -280,10 +294,10 @@ function RegisterResources(Cmd: String): Integer;
procedure FreeResources;
function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean)
: TPrecompCmd cdecl;
: TPrecompStr cdecl;
function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar)
: TPrecompCmd cdecl;
function PrecompGetDepthCodec(Cmd: PChar): TPrecompCmd cdecl;
: 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;
@@ -322,7 +336,7 @@ function PrecompFileRead(Handle: THandle; Buffer: Pointer; Count: Integer)
function PrecompFileWrite(Handle: THandle; Buffer: Pointer; Count: Integer)
: Integer cdecl;
function PrecompIniRead(Section, Key, Default, FileName: PChar)
: TPrecompCmd cdecl;
: TPrecompStr cdecl;
procedure PrecompIniWrite(Section, Key, Value, FileName: PChar)cdecl;
function PrecompExec(Executable, CommandLine, WorkDir: PChar): Boolean cdecl;
function PrecompExecStdin(Executable, CommandLine, WorkDir: PChar;
@@ -339,6 +353,7 @@ function PrecompExecStdioSync(Instance: Integer;
var
PrecompFunctions: _PrecompFuncs;
DIFF_TOLERANCE: Single = 0.05;
VERBOSE: Boolean = False;
EncodeSICmp: TEncodeSIComparer;
FutureSICmp: TFutureSIComparer;
StockMethods, ExternalMethods: TStringList;
@@ -503,7 +518,7 @@ begin
end;
function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean)
: TPrecompCmd;
: TPrecompStr;
var
List0, List1, List2: System.Types.TStringDynArray;
I: Integer;
@@ -532,7 +547,7 @@ begin
StringToWideChar(S, @Result, Length(Result));
end;
function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar): TPrecompCmd;
function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar): TPrecompStr;
var
List0, List1, List2: System.Types.TStringDynArray;
I: Integer;
@@ -573,7 +588,7 @@ begin
StringToWideChar(S, @Result, Length(Result));
end;
function PrecompGetDepthCodec(Cmd: PChar): TPrecompCmd cdecl;
function PrecompGetDepthCodec(Cmd: PChar): TPrecompStr cdecl;
var
List: System.Types.TStringDynArray;
I: Integer;
@@ -972,7 +987,7 @@ begin
Result := FileWrite(Handle, Buffer^, Count);
end;
function PrecompIniRead(Section, Key, Default, FileName: PChar): TPrecompCmd;
function PrecompIniRead(Section, Key, Default, FileName: PChar): TPrecompStr;
var
S: String;
begin
@@ -1006,15 +1021,18 @@ 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;
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := 0;
StartupInfo.hStdOutput := hstdoutw;
StartupInfo.hStdError := 0;
@@ -1026,18 +1044,24 @@ begin
if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hstdoutw);
while ReadFile(hstdoutr, Buffer, Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(Instance, @Buffer[0], BytesRead);
CloseHandle(hstdoutr);
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
CloseHandle(hstdoutr);
CloseHandle(hstdoutw);
CloseHandleEx(hstdoutr);
CloseHandleEx(hstdoutw);
RaiseLastOSError;
end;
end;
@@ -1056,6 +1080,7 @@ var
hstdoutr, hstdoutw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
LWorkDir: PChar;
begin
Result := True;
@@ -1065,7 +1090,8 @@ begin
SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESTDHANDLES;
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := hstdinr;
StartupInfo.hStdOutput := hstdoutw;
StartupInfo.hStdError := 0;
@@ -1077,24 +1103,30 @@ begin
if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hstdinr);
CloseHandle(hstdoutw);
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
while ReadFile(hstdoutr, Buffer[0], Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(Instance, @Buffer[0], BytesRead);
CloseHandle(hstdoutr);
Result := True;
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
CloseHandle(hstdinr);
CloseHandle(hstdinw);
CloseHandle(hstdoutr);
CloseHandle(hstdoutw);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdinw);
CloseHandleEx(hstdoutr);
CloseHandleEx(hstdoutw);
RaiseLastOSError;
end;
end;
@@ -1122,18 +1154,20 @@ var
hstdoutr, hstdoutw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
LWorkDir: PChar;
LTask: TTask;
LDone: Boolean;
begin
Result := False;
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;
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := hstdinr;
StartupInfo.hStdOutput := hstdoutw;
StartupInfo.hStdError := 0;
@@ -1145,27 +1179,37 @@ begin
if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hstdinr);
CloseHandle(hstdoutw);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdoutw);
LTask := TTask.Create(Instance, hstdoutr, NativeInt(@Output),
NativeInt(@LDone));
LTask.Perform(ExecReadTask);
LTask.Start;
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
LTask.Wait;
LTask.Free;
CloseHandle(hstdoutr);
Result := True;
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
CloseHandle(hstdinr);
CloseHandle(hstdinw);
CloseHandle(hstdoutr);
CloseHandle(hstdoutw);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdinw);
CloseHandleEx(hstdoutr);
CloseHandleEx(hstdoutw);
RaiseLastOSError;
end;
end;

105
precompressor/PrecompZLib.pas
View File

@@ -40,7 +40,6 @@ var
RefInst1, RefInst2: TArray<Pointer>;
RLevel: Integer = R_LEVEL;
CodecAvailable, CodecEnabled: TArray<Boolean>;
Storage: TArray<TMemoryStream>;
Scan2Pos: TArray<Integer>;
Scan2SI: TArray<PStrInfo2>;
@@ -57,11 +56,8 @@ begin
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
SOList[X, Y] := TSOList.Create([], TSOMethod.MTF);
SetLength(Storage, Count);
SetLength(Scan2Pos, Count);
SetLength(Scan2SI, Count);
for X := Low(Storage) to High(Storage) do
Storage[X] := TMemoryStream.Create;
for X := Low(CodecAvailable) to High(CodecAvailable) do
begin
CodecAvailable[X] := False;
@@ -91,8 +87,7 @@ begin
begin
CodecEnabled[REFLATE_CODEC] := True;
if Funcs^.GetParam(Command, X, 'l') <> '' then
for I := Low(SOList) to High(SOList) do
RLevel := StrToInt(Funcs^.GetParam(Command, X, 'l'));
RLevel := StrToInt(Funcs^.GetParam(Command, X, 'l'));
end
else if (CompareText(S, ZlibCodecs[PREFLATE_CODEC]) = 0) and PreflateDLL.DLLLoaded
then
@@ -159,8 +154,6 @@ begin
for X := Low(SOList) to High(SOList) do
for Y := Low(SOList[X]) to High(SOList[X]) do
SOList[X, Y].Free;
for X := Low(Storage) to High(Storage) do
Storage[X].Free;
if CodecAvailable[ZLIB_CODEC] then
begin
for W := Low(ZStream1) to High(ZStream1) do
@@ -248,7 +241,7 @@ var
ScanBytes: Integer;
SI: _StrInfo1;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
LastIn, LastOut: cardinal;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
@@ -368,11 +361,16 @@ begin
SetBits(SI.Option, I, 0, 5);
if CodecEnabled[I] then
begin
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
if Assigned(Add) then
Add(Instance, @SI, DI1.Codec, @DI2)
begin
Funcs^.LogScan1(ZlibCodecs[GetBits(SI.Option, 0, 5)],
SI.Position, SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end
else
begin
Scan2Pos[Instance] := SI.Position;
@@ -414,7 +412,11 @@ begin
ZlibScan1(Instance, Depth, Input, Size, Size, Output, nil, Funcs);
Result := Scan2SI[Instance]^.OldSize > 0;
if Result then
begin
Offset^ := Scan2Pos[Instance];
Funcs^.LogScan2(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
end;
end;
function ZlibProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
@@ -439,6 +441,7 @@ function ZlibProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
var
Buffer, Ptr: PByte;
Params: String;
Res1, Res2: Integer;
L, M: Integer;
I, J: Integer;
@@ -478,6 +481,8 @@ begin
break; }
end;
end;
Params := 'l' + I.ToString + ':' + 'w' +
(GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
ZStream := @ZStream1[Instance, L, M,
GetBits(StreamInfo^.Option, 12, 3)];
ZStream^.next_in := NewInput;
@@ -496,6 +501,9 @@ begin
if not Verified then
break;
until (ZStream^.avail_in = 0) and (ZStream^.avail_out > 0);
Funcs^.LogProcess(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize,
ZStream^.total_out, Verified and (Res1 = Z_STREAM_END));
if Verified and (Res1 = Z_STREAM_END) then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
@@ -523,7 +531,7 @@ begin
REFLATE_CODEC:
begin
Buffer := Funcs^.Allocator(Instance, R_WORKMEM * 2);
Storage[Instance].Position := 0;
J := 0;
HR := RefInst1[Instance];
if StreamInfo^.Status = TStreamStatus.Predicted then
L := GetBits(StreamInfo^.Option, 5, 7)
@@ -534,6 +542,8 @@ begin
L := EnsureRange(L, 1, 9);
M := 0;
I := 0;
Params := 'l' + L.ToString + ':' + 'w' +
(GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
raw2hif_Init(HR, L);
while True do
begin
@@ -542,7 +552,7 @@ begin
begin
Res2 := raw2hif_getoutlen(HR);
Output(Instance, Buffer, Res2);
Storage[Instance].WriteBuffer(Buffer^, Res2);
Inc(J, Res2);
raw2hif_addbuf(HR, Buffer, R_WORKMEM);
end;
if (Res1 = 3) or (Res1 = 0) then
@@ -560,46 +570,13 @@ begin
Inc(I, Res2);
end;
end;
Funcs^.LogProcess(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize + J,
StreamInfo^.OldSize, M = StreamInfo^.NewSize);
if M = StreamInfo^.NewSize then
begin
{ HR := RefInst2[Instance];
I := 0;
J := 0;
M := 0;
CRC := 0;
M := Storage[Instance].Position;
Ptr := Storage[Instance].Memory;
hif2raw_Init(HR, L);
while True do
begin
Res1 := hif2raw_Loop(HR);
if (Res1 in [0, 2]) or (Res1 > 3) then
begin
Res2 := hif2raw_getoutlen(HR);
if Res2 > 0 then
CRC := Hash32(CRC, Buffer, Res2);
hif2raw_addbuf(HR, Buffer, R_WORKMEM);
if Res1 = 0 then
break;
end;
if Res1 = 1 then
begin
Res2 := Min(M - J, R_WORKMEM);
hif2raw_addbuf(HR, Ptr + J, Res2);
Inc(J, Res2);
end;
if Res1 = 3 then
begin
Res2 := Min(StreamInfo^.NewSize - I, R_WORKMEM);
hif2raw_addbuf(HR, PByte(NewInput) + I, Res2);
Inc(I, Res2);
end;
end;
if CRC = Hash32(0, OldInput, StreamInfo^.OldSize) then
begin }
SetBits(StreamInfo^.Option, L, 5, 7);
Result := True;
// end;
end;
end;
PREFLATE_CODEC:
@@ -607,24 +584,32 @@ begin
Res1 := StreamInfo^.NewSize;
Res2 := P_HIFSIZE;
Buffer := Funcs^.Allocator(Instance, Res2);
Params := 'w' + (GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
if preflate_decode(OldInput, StreamInfo^.OldSize, NewInput, @Res1,
Buffer, @Res2) then
begin
Output(Instance, Buffer, Res2);
Result := True;
end;
Funcs^.LogProcess(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize + Res2,
StreamInfo^.OldSize, Result);
end;
GRITTIBANZLI_CODEC:
begin
Res1 := StreamInfo^.NewSize;
Res2 := G_HIFSIZE;
Buffer := Funcs^.Allocator(Instance, Res2);
Params := 'w' + (GetBits(StreamInfo^.Option, 12, 3) + 8).ToString;
if Grittibanzli(OldInput, StreamInfo^.OldSize, NewInput, @Res1, Buffer,
@Res2) then
begin
Output(Instance, Buffer, Res2);
Result := True;
end;
Funcs^.LogProcess(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize + Res2,
StreamInfo^.OldSize, Result);
end;
end;
end;
@@ -633,6 +618,7 @@ function ZlibRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
Res1, Res2: Integer;
L, M: Integer;
I, J: Integer;
@@ -650,6 +636,8 @@ begin
Buffer := Funcs^.Allocator(Instance, Z_WORKMEM);
L := GetBits(StreamInfo.Option, 5, 7) div 10;
M := GetBits(StreamInfo.Option, 5, 7) mod 10;
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + 'w' +
(GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
ZStream := @ZStream1[Instance, L, M, GetBits(StreamInfo.Option, 12, 3)];
ZStream^.next_in := Input;
ZStream^.avail_in := StreamInfo.NewSize;
@@ -664,6 +652,9 @@ begin
Res2 := Z_WORKMEM - ZStream^.avail_out;
Output(Instance, Buffer, Res2);
until (ZStream^.avail_in = 0) and (ZStream^.avail_out > 0);
Funcs^.LogRestore(ZlibCodecs[GetBits(StreamInfo.Option, 0, 5)],
PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize,
ZStream^.total_out, True);
Result := True;
end;
REFLATE_CODEC:
@@ -672,6 +663,9 @@ begin
HR := RefInst2[Instance];
I := 0;
J := 0;
M := 0;
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + 'w' +
(GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
hif2raw_Init(HR, GetBits(StreamInfo.Option, 5, 7));
while True do
begin
@@ -679,6 +673,7 @@ begin
if (Res1 in [0, 2]) or (Res1 > 3) then
begin
Res2 := hif2raw_getoutlen(HR);
Inc(M, Res2);
Output(Instance, Buffer, Res2);
hif2raw_addbuf(HR, Buffer, R_WORKMEM);
if Res1 = 0 then
@@ -697,29 +692,39 @@ begin
Inc(I, Res2);
end;
end;
Result := True;
Result := StreamInfo.OldSize = M;
Funcs^.LogRestore(ZlibCodecs[GetBits(StreamInfo.Option, 0, 5)],
PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize + J, M, Result);
end;
PREFLATE_CODEC:
begin
Res1 := StreamInfo.OldSize;
Buffer := Funcs^.Allocator(Instance, Res1);
Params := 'w' + (GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
if preflate_reencode(Input, StreamInfo.NewSize, InputExt,
StreamInfo.ExtSize, Buffer, @Res1) then
begin
Output(Instance, Buffer, Res1);
Result := True;
end;
Funcs^.LogRestore(ZlibCodecs[GetBits(StreamInfo.Option, 0, 5)],
PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize +
StreamInfo.ExtSize, Res1, Result);
end;
GRITTIBANZLI_CODEC:
begin
Res1 := StreamInfo.OldSize;
Buffer := Funcs^.Allocator(Instance, Res1);
Params := 'w' + (GetBits(StreamInfo.Option, 12, 3) + 8).ToString;
if Ungrittibanzli(Input, StreamInfo.NewSize, InputExt,
StreamInfo.ExtSize, Buffer, @Res1) then
begin
Output(Instance, Buffer, Res1);
Result := True;
end;
Funcs^.LogRestore(ZlibCodecs[GetBits(StreamInfo.Option, 0, 5)],
PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize +
StreamInfo.ExtSize, Res1, Result);
end;
end;
end;

51
precompressor/PrecompZSTD.pas
View File

@@ -18,6 +18,9 @@ const
CODEC_COUNT = 1;
ZSTD_CODEC = 0;
const
Z_MAXSIZE = 16 * 1024 * 1024;
var
SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList;
cctx, dctx: array of Pointer;
@@ -127,7 +130,7 @@ var
X, Y, Z: Integer;
SI: _StrInfo1;
DI1, DI2: TDepthInfo;
DS: TPrecompCmd;
DS: TPrecompStr;
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@@ -140,7 +143,7 @@ begin
exit;
Y := ZSTD_findDecompressedSize(Input, SizeEx);
if Y <= 0 then
exit;
Y := Z_MAXSIZE;
Buffer := Funcs^.Allocator(Instance, Y);
case X of
ZSTD_CODEC:
@@ -158,9 +161,12 @@ begin
SI.Status := TStreamStatus.Predicted
else
SI.Status := TStreamStatus.None;
DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec);
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(ZSTDCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
exit;
@@ -177,10 +183,7 @@ begin
begin
Z := ZSTD_findDecompressedSize(Input + Pos, X);
if Z <= 0 then
begin
Inc(Pos);
continue;
end;
Z := Z_MAXSIZE;
Buffer := Funcs^.Allocator(Instance, Z);
Y := ZSTD_decompressDCtx(dctx[Instance], Buffer, Z, Input + Pos, X);
// Y := ZSTD_decompress_usingDDict(dctx[Instance], Buffer, Z, Input + Pos, X, ddict);
@@ -192,6 +195,8 @@ begin
SI.NewSize := Y;
SI.Option := 0;
SI.Status := TStreamStatus.None;
Funcs^.LogScan1(ZSTDCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil);
Inc(Pos, SI.OldSize);
continue;
@@ -219,7 +224,7 @@ begin
if StreamInfo^.NewSize <= 0 then
StreamInfo^.NewSize := ZSTD_findDecompressedSize(Input, Size);
if StreamInfo^.NewSize <= 0 then
exit;
StreamInfo^.NewSize := Z_MAXSIZE;
Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize);
case X of
ZSTD_CODEC:
@@ -230,6 +235,8 @@ begin
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
Funcs^.LogScan2(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
end;
end;
@@ -238,6 +245,7 @@ function ZSTDProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
I: Integer;
X: Integer;
Res1: Integer;
@@ -259,8 +267,11 @@ begin
continue;
case X of
ZSTD_CODEC:
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer, StreamInfo^.NewSize,
NewInput, StreamInfo^.NewSize, I);
begin
Params := 'l' + I.ToString;
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer, StreamInfo^.NewSize,
NewInput, StreamInfo^.NewSize, I);
end;
{ Res1 := ZSTD_compress_usingCDict(cctx[Instance], Buffer,
StreamInfo^.NewSize, NewInput, StreamInfo^.NewSize, cdict); }
{ begin
@@ -288,19 +299,21 @@ begin
end;
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize);
Funcs^.LogProcess(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
break;
end;
end;
if Res1 < 0 then
exit;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, Res1));
Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, (Res2 > 0) and
((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE));
if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE)
then
begin
@@ -310,12 +323,18 @@ begin
Result := True;
end;
end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
end;
end;
function ZSTDRestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var
Buffer: PByte;
Params: String;
X: Integer;
Res1: Integer;
Res2: NativeUInt;
@@ -325,6 +344,7 @@ begin
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Buffer := Funcs^.Allocator(Instance, StreamInfo.NewSize);
Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString;
case X of
ZSTD_CODEC:
Res1 := ZSTD_compressCCtx(cctx[Instance], Buffer, StreamInfo.NewSize,
@@ -332,11 +352,14 @@ begin
{ Res1 := ZSTD_compress_usingCDict(cctx[Instance], Buffer,
StreamInfo.NewSize, Input, StreamInfo.NewSize, cdict); }
end;
Funcs^.LogRestore(ZSTDCodecs[GetBits(StreamInfo.Option, 0, 5)], PChar(Params),
StreamInfo.OldSize, StreamInfo.NewSize, Res1, True);
if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1,
Buffer + Res1, StreamInfo.OldSize);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 > 0 then
begin
Output(Instance, Buffer + Res1, StreamInfo.OldSize);