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

update to 0.6.0

Browse Source 
major update
This commit is contained in:
Razor12911
2022-07-05 00:36:34 +02:00
parent 8acdee7e3b
commit 762160b0c9
24 changed files with 2633 additions and 685 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
precompressor/PrecompCrypto.pas
View File

@@ -91,7 +91,7 @@ begin
DI2.OldSize := SI.NewSize;
DI2.NewSize := SI.NewSize;
Funcs^.LogScan1(CryptoCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
SI.OldSize, -1);
Add(Instance, @SI, DI1.Codec, @DI2);
end;
end;
@@ -108,10 +108,10 @@ begin
exit;
if (Res > 0) and (StreamInfo^.OldSize > 0) then
begin
StreamInfo^.NewSize := StreamInfo^.OldSize;
Output(Instance, Input, StreamInfo^.OldSize);
StreamInfo^.NewSize := StreamInfo^.OldSize;
Funcs^.LogScan2(CryptoCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
StreamInfo^.OldSize, -1);
Result := True;
end;
end;
@@ -143,7 +143,7 @@ begin
end;
Result := True;
Funcs^.LogProcess(CryptoCodecs[GetBits(StreamInfo^.Option, 0, 5)], nil,
StreamInfo^.OldSize, StreamInfo^.NewSize, StreamInfo^.OldSize, Result);
StreamInfo^.OldSize, -1, -1, Result);
end;
end;
@@ -175,7 +175,7 @@ begin
Output(Instance, Input, StreamInfo.OldSize);
Result := True;
Funcs^.LogRestore(CryptoCodecs[GetBits(StreamInfo.Option, 0, 5)], nil,
StreamInfo.OldSize, StreamInfo.NewSize, StreamInfo.OldSize, Result);
StreamInfo.OldSize, -1, -1, Result);
end;
end;

2
precompressor/PrecompEXE.pas
View File

@@ -589,7 +589,7 @@ begin
StreamInfo^.OldSize);
Funcs^.LogProcess(PChar(Codec.Names[X]), nil, StreamInfo^.OldSize,
StreamInfo^.NewSize, Res1, Result);
if Result = False then
if (Result = False) and (DIFF_TOLERANCE > 0) then
begin
Buffer := Funcs^.Allocator(Instance,
Res1 + Max(StreamInfo^.OldSize, Res1));

29
precompressor/PrecompLZ4.pas
View File

@@ -24,12 +24,14 @@ const
L_MAXSIZE = 16 * 1024 * 1024;
L_BLOCKSIZE = 0;
L_BLOCKDEPENDENCY = 0;
L_ACCELERATION = 1;
var
SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList;
CodecAvailable, CodecEnabled: TArray<Boolean>;
LBlockSize: Integer = L_BLOCKSIZE;
LBlockDependency: Integer = L_BLOCKDEPENDENCY;
LAcceleration: Integer = L_ACCELERATION;
function LZ4Init(Command: PChar; Count: Integer; Funcs: PPrecompFuncs): Boolean;
var
@@ -57,6 +59,8 @@ begin
if (CompareText(S, LZ4Codecs[LZ4_CODEC]) = 0) and LZ4DLL.DLLLoaded then
begin
CodecEnabled[LZ4_CODEC] := True;
if Funcs^.GetParam(Command, X, 'a') <> '' then
LAcceleration := StrToInt(Funcs^.GetParam(Command, X, 'a'));
end
else if (CompareText(S, LZ4Codecs[LZ4HC_CODEC]) = 0) and LZ4DLL.DLLLoaded
then
@@ -86,7 +90,7 @@ begin
if SOList[X, LZ4_CODEC].Count = 0 then
SOList[X, LZ4_CODEC].Update([1]);
SetLength(Options, 0);
for I := 3 to 12 do
for I := 2 to 12 do
Insert(I, Options, Length(Options));
for X := Low(SOList) to High(SOList) do
if SOList[X, LZ4HC_CODEC].Count = 0 then
@@ -118,6 +122,7 @@ begin
Option^ := 0;
SetBits(Option^, LBlockSize, 12, 2);
SetBits(Option^, LBlockDependency, 14, 1);
SetBits(Option^, LAcceleration, 15, 7);
I := 0;
while Funcs^.GetCodec(Command, I, False) <> '' do
begin
@@ -125,6 +130,8 @@ begin
if (CompareText(S, LZ4Codecs[LZ4_CODEC]) = 0) and LZ4DLL.DLLLoaded then
begin
SetBits(Option^, LZ4_CODEC, 0, 5);
if Funcs^.GetParam(Command, I, 'a') <> '' then
SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'a')), 15, 7);
Result := True;
end
else if (CompareText(S, LZ4Codecs[LZ4HC_CODEC]) = 0) and LZ4DLL.DLLLoaded
@@ -188,6 +195,7 @@ begin
SetBits(SI.Option, X, 0, 5);
SetBits(SI.Option, LBlockSize, 12, 2);
SetBits(SI.Option, LBlockDependency, 14, 1);
SetBits(SI.Option, LAcceleration, 15, 7);
if System.Pos(SPrecompSep2, DI1.Codec) > 0 then
SI.Status := TStreamStatus.Predicted
else
@@ -230,8 +238,8 @@ begin
end;
if Res > StreamInfo^.OldSize then
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
StreamInfo^.NewSize := Res;
Funcs^.LogScan2(LZ4Codecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
@@ -261,12 +269,13 @@ begin
if StreamInfo^.Status = TStreamStatus.Predicted then
if GetBits(StreamInfo^.Option, 5, 7) <> I then
continue;
Params := '';
case X of
LZ4_CODEC:
begin
Params := '';
Res1 := LZ4_compress_default(NewInput, Buffer,
StreamInfo^.NewSize, Y);
Params := 'a' + GetBits(StreamInfo^.Option, 15, 7).ToString;
Res1 := LZ4_compress_fast(NewInput, Buffer, StreamInfo^.NewSize, Y,
GetBits(StreamInfo^.Option, 15, 7));
end;
LZ4HC_CODEC:
begin
@@ -296,7 +305,7 @@ begin
break;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
(SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
@@ -332,14 +341,16 @@ begin
X := GetBits(StreamInfo.Option, 0, 5);
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Params := '';
Buffer := Funcs^.Allocator(Instance,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
case X of
LZ4_CODEC:
begin
Params := '';
Res1 := LZ4_compress_default(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
Params := 'a' + GetBits(StreamInfo.Option, 15, 7).ToString;
Res1 := LZ4_compress_fast(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil),
GetBits(StreamInfo.Option, 15, 7));
end;
LZ4HC_CODEC:
begin

6
precompressor/PrecompLZO.pas
View File

@@ -272,8 +272,8 @@ begin
end;
if Res > StreamInfo^.OldSize then
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
StreamInfo^.NewSize := Res;
Funcs^.LogScan2(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
@@ -301,6 +301,7 @@ begin
if StreamInfo^.Status = TStreamStatus.Predicted then
if GetBits(StreamInfo^.Option, 5, 7) <> I then
continue;
Params := '';
Res1 := StreamInfo^.NewSize;
case X of
LZO1X_CODEC:
@@ -326,7 +327,7 @@ begin
break;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
(SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
@@ -361,6 +362,7 @@ begin
X := GetBits(StreamInfo.Option, 0, 5);
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Params := '';
Buffer := Funcs^.Allocator(Instance, StreamInfo.NewSize);
Res1 := StreamInfo.NewSize;
case X of

606
precompressor/PrecompMain.pas
View File

@@ -7,7 +7,7 @@ interface
uses
Threading, Utils, SynCommons, ParseClass, ParseExpr,
PrecompUtils, PrecompCrypto, PrecompZLib, PrecompLZ4, PrecompLZO, PrecompZSTD,
PrecompOodle, PrecompINI, PrecompSearch, PrecompDLL, PrecompEXE,
PrecompOodle, PrecompMedia, PrecompINI, 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,
@@ -24,8 +24,7 @@ type
ChunkSize, Threads: Integer;
Depth: Integer;
LowMem: Boolean;
DBaseFile: String;
DedupFile: String;
DBaseFile, ExtractDir: String;
end;
PDecodeOptions = ^TDecodeOptions;
@@ -34,7 +33,6 @@ type
Method: String;
ChunkCount, Threads: Integer;
Depth: Integer;
DedupFile: String;
DedupSysMem, DedupGPUMem: Int64;
end;
@@ -53,10 +51,10 @@ function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer;
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 PrecompLogProcess(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean)cdecl;
procedure PrecompLogRestore(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean)cdecl;
procedure PrecompLogPatch1(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
procedure PrecompLogPatch2(OldSize, NewSize, PatchSize: Integer;
@@ -101,10 +99,11 @@ var
IntArray: array [0 .. 1] of Int64;
Codecs: array of TPrecompressor;
DBFile: String = '';
ExtDir: String = '';
UseDB: Boolean = False;
DupFile: String = '';
StoreDD: Boolean = False;
DupGUID: TGUID;
VERBOSE: Boolean = False;
EXTRACT: Boolean = False;
DupSysMem: Int64 = 0;
EncInfo: TEncInfo;
ConTask: TTask;
@@ -131,11 +130,14 @@ begin
WriteLn(ErrOutput, '');
WriteLn(ErrOutput, 'Advanced parameters:');
WriteLn(ErrOutput,
' --dbase=# - use database (#=filename to save db, optional)');
' --dbase=# - use database (#=filename to save db, optional)');
WriteLn(ErrOutput,
' --dedup=# - use stream deduplication (#=filename to save db, optional)');
' --dedup=# - use stream deduplication (#=filename to save db, optional)');
WriteLn(ErrOutput,
' --mem=# - deduplication ram usage limit (#=size) [75p]');
' --mem=# - deduplication ram usage limit (#=size) [75p]');
WriteLn(ErrOutput,
' --diff=# - set xdelta threshold to accept streams [5p]');
WriteLn(ErrOutput, ' --extract=# - extract streams to directory path');
WriteLn(ErrOutput, '');
end;
@@ -182,16 +184,18 @@ begin
if Options.DBaseFile <> '' then
UseDB := True;
StoreDD := ArgParse.AsBoolean('--dedup');
Options.DedupFile := ArgParse.AsString('--dedup=');
S := ArgParse.AsString('--diff=', 0, '5p');
S := ReplaceText(S, 'p', '%');
DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S));
VERBOSE := ArgParse.AsBoolean('--verbose');
Options.ExtractDir := ArgParse.AsString('--extract=');
if Options.ExtractDir <> '' then
EXTRACT := DirectoryExists(Options.ExtractDir);
finally
ArgParse.Free;
ExpParse.Free;
end;
if VERBOSE then
if VERBOSE or EXTRACT then
Options.Threads := 1;
end;
@@ -210,7 +214,6 @@ begin
S := ReplaceText(S, 'p', '%');
S := ReplaceText(S, '%', '%*' + CPUCount.ToString);
Options.Threads := Max(1, Round(ExpParse.Evaluate(S)));
Options.DedupFile := ArgParse.AsString('--dedup=');
S := ArgParse.AsString('--mem=', 0, '75p');
S := ReplaceText(S, 'KB', '* 1024^1');
S := ReplaceText(S, 'MB', '* 1024^2');
@@ -267,14 +270,13 @@ type
StrIdx: TArray<Integer>;
end;
TDupRec = record
Dict: TSynDictionary;
Index: Integer;
end;
var
Database: TSynDictionary;
Duplicates1: array [0 .. 1] of TDupRec;
DBInfo: TArray<TArray<TDatabase>>;
DBCount: TArray<Integer>;
DDInfo: TArray<TArray<TDuplicate1>>;
DDCount1: TArray<Integer>;
DDList1: TArray<Int64>;
DDIndex: Integer;
ComVars1: TArray<TCommonVarsEnc>;
Tasks: TArray<TTask>;
CurCodec: TArray<Byte>;
@@ -285,6 +287,7 @@ var
Scanned1, Scanned2, Processed: TArray<Boolean>;
LogInt: Integer;
LogInt64: Int64;
LogPtr: Pointer;
procedure CodecInit(Count: Integer; Method: String);
var
@@ -303,6 +306,7 @@ begin
Insert(PrecompLZO.Codec, Codecs, Length(Codecs));
Insert(PrecompZSTD.Codec, Codecs, Length(Codecs));
Insert(PrecompOodle.Codec, Codecs, Length(Codecs));
Insert(PrecompMedia.Codec, Codecs, Length(Codecs));
for X := Low(Codecs) to High(Codecs) do
for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do
Insert(Codecs[X].Names[Y], List, Length(List));
@@ -394,64 +398,101 @@ end;
procedure PrecompLogScan1(Codec: PChar; Position: Int64;
InSize, OutSize: Integer);
var
S: String;
begin
if not VERBOSE then
exit;
with ComVars1[CurDepth[0]] do
begin
if OutSize < 0 then
S := '(%d)'
else
S := '(%d >> %d)';
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)',
WriteLn(ErrOutput, Format('[%d] Actual %s stream found at %s ' + S,
[CurDepth[0], Codec, (DataStore.Position(0) + Position).ToHexString,
InSize, OutSize]))
else
WriteLn(ErrOutput,
Format('[%d] Possible %s stream located at %s (%d >> %d)',
WriteLn(ErrOutput, Format('[%d] Possible %s stream located at %s ' + S,
[CurDepth[0], Codec, (DataStore.Position(0) + Position).ToHexString,
InSize, OutSize]));
end;
end;
procedure PrecompLogScan2(Codec: PChar; InSize, OutSize: Integer);
var
S: String;
begin
if not VERBOSE then
exit;
WriteLn(ErrOutput, Format('[%d] Confirmed %s stream at %s (%d >> %d)',
if OutSize < 0 then
S := '(%d)'
else
S := '(%d >> %d)';
WriteLn(ErrOutput, Format('[%d] Confirmed %s stream at %s ' + S,
[CurDepth[0], Codec, LogInt64.ToHexString, InSize, OutSize]));
end;
procedure PrecompLogProcess(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean);
procedure PrecompLogProcess(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean);
var
S: String;
S1, S2: 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]));
if VERBOSE then
begin
if Size2 < 0 then
S1 := '(%d)'
else if Size3 < 0 then
S1 := '(%d >> %d)'
else
S1 := '(%d >> %d >> %d)';
if Status then
S2 := '[%d] Processed %s stream at %s ' + S1 +
IfThen(String(Method) <> '', ' using ' + String(Method), '') +
' successfully'
else
S2 := '[%d] Processing %s stream at %s ' + S1 +
IfThen(String(Method) <> '', ' using ' + String(Method), '') +
' has failed';
WriteLn(ErrOutput, Format(S2, [CurDepth[0], Codec, LogInt64.ToHexString,
Size1, Size2, Size3]));
end;
if EXTRACT and (CurDepth[0] = 0) then
begin
S1 := '%s_%s.raw';
with TFileStream.Create(ExtDir + Format(S1, [LogInt64.ToHexString, Codec]),
fmCreate) do
try
WriteBuffer(LogPtr^, Size1);
finally
Free;
end;
end;
end;
procedure PrecompLogRestore(Codec, Method: PChar;
OriginalSize, InSize, OutSize: Integer; Status: Boolean);
procedure PrecompLogRestore(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean);
var
S: String;
S1, S2: 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'
if Size2 < 0 then
S1 := '(%d)'
else if Size3 < 0 then
S1 := '(%d >> %d)'
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]));
S1 := '(%d >> %d >> %d)';
if Status then
S2 := '[%d] Restored %s stream at %s ' + S1 + IfThen(String(Method) <> '',
' using ' + String(Method), '') + ' successfully'
else
S2 := '[%d] Restoring %s stream at %s ' + S1 + IfThen(String(Method) <> '',
' using ' + String(Method), '') + ' has failed';
WriteLn(ErrOutput, Format(S2, [CurDepth[0], Codec, LogInt64.ToHexString,
Size1, Size2, Size3]));
end;
procedure PrecompLogPatch1(OldSize, NewSize, PatchSize: Integer;
@@ -553,7 +594,9 @@ begin
begin
MemOutput1[Instance].Position := CurPos1[Instance];
exit;
end;
end
else if LCodec = CurCodec[Instance] then
LOption := Info^.Option;
end
else
begin
@@ -616,53 +659,130 @@ begin
CurTransfer[Instance] := String(Codec);
end;
function CheckDB(Dictionary: TSynDictionary; const StreamInfo: TEncodeSI;
var Database: TDatabase): Boolean;
function CheckDB(StreamInfo: TEncodeSI; Database: PDatabase): Boolean;
var
DBKey: Int64;
A: Word;
I: Integer;
LCount: Integer;
DB: PDatabase;
begin
Result := False;
Int64Rec(DBKey).Lo := StreamInfo.Checksum;
Int64Rec(DBKey).Hi := StreamInfo.OldSize;
Result := Dictionary.FindAndCopy(DBKey, Database);
end;
procedure AddDB(Dictionary: TSynDictionary; const StreamInfo: TEncodeSI;
const Database: TDatabase);
var
DBKey: Int64;
begin
Int64Rec(DBKey).Lo := StreamInfo.Checksum;
Int64Rec(DBKey).Hi := StreamInfo.OldSize;
Dictionary.AddOrUpdate(DBKey, Database);
end;
function CheckDup(var DupRec: TDupRec; const StreamInfo: TEncodeSI;
var StreamKey, DupCount: Integer): Boolean;
var
DupKey: Int64;
DupInfo: PDuplicate;
DupAdded: Boolean;
begin
Result := False;
Inc(DupRec.Index);
Int64Rec(DupKey).Lo := StreamInfo.Checksum;
Int64Rec(DupKey).Hi := StreamInfo.OldSize;
DupInfo := DupRec.Dict.FindValueOrAdd(DupKey, DupAdded);
if not DupAdded then
A := LongRec(StreamInfo.Checksum).Lo;
AtomicExchange(LCount, DBCount[A]);
for I := 0 to LCount - 1 do
begin
DB := @DBInfo[A, I];
if (DB^.Size = StreamInfo.OldSize) and (DB^.Checksum = StreamInfo.Checksum)
then
begin
if Assigned(Database) then
Move(DB^, Database^, SizeOf(TDatabase));
Result := True;
break;
end;
end;
end;
procedure AddDB(StreamInfo: TEncodeSI);
var
A: Word;
I: Integer;
DB: TDatabase;
begin
A := LongRec(StreamInfo.Checksum).Lo;
if not CheckDB(StreamInfo, nil) then
begin
GlobalSync.Acquire;
try
DB.Size := StreamInfo.OldSize;
DB.Codec := StreamInfo.Codec;
DB.Option := StreamInfo.Option;
DB.Checksum := StreamInfo.Checksum;
DB.Status := StreamInfo.Status;
Insert(DB, DBInfo[A], Length(DBInfo[A]));
Inc(DBCount[A]);
finally
GlobalSync.Release;
end;
end;
end;
function CheckDD(StreamInfo: TEncodeSI; Database: PDuplicate1;
Index: PInteger): Boolean;
var
A: Word;
I: Integer;
LCount: Integer;
DD: PDuplicate1;
begin
Result := False;
A := LongRec(StreamInfo.Checksum).Lo;
LCount := DDCount1[A];
for I := 0 to LCount - 1 do
begin
DD := @DDInfo[A, I];
if (DD^.Size = StreamInfo.OldSize) and (DD^.Checksum = StreamInfo.Checksum)
then
begin
if Assigned(Database) then
Move(DD^, Database^, SizeOf(TDuplicate1));
if Assigned(Index) then
Index^ := I;
Result := True;
break;
end;
end;
end;
function FindDD(StreamInfo: TEncodeSI; Index, Count: PInteger): Boolean;
var
A: Word;
I: Integer;
DD: PDuplicate1;
begin
Result := False;
if CheckDD(StreamInfo, nil, @I) then
begin
A := LongRec(StreamInfo.Checksum).Lo;
DD := @DDInfo[A, I];
if Assigned(Index) then
Index^ := DD^.Index;
if Assigned(Count) then
Count^ := DD^.Count;
Result := True;
end;
end;
function FindOrAddDD(StreamInfo: TEncodeSI; Index, Count: PInteger): Boolean;
var
A: Word;
I: Integer;
DD: TDuplicate1;
I64: Int64;
begin
Result := False;
Inc(DDIndex);
A := LongRec(StreamInfo.Checksum).Lo;
if not CheckDD(StreamInfo, nil, @I) then
begin
DD.Size := StreamInfo.OldSize;
DD.Checksum := StreamInfo.Checksum;
DD.Index := DDIndex;
DD.Count := 0;
I := Length(DDInfo[A]);
Insert(DD, DDInfo[A], I);
Int64Rec(I64).Words[0] := A;
Int64Rec(I64).Hi := DDCount1[A];
Insert(I64, DDList1, Length(DDList1));
Inc(DDCount1[A]);
Result := True;
Inc(DupInfo^.Count);
StreamKey := DupInfo^.Index;
DupCount := DupInfo^.Count;
end
else
begin
DupInfo^.Count := 0;
DupInfo^.Index := DupRec.Index;
StreamKey := -1;
DupCount := 0;
end;
Inc(DDInfo[A, I].Count);
if Assigned(Index) then
Index^ := DDInfo[A, I].Index;
if Assigned(Count) then
Count^ := DDInfo[A, I].Count;
end;
procedure Scan1(Index, Depth: Integer);
@@ -729,6 +849,8 @@ begin
X := DataStore.ActualSize(Index) -
NativeInt(SI2.Position - DataStore.Position(Index));
LogInt64 := SI2.Position;
LogPtr := PByte(DataStore.Slot(Index).Memory) +
NativeInt(SI2.Position - DataStore.Position(Index));
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,
@@ -830,10 +952,11 @@ begin
SI1.Resource := SI2.Resource;
SI1.Option := SI2.Option;
SI1.Status := SI2.Status;
LogInt64 := DataStore.Position(0) + SI2.ActualPosition;
LogInt64 := DataStore.Position(ThreadIndex) + SI2.ActualPosition;
LogPtr := PByte(DataStore.Slot(ThreadIndex).Memory) + SI2.ActualPosition;
if UseDB and (SI2.Codec > 2) then
begin
DBBool := CheckDB(Database, SI2, DBTyp);
DBBool := CheckDB(SI2, @DBTyp);
if DBBool and (SI2.Codec = DBTyp.Codec) then
begin
if DBTyp.Status = TStreamStatus.Invalid then
@@ -841,7 +964,7 @@ begin
else
begin
SI1.Option := DBTyp.Option;
SI1.Status := TStreamStatus.Predicted;
SI1.Status := TStreamStatus.Database;
end;
end;
end;
@@ -882,13 +1005,14 @@ begin
if UseDB then
if not DBBool then
begin
DBTyp.Codec := SI2.Codec;
DBTyp.Option := SI1.Option;
if Result then
DBTyp.Status := TStreamStatus.Predicted
begin
SI2.Option := SI1.Option;
SI2.Status := TStreamStatus.Predicted
end
else
DBTyp.Status := TStreamStatus.Invalid;
AddDB(Database, SI2, DBTyp);
SI2.Status := TStreamStatus.Invalid;
AddDB(SI2);
end;
if Result then
begin
@@ -1033,10 +1157,9 @@ procedure EncInit(Input, Output: TStream; Options: PEncodeOptions);
var
UI32: UInt32;
I, J, K: Integer;
W: Word;
Bytes: TBytes;
NI: NativeInt;
DBKey: Int64;
DBTyp: TDatabase;
S: String;
DupMethod: Boolean;
begin
@@ -1046,15 +1169,21 @@ begin
ThreadSync[I] := TCriticalSection.Create;
I := XTOOL_PRECOMP;
Output.WriteBuffer(I, I.Size);
CreateGUID(DupGUID);
Output.WriteBuffer(DupGUID, SizeOf(TGUID));
Database := TSynDictionary.Create(TypeInfo(TInt64DynArray),
TypeInfo(TDatabaseDynArray));
for I := Low(Duplicates1) to High(Duplicates1) do
if UseDB then
begin
Duplicates1[I].Dict := TSynDictionary.Create(TypeInfo(TInt64DynArray),
TypeInfo(TDuplicateDynArray));
Duplicates1[I].Index := -1;
SetLength(DBInfo, $10000);
SetLength(DBCount, $10000);
for I := Low(DBInfo) to High(DBInfo) do
DBCount[I] := 0;
end;
if StoreDD then
begin
SetLength(DDInfo, $10000);
SetLength(DDCount1, $10000);
SetLength(DDList1, 0);
for I := Low(DDInfo) to High(DDInfo) do
DDCount1[I] := 0;
DDIndex := -1;
end;
SetLength(Tasks, Options^.Threads);
SetLength(CurCodec, Options^.Threads);
@@ -1126,7 +1255,6 @@ begin
end;
CodecInit(Options^.Threads, Options^.Method);
DBFile := Options^.DBaseFile;
DupFile := Options^.DedupFile;
if FileExists(ExtractFilePath(Utils.GetModuleName) + DBFile) then
begin
with TFileStream.Create(ExtractFilePath(Utils.GetModuleName) + DBFile,
@@ -1140,16 +1268,19 @@ begin
end;
with WorkStream[0] do
begin
J := PInteger(Memory)^;
for I := 0 to J - 1 do
Position := 0;
while Position < Size do
begin
NI := Integer.Size + (I * (SizeOf(Int64) + SizeOf(TDatabase)));
DBKey := PInt64(PByte(Memory) + NI)^;
DBTyp := PDatabase(PByte(Memory) + NI + SizeOf(Int64))^;
Database.Add(DBKey, DBTyp);
ReadBuffer(W, W.Size);
ReadBuffer(J, J.Size);
DBCount[W] := J;
SetLength(DBInfo[W], J);
for K := 0 to J - 1 do
ReadBuffer(DBInfo[W, K], SizeOf(TDatabase));
end;
end;
end;
ExtDir := IncludeTrailingBackSlash(Options^.ExtractDir);
Output.WriteBuffer(Options^.Depth, Options^.Depth.Size);
S := '';
I := 0;
@@ -1237,9 +1368,6 @@ begin
Tasks[I].Free;
WorkStream[I].Free;
end;
Database.Free;
for I := Low(Duplicates1) to High(Duplicates1) do
Duplicates1[I].Dict.Free;
FreeResources;
GlobalSync.Free;
for I := Low(ThreadSync) to High(ThreadSync) do
@@ -1265,19 +1393,19 @@ var
StreamCount: Integer;
BlockSize: Int64;
UI32: UInt32;
I, J, X: Integer;
I, J, K, X: Integer;
W: Word;
I64: Int64;
LastStream, LastPos: Int64;
LastIndex: Integer;
CurrSize: Cardinal;
DupBool: Boolean;
DupKey, DupCount: Integer;
DBKey: Int64;
DBTyp: TDatabase;
DupTyp: TDuplicate;
DupIdx1, DupIdx2, DupCount: Integer;
DupTyp: TDuplicate2;
begin
if (Depth = 0) then
begin
if (DupFile = '') and StoreDD then
if StoreDD then
TempOutput := TPrecompVMStream.Create
else
TempOutput := Output;
@@ -1285,6 +1413,7 @@ begin
else
TempOutput := Output;
Result := False;
DupIdx1 := 0;
with ComVars1[Depth] do
begin
LastStream := 0;
@@ -1381,16 +1510,15 @@ begin
begin
Inc(StreamCount);
DupBool := False;
if (Depth = 0) and ((DupFile <> '') or StoreDD) then
DupBool := CheckDup(Duplicates1[0], StreamInfo, DupKey,
DupCount);
if (Depth = 0) and StoreDD then
DupBool := not FindOrAddDD(StreamInfo, @DupIdx2, @DupCount);
if DupBool then
begin
if DupCount = 2 then
if DupCount = 1 then
Inc(EncInfo.DecMem2, StreamInfo.OldSize);
FillChar(StreamHeader, SizeOf(TStreamHeader), 0);
StreamHeader.Kind := DUPLICATED_STREAM;
StreamHeader.Option := DupKey;
StreamHeader.Option := DupIdx2;
end
else
begin
@@ -1427,19 +1555,19 @@ begin
Result := True
else if Depth > 0 then
exit;
I64 := MemStream[I].Position;
MemStream[I].Position := 0;
MemStream[I].WriteBuffer(StreamCount, StreamCount.Size);
MemStream[I].WriteBuffer(BlockSize, BlockSize.Size);
TempOutput.WriteBuffer(MemStream[I].Memory^, MemStream[I].Position +
StreamCount * SizeOf(TStreamHeader));
TempOutput.WriteBuffer(MemStream[I].Memory^, I64);
InfoStore1[I].Index := LastIndex;
J := InfoStore1[I].Get(StreamInfo);
while J >= 0 do
begin
DupBool := False;
if (Depth = 0) and ((DupFile <> '') or StoreDD) then
DupBool := CheckDup(Duplicates1[1], StreamInfo, DupKey, DupCount);
if not DupBool then
if (Depth = 0) and StoreDD then
DupBool := FindDD(StreamInfo, @DupIdx2, @DupCount);
if (DupBool = False) or (DupIdx1 = DupIdx2) then
begin
if StreamInfo.ExtSize < 0 then
begin
@@ -1465,6 +1593,7 @@ begin
StreamInfo.ExtSize.Size);
end;
end;
Inc(DupIdx1);
if Succ(J - LastIndex) = StreamCount then
break;
J := InfoStore1[I].Get(StreamInfo);
@@ -1519,14 +1648,16 @@ begin
with WorkStream[0] do
begin
Position := 0;
J := Database.Count;
WriteBuffer(J, J.Size);
for I := 0 to J - 1 do
for W := 0 to $10000 - 1 do
begin
DBKey := PInt64(Database.Keys.ElemPtr(I))^;
WriteBuffer(DBKey, SizeOf(Int64));
DBTyp := PDatabase(Database.Values.ElemPtr(I))^;
WriteBuffer(DBTyp, SizeOf(TDatabase));
J := DBCount[I];
if J > 0 then
begin
WriteBuffer(W, W.Size);
WriteBuffer(J, J.Size);
for K := 0 to J - 1 do
WriteBuffer(DBInfo[W, K], SizeOf(TDatabase));
end;
end;
end;
with TFileStream.Create(ExtractFilePath(Utils.GetModuleName) + DBFile,
@@ -1536,40 +1667,27 @@ begin
Free;
end;
end;
if (DupFile <> '') or StoreDD then
if StoreDD then
begin
for I := Duplicates1[0].Dict.Count - 1 downto 0 do
begin
if PDuplicate(Duplicates1[0].Dict.Values.ElemPtr(I))^.Count < 1 then
Duplicates1[0].Dict.DeleteAt(I);
end;
with WorkStream[0] do
begin
Position := 0;
WriteBuffer(DupGUID, SizeOf(TGUID));
Duplicates1[0].Dict.Values.Sort(DuplicateSortCompare);
J := Duplicates1[0].Dict.Count;
WriteBuffer(J, J.Size);
for I := 0 to J - 1 do
UI32 := 0;
for I := Low(DDList1) to High(DDList1) do
begin
DupTyp := PDuplicate(Duplicates1[0].Dict.Values.ElemPtr(I))^;
WriteBuffer(DupTyp, SizeOf(TDuplicate));
J := Int64Rec(DDList1[I]).Words[0];
X := Int64Rec(DDList1[I]).Hi;
if DDInfo[J, X].Count > 0 then
begin
DupTyp.Index := DDInfo[J, X].Index;
DupTyp.Count := DDInfo[J, X].Count;
WriteBuffer(DupTyp, SizeOf(TDuplicate2));
Inc(UI32);
end;
end;
end;
if DupFile <> '' then
begin
with TFileStream.Create(ExtractFilePath(Utils.GetModuleName) + DupFile,
FSMode(FileExists(ExtractFilePath(Utils.GetModuleName) + DupFile))) do
begin
Position := Size;
WriteBuffer(WorkStream[0].Memory^, WorkStream[0].Position);
end;
end
else
Output.WriteBuffer(WorkStream[0].Memory^, WorkStream[0].Position);
end;
if (DupFile = '') and StoreDD then
begin
Output.WriteBuffer(UI32, UI32.Size);
Output.WriteBuffer(WorkStream[0].Memory^, WorkStream[0].Position);
Output.CopyFrom(TempOutput, 0);
TempOutput.Free;
end;
@@ -1633,10 +1751,9 @@ var
NStream: TArrayStream;
DataMgr: TDataManager;
ComVars2: TArray<TCommonVarsDec>;
Duplicates2: TSynDictionary;
DupIdx1: Integer;
DupIdx2: TArray<Integer>;
DupBool: TArray<Boolean>;
DDList2: TArray<TDuplicate2>;
DDCount2: Integer;
DDIndex1, DDIndex2: Integer;
BlockPos: Int64;
procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer;
@@ -1644,8 +1761,9 @@ procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer;
begin
with ComVars2[CurDepth[Instance]] do
DecOutput[Instance].WriteBuffer(Buffer^, Size);
if (CurDepth[Instance] = 0) and (DupBool[Instance]) then
DataMgr.Write(DupIdx2[Instance], Buffer^, Size);
if StoreDD and (CurDepth[Instance] = 0) then
if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index)) then
DataMgr.Write(DDIndex1, Buffer, Size);
end;
procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer;
@@ -1653,8 +1771,6 @@ procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer;
begin
with ComVars2[CurDepth[Instance]] do
MemOutput1[Instance].WriteBuffer(Buffer^, Size);
if (CurDepth[Instance] = 0) and (DupBool[Instance]) then
DataMgr.Write(DupIdx2[Instance], Buffer^, Size);
end;
procedure Restore(MT: Boolean; Index, Depth: Integer);
@@ -1675,18 +1791,11 @@ begin
while X < StreamCount[Index]^ do
begin
SH := PStreamHeader(MemStream1[Index].Memory) + X;
if (Depth = 0) then
begin
DupIdx2[Index] := DupIdx1 + X;
DupBool[Index] := Duplicates2.FindAndCopy(DupIdx2[Index], Y);
if DupBool[Index] then
DataMgr.Add(DupIdx2[Index], SH^.OldSize, Y);
end;
if MT then
begin
LOutput := @PrecompOutput3;
Pos := StreamInfo[Index]^.Pos[X];
X64 := Pos + SH^.NewSize;
X64 := Pos + Max(SH^.OldSize, SH^.NewSize);
while (BlockPos < X64) do
begin
if IsErrored(Tasks) or (BlockPos < 0) then
@@ -1697,6 +1806,13 @@ begin
end
else
begin
if StoreDD and (Depth = 0) then
begin
Inc(DDIndex1);
if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index))
then
DataMgr.Add(DDIndex1, SH^.OldSize, DDList2[DDIndex2].Count);
end;
LOutput := @PrecompOutput2;
DecInput[Index].ReadBuffer(UI32, UI32.Size);
if UI32 > 0 then
@@ -1740,9 +1856,12 @@ begin
end;
CurCodec[Index] := SH^.Codec;
CurDepth[Index] := Depth;
Y := GetBits(SI.Option, 0, 5);
if not InRange(Y, 0, Pred(Length(Codecs[SH^.Codec].Names))) then
Y := 0;
if (Codecs[SH^.Codec].Restore(Index, Depth, Ptr1, Ptr2, SI, LOutput,
@PrecompFunctions) = False) then
raise Exception.CreateFmt(SPrecompError3, [Codecs[SH^.Codec].Names[0]]);
raise Exception.CreateFmt(SPrecompError3, [Codecs[SH^.Codec].Names[Y]]);
NStream.Update(0, CalcSysMem);
if MT then
begin
@@ -1751,7 +1870,13 @@ begin
StreamInfo[Index]^.Completed[X] := True;
end
else
begin
if StoreDD and (Depth = 0) then
if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index))
then
Inc(DDIndex2);
Inc(Pos, SH^.NewSize);
end;
X := AtomicIncrement(StreamIdx[Index]^);
end;
end;
@@ -1772,24 +1897,16 @@ var
I, J: Integer;
Bytes: TBytes;
UI32: UInt32;
DupTyp: TDuplicate;
LStream: TStream;
LGUID: TGUID;
LResData: PResData;
DupTyp: TDuplicate1;
LResData: TResData;
begin
GlobalSync := TCriticalSection.Create;
SetLength(ThreadSync, Options^.Threads);
for I := Low(ThreadSync) to High(ThreadSync) do
ThreadSync[I] := TCriticalSection.Create;
DupSysMem := Options^.DedupSysMem;
NStream.Add(TypeInfo(TMemoryStream), CalcSysMem);
NStream.Add(TypeInfo(TPrecompVMStream));
Duplicates2 := TSynDictionary.Create(TypeInfo(TIntegerDynArray),
TypeInfo(TIntegerDynArray));
DupIdx1 := 0;
SetLength(DupIdx2, Options^.Threads);
SetLength(DupBool, Options^.Threads);
Input.ReadBuffer(DupGUID, SizeOf(TGUID));
NStream.Add(TypeInfo(TMemoryStream) { , CalcSysMem } );
// NStream.Add(TypeInfo(TPrecompVMStream));
Input.ReadBuffer(Options^.Depth, Options^.Depth.Size);
Input.ReadBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size);
SetLength(Bytes, LongRec(I).Bytes[0]);
@@ -1798,15 +1915,14 @@ begin
Input.ReadBuffer(I, I.Size);
for J := 0 to I - 1 do
begin
New(LResData);
Input.ReadBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size);
SetLength(Bytes, LongRec(I).Bytes[0]);
Input.ReadBuffer(Bytes[0], LongRec(I).Bytes[0]);
LResData^.Name := StringOf(Bytes);
Input.ReadBuffer(LResData^.Size, LResData^.Size.Size);
GetMem(LResData^.Data, LResData^.Size);
Input.ReadBuffer(LResData^.Data^, LResData^.Size);
Insert(LResData^, Resources, Length(Resources));
LResData.Name := StringOf(Bytes);
Input.ReadBuffer(LResData.Size, LResData.Size.Size);
GetMem(LResData.Data, LResData.Size);
Input.ReadBuffer(LResData.Data^, LResData.Size);
Insert(LResData, Resources, Length(Resources));
end;
SetLength(Tasks, Options^.Threads);
SetLength(CurCodec, Options^.Threads);
@@ -1860,45 +1976,18 @@ begin
end;
end;
Input.ReadBuffer(StoreDD, StoreDD.Size);
if StoreDD or FileExists(ExtractFilePath(Utils.GetModuleName) +
Options^.DedupFile) then
UI32 := 0;
if StoreDD then
begin
if StoreDD then
LStream := Input
else
begin
LStream := TFileStream.Create(ExtractFilePath(Utils.GetModuleName) +
Options^.DedupFile, fmShareDenyNone);
LStream.Position := 0;
end;
while True do
begin
LStream.ReadBuffer(LGUID, SizeOf(TGUID));
LStream.ReadBuffer(J, J.Size);
I := J * SizeOf(TDuplicate);
if CompareMem(@DupGUID, @LGUID, SizeOf(TGUID)) then
begin
if WorkStream[0].Size < I then
WorkStream[0].Size := I;
LStream.ReadBuffer(WorkStream[0].Memory^, I);
for I := 0 to J - 1 do
begin
DupTyp := (PDuplicate(WorkStream[0].Memory) + I)^;
Duplicates2.Add(DupTyp.Index, DupTyp.Count);
end;
break;
end
else if StoreDD then
raise EReadError.CreateRes(@SInvalidProperty)
else
LStream.Seek(I, TSeekOrigin.soCurrent);
if StoreDD or (LStream.Position >= LStream.Size) then
break;
end;
if not StoreDD then
LStream.Free;
Input.ReadBuffer(UI32, UI32.Size);
SetLength(DDList2, UI32);
DDCount2 := UI32;
for I := Low(DDList2) to High(DDList2) do
Input.ReadBuffer(DDList2[I], SizeOf(TDuplicate2));
DDIndex1 := -1;
DDIndex2 := 0;
end;
DataMgr := TDataManager.Create(NStream, Duplicates2.Count);
DataMgr := TDataManager.Create(NStream);
end;
procedure DecFree;
@@ -1933,7 +2022,6 @@ begin
WorkStream[I].Free;
end;
DataMgr.Free;
Duplicates2.Free;
FreeResources;
GlobalSync.Free;
for I := Low(ThreadSync) to High(ThreadSync) do
@@ -1981,8 +2069,17 @@ begin
Inc(CurrPos, Max(StreamHeader^.OldSize, StreamHeader^.NewSize));
end;
end;
if MemInput[Index].Size < BlockSize then
MemInput[Index].Size := BlockSize;
if (Depth = 0) and (Length(Tasks) > 1) and (StreamCount[Index]^ > 1)
then
begin
if MemInput[Index].Size < CurrPos then
MemInput[Index].Size := CurrPos;
end
else
begin
if MemInput[Index].Size < BlockSize then
MemInput[Index].Size := BlockSize;
end;
MemInput[Index].Position := 0;
StreamIdx[Index]^ := -1;
if (Depth = 0) and (Length(Tasks) > 1) and (StreamCount[Index]^ > 1)
@@ -1996,9 +2093,6 @@ begin
for J := 0 to StreamCount[Index]^ - 1 do
begin
StreamHeader := PStreamHeader(MemStream1[Index].Memory) + J;
MemInput[Index].Size := Max(MemInput[Index].Size,
StreamInfo[Index]^.Pos[J] + Max(StreamHeader^.OldSize,
StreamHeader^.NewSize));
MemInput[Index].Position := StreamInfo[Index]^.Pos[J];
if CopyStream(DecInput[Index], MemInput[Index],
StreamHeader^.NewSize) <> StreamHeader^.NewSize then
@@ -2026,12 +2120,26 @@ begin
if IsErrored(Tasks) then
for I := Low(Tasks) to High(Tasks) do
Tasks[I].RaiseLastError;
if StoreDD and (Depth = 0) then
begin
Inc(DDIndex1);
if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index))
then
begin
DataMgr.Add(DDIndex1, StreamHeader^.OldSize,
DDList2[DDIndex2].Count);
DataMgr.Write(DDIndex1,
(PByte(MemInput[Index].Memory) + StreamInfo[Index]^.Pos[J]),
StreamHeader^.OldSize);
Inc(DDIndex2);
end;
end;
if StreamHeader^.Kind and DUPLICATED_STREAM = DUPLICATED_STREAM then
DataMgr.CopyData(StreamHeader^.Option, DecOutput[Index])
else
DecOutput[Index].WriteBuffer
((PByte(MemInput[Index].Memory) + StreamInfo[Index]^.Pos[J])^,
(PStreamHeader(MemStream1[Index].Memory) + J)^.OldSize);
StreamHeader^.OldSize);
end;
WaitForAll(Tasks);
end
@@ -2041,8 +2149,6 @@ begin
DecInput[Index].ReadBuffer(UI32, UI32.Size);
if UI32 > 0 then
CopyStreamEx(DecInput[Index], DecOutput[Index], UI32);
if Depth = 0 then
Inc(DupIdx1, StreamCount[Index]^);
DecInput[Index].ReadBuffer(StreamCount[Index]^, StreamCount[Index]^.Size);
end;
end;

1005
precompressor/PrecompMedia.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4
precompressor/PrecompOodle.pas
View File

@@ -681,8 +681,8 @@ begin
if CustomLZ_Decompress0(Input, Buffer, StreamInfo^.OldSize,
OodleSI.DSize, Res) then
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
StreamInfo^.NewSize := Res;
Funcs^.LogScan2(OodleCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
@@ -730,7 +730,7 @@ begin
break;
end;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
(SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,

45
precompressor/PrecompUtils.pas
View File

@@ -18,7 +18,7 @@ resourcestring
SPrecompSep4 = '/';
const
SuccessStatus = 3;
SuccessStatus = 4;
DEFAULT_STREAM = 0;
EXTENDED_STREAM = 1;
@@ -32,7 +32,7 @@ type
TPrecompStr = array [0 .. 255] of Char;
TStreamStatus = (None, Invalid, Predicted);
TStreamStatus = (None, Invalid, Predicted, Database);
PDepthInfo = ^TDepthInfo;
@@ -182,10 +182,10 @@ type
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;
LogProcess: procedure(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean)cdecl;
LogRestore: procedure(Codec, Method: PChar; Size1, Size2, Size3: Integer;
Status: Boolean)cdecl;
LogPatch1: procedure(OldSize, NewSize, PatchSize: Integer;
Status: Boolean)cdecl;
LogPatch2: procedure(OldSize, NewSize, PatchSize: Integer;
@@ -243,22 +243,29 @@ type
PDatabase = ^TDatabase;
TDatabase = record
TDatabase = packed record
Size: Integer;
Codec: Byte;
Status: TStreamStatus;
Option: Integer;
Checksum: Cardinal;
Status: TStreamStatus;
end;
TDatabaseDynArray = TArray<TDatabase>;
PDuplicate1 = ^TDuplicate1;
PDuplicate = ^TDuplicate;
TDuplicate = record
TDuplicate1 = packed record
Size: Integer;
Checksum: Cardinal;
Index: Integer;
Count: Integer;
end;
TDuplicateDynArray = TArray<TDuplicate>;
PDuplicate2 = ^TDuplicate2;
TDuplicate2 = packed record
Index: Integer;
Count: Integer;
end;
TPrecompVMStream = class(TStream)
private const
@@ -288,8 +295,6 @@ type
Size: Integer;
end;
function DuplicateSortCompare(const Left, Right): Integer;
procedure AddMethod(Method: String);
procedure ClearMethods;
@@ -358,7 +363,6 @@ function PrecompAcceptPatch(OldSize, NewSize, PatchSize: Integer)
var
PrecompFunctions: _PrecompFuncs;
DIFF_TOLERANCE: Single = 0.05;
VERBOSE: Boolean = False;
EncodeSICmp: TEncodeSIComparer;
FutureSICmp: TFutureSIComparer;
StockMethods, ExternalMethods: TStringList;
@@ -380,11 +384,6 @@ begin
Result := Integer(CompareValue(Left.Position, Right.Position));
end;
function DuplicateSortCompare(const Left, Right): Integer;
begin
Result := TDuplicate(Left).Index - TDuplicate(Right).Index;
end;
procedure AddMethod(Method: String);
begin
if (StockMethods.IndexOf(Method) < 0) and (ExternalMethods.IndexOf(Method) < 0)
@@ -856,7 +855,7 @@ var
begin
Result := 0;
if xd3_encode(OldBuff, OldSize, NewBuff, NewSize, PatchBuff, @Res, PatchSize,
0) = 0 then
Integer(XD3_NOCOMPRESS)) = 0 then
Result := Res;
// MakeDiff(OldBuff, NewBuff, PatchBuff, OldSize, NewSize, Result);
end;
@@ -869,7 +868,7 @@ var
begin
Result := 0;
if xd3_decode(PatchBuff, PatchSize, OldBuff, OldSize, NewBuff, @Res, NewSize,
0) = 0 then
Integer(XD3_NOCOMPRESS)) = 0 then
Result := Res;
// MakePatch(OldBuff, PatchBuff, NewBuff, OldSize, PatchSize, Result);
end;

74
precompressor/PrecompZLib.pas
View File

@@ -255,7 +255,8 @@ begin
CodecAvailable[ZLIB_CODEC] := ZLibDLL.DLLLoaded;
CodecAvailable[REFLATE_CODEC] := ReflateDLL.DLLLoaded;
CodecAvailable[PREFLATE_CODEC] := PreflateDLL.DLLLoaded;
CodecAvailable[PNG_CODEC] := True;
CodecAvailable[PNG_CODEC] := ZLibDLL.DLLLoaded or ReflateDLL.DLLLoaded or
PreflateDLL.DLLLoaded;
X := 0;
while Funcs^.GetCodec(Command, X, False) <> '' do
begin
@@ -433,12 +434,13 @@ var
begin
DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False);
X := -1;
if DS <> '' then
begin
X := IndexTextW(@DS[0], ZlibCodecs);
if (X < 0) or (DI1.OldSize <> SizeEx) then
exit;
if CodecAvailable[X] then
if not CodecAvailable[X] then
exit;
end
else if BoolArray(CodecEnabled, False) then
@@ -567,7 +569,7 @@ begin
if (I = ZLIB_CODEC) and (WinBits = 0) then
SetBits(SI.Option, 1, 12, 3);
SetBits(SI.Option, I, 0, 5);
if CodecEnabled[I] then
if CodecEnabled[I] or (I = X) then
begin
DS := Funcs^.GetDepthCodec(DI1.Codec);
Move(DS[0], DI2.Codec, SizeOf(DI2.Codec));
@@ -632,18 +634,14 @@ function ZlibProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
function IsValidLevel(CLevel, ZLevel: Integer): Boolean;
begin
Result := False;
case CLevel of
1, 6:
if CLevel = ZLevel then
Result := True;
Result := CLevel = ZLevel;
2 .. 5:
if ZLevel = 5 then
Result := True;
Result := ZLevel = 5;
7 .. 9:
if ZLevel = 9 then
Result := True;
else
Result := False;
Result := ZLevel = 9;
end;
end;
@@ -664,6 +662,7 @@ begin
if not X in [PNG_CODEC] then
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Params := '';
case X of
ZLIB_CODEC:
begin
@@ -673,7 +672,7 @@ begin
begin
L := I div 10;
M := I mod 10;
if StreamInfo^.Status = TStreamStatus.Predicted then
if StreamInfo^.Status >= TStreamStatus.Predicted then
begin
if InRange(GetBits(StreamInfo^.Option, 5, 7), 1, 9) then
begin
@@ -684,36 +683,40 @@ begin
begin
if GetBits(StreamInfo^.Option, 5, 7) <> I then
continue;
{ I := GetBits(StreamInfo^.Option, 5, 7);
SOList[Instance][ZLIB_CODEC].Add(I);
if StreamInfo^.Status = TStreamStatus.Database then
Result := True;
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;
ZStream^.avail_in := StreamInfo^.NewSize;
deflateReset(ZStream^);
repeat
ZStream^.next_out := Buffer;
ZStream^.avail_out := Z_BLKSIZE;
Res1 := deflate(ZStream^, Z_FINISH);
if Res1 < 0 then
raise EZCompressionError.Create(string(_z_errmsg[2 - Res1]))
at ReturnAddress;
Res2 := Z_BLKSIZE - ZStream^.avail_out;
Verified := CompareMem(PByte(OldInput) + ZStream^.total_out - Res2,
Buffer, Res2);
if not Verified then
break;
until (ZStream^.avail_in = 0) and (ZStream^.avail_out > 0);
if not Result then
begin
ZStream^.next_in := NewInput;
ZStream^.avail_in := StreamInfo^.NewSize;
deflateReset(ZStream^);
repeat
ZStream^.next_out := Buffer;
ZStream^.avail_out := Z_BLKSIZE;
Res1 := deflate(ZStream^, Z_FINISH);
if Res1 < 0 then
raise EZCompressionError.Create(string(_z_errmsg[2 - Res1]))
at ReturnAddress;
Res2 := Z_BLKSIZE - ZStream^.avail_out;
Verified := CompareMem(PByte(OldInput) + ZStream^.total_out -
Res2, Buffer, Res2);
if not Verified then
break;
until (ZStream^.avail_in = 0) and (ZStream^.avail_out > 0);
end
else
ZStream.total_out := StreamInfo^.OldSize;
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
ZStream^.total_out, (Result = True) or
(Verified and (Res1 = Z_STREAM_END)));
if (Result = True) or (Verified and (Res1 = Z_STREAM_END)) then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][ZLIB_CODEC].Add(I);
@@ -739,7 +742,7 @@ begin
Buffer := Funcs^.Allocator(Instance, R_WORKMEM * 2);
J := 0;
HR := RefInst1[Instance];
if StreamInfo^.Status = TStreamStatus.Predicted then
if StreamInfo^.Status >= TStreamStatus.Predicted then
L := GetBits(StreamInfo^.Option, 5, 7)
else
L := RLevel;
@@ -804,7 +807,6 @@ begin
PNG_CODEC:
begin
Buffer := Funcs^.Allocator(Instance, StreamInfo^.OldSize);
Params := '';
if DecodePNG(NewInput, Buffer, StreamInfo^.OldSize) then
Result := CompareMem(OldInput, Buffer, StreamInfo^.OldSize);
Funcs^.LogProcess(ZlibCodecs[GetBits(StreamInfo^.Option, 0, 5)],
@@ -831,6 +833,7 @@ begin
if not X in [PNG_CODEC] then
if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then
exit;
Params := '';
case X of
ZLIB_CODEC:
begin
@@ -915,7 +918,6 @@ begin
PNG_CODEC:
begin
Buffer := Funcs^.Allocator(Instance, StreamInfo.OldSize);
Params := '';
if DecodePNG(Input, Buffer, StreamInfo.OldSize) then
begin
Output(Instance, Buffer, StreamInfo.OldSize);

5
precompressor/PrecompZSTD.pas
View File

@@ -233,8 +233,8 @@ begin
end;
if Res > StreamInfo^.OldSize then
begin
StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res);
StreamInfo^.NewSize := Res;
Funcs^.LogScan2(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True;
@@ -265,6 +265,7 @@ begin
if StreamInfo^.Status = TStreamStatus.Predicted then
if GetBits(StreamInfo^.Option, 5, 7) <> I then
continue;
Params := '';
case X of
ZSTD_CODEC:
begin
@@ -307,7 +308,7 @@ begin
if Res1 < 0 then
exit;
if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then
(SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then
begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,