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

update to 0.4.7

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

285
common/Utils.pas
View File

@ -433,8 +433,9 @@ function ExecStdio(Executable, CommandLine, WorkDir: string; InBuff: Pointer;
InSize: Integer; Output: TExecOutput): Boolean;
function ExecStdioSync(Executable, CommandLine, WorkDir: string;
InBuff: Pointer; InSize: Integer; Output: TExecOutput): Boolean;
function GetCmdStr(CommandLine: String; Index: Integer;
KeepQuotes: Boolean = False): string;
function GetCmdCount(CommandLine: String): Integer;
function GetCmdStr(CommandLine: String; Index: Integer): string;
implementation
@ -446,50 +447,82 @@ end;
procedure SetBits(var Data: Int8; Value: Int8; Index: TInt8_BitIndex;
Count: TInt8_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: UInt8; Value: Int8; Index: TInt8_BitIndex;
Count: TInt8_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: Int16; Value: Int16; Index: TInt16_BitIndex;
Count: TInt16_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: UInt16; Value: Int16; Index: TInt16_BitIndex;
Count: TInt16_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: Int32; Value: Int32; Index: TInt32_BitIndex;
Count: TInt32_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: UInt32; Value: Int32; Index: TInt32_BitIndex;
Count: TInt32_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: Int64; Value: Int64; Index: TInt64_BitIndex;
Count: TInt64_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure SetBits(var Data: UInt64; Value: Int64; Index: TInt64_BitIndex;
Count: TInt64_BitCount);
var
I: Integer;
begin
Data := (Data and (not(((1 shl Count) - 1) shl Index))) or (Value shl Index);
I := Index + Count;
Data := (GetBits(Data, I, Data.Size - I) shl I) or
(GetBits(Value, 0, Count) shl Index) or GetBits(Data, 0, Index);
end;
procedure ShowMessage(Msg: string; Caption: string = '');
@ -1351,6 +1384,7 @@ begin
inherited Create;
FSync.Init;
FInput := AInput;
FTemp := nil;
FTempFile := ATempFile;
FTempPos := 0;
FDynamic := ADynamic;
@ -1447,6 +1481,8 @@ begin
end
else
begin
if Count = 0 then
exit;
FSync.Lock;
try
if not Assigned(FTemp) then
@ -2924,8 +2960,10 @@ begin
exit;
if GetHandleInformation(Handle, lpdwFlags) then
if lpdwFlags <> HANDLE_FLAG_PROTECT_FROM_CLOSE then
begin
CloseHandle(Handle);
Handle := 0;
end;
end;
function Exec(Executable, CommandLine, WorkDir: string): Boolean;
@ -2950,12 +2988,14 @@ begin
if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
False, 0, nil, LWorkDir, StartupInfo, ProcessInfo) then
begin
CloseHandleEx(ProcessInfo.hThread);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
Result := True;
end;
CloseHandleEx(ProcessInfo.hProcess);
Result := dwExitCode = 0;
end
else
RaiseLastOSError;
end;
function ExecStdin(Executable, CommandLine, WorkDir: string; InBuff: Pointer;
@ -2967,6 +3007,7 @@ var
hstdinr, hstdinw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
LWorkDir: PChar;
begin
Result := False;
@ -2987,17 +3028,22 @@ begin
if CreateProcess(nil, PChar('"' + Executable + '" ' + CommandLine), nil, nil,
True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, ProcessInfo) then
begin
Result := True;
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdinr);
try
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinr);
CloseHandle(hstdinw);
finally
CloseHandleEx(hstdinw);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
CloseHandleEx(ProcessInfo.hProcess);
end;
Result := dwExitCode = 0;
end
else
begin
CloseHandle(hstdinr);
CloseHandle(hstdinw);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdinw);
RaiseLastOSError;
end;
end;
@ -3012,6 +3058,7 @@ var
hstdoutr, hstdoutw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
Buffer: array [0 .. BufferSize - 1] of Byte;
BytesRead: DWORD;
LWorkDir: PChar;
@ -3034,19 +3081,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);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdoutw);
try
while ReadFile(hstdoutr, Buffer, Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(@Buffer[0], BytesRead);
CloseHandle(hstdoutr);
Result := True;
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;
@ -3064,6 +3116,7 @@ var
hstdoutr, hstdoutw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
LWorkDir: PChar;
begin
Result := True;
@ -3086,24 +3139,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);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdoutw);
try
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
CloseHandleEx(hstdinw);
while ReadFile(hstdoutr, Buffer[0], Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(@Buffer[0], BytesRead);
CloseHandle(hstdoutr);
Result := True;
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;
@ -3132,6 +3191,7 @@ var
hstdoutr, hstdoutw: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
dwExitCode: DWORD;
LWorkDir: PChar;
LTask: TTask;
LDone: Boolean;
@ -3156,126 +3216,95 @@ 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(hstdoutr, NativeInt(@Output), NativeInt(@LDone));
LTask.Perform(ExecReadTask);
LTask.Start;
try
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
finally
CloseHandleEx(hstdinw);
LTask.Wait;
if LTask.Status <> TThreadStatus.tsErrored then
begin
LTask.Free;
CloseHandle(hstdoutr);
Result := True;
LTask := nil;
end;
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;
type
PAnsiCharArray = array [0 .. 0] of PAnsiChar;
function GetParamStr(P: PChar; var Param: string): PChar;
function GetCmdStr(CommandLine: String; Index: Integer;
KeepQuotes: Boolean): string;
var
I, len: Integer;
Start, S: PChar;
I, J, Idx: Integer;
Quoted: Boolean;
begin
while True do
Result := '';
Quoted := False;
Idx := 0;
I := 1;
while Idx <= Index do
begin
while (P[0] <> #0) and (P[0] <= ' ') do
Inc(P);
if (P[0] = '"') and (P[1] = '"') then
Inc(P, 2)
else
Quoted := False;
while (I <= CommandLine.Length) and (CommandLine[I] = ' ') do
Inc(I);
if I > CommandLine.Length then
break;
end;
len := 0;
Start := P;
while P[0] > ' ' do
Quoted := CommandLine[I] = '"';
J := Succ(I);
if Quoted then
Inc(I);
if Quoted then
begin
if P[0] = '"' then
begin
Inc(P);
while (P[0] <> #0) and (P[0] <> '"') do
begin
Inc(len);
Inc(P);
end;
if P[0] <> #0 then
Inc(P);
while (J <= CommandLine.Length) and (CommandLine[J] <> '"') do
Inc(J);
end
else
begin
Inc(len);
Inc(P);
while (J <= CommandLine.Length) and
(not(CharInSet(CommandLine[J], [' ', '"']))) do
Inc(J);
end;
end;
SetLength(Param, len);
P := Start;
S := Pointer(Param);
I := 0;
while P[0] > ' ' do
begin
if P[0] = '"' then
begin
Inc(P);
while (P[0] <> #0) and (P[0] <> '"') do
begin
S[I] := P^;
Inc(P);
Inc(I);
end;
if P[0] <> #0 then
Inc(P);
end
if Idx = Index then
if (CommandLine[I] = '"') and (CommandLine[I] = CommandLine[Succ(I)]) then
Result := ''
else
begin
S[I] := P^;
Inc(P);
Inc(I);
Result := CommandLine.Substring(Pred(I), J - I);
if (Quoted = False) and (CommandLine[J] = '"') then
I := J
else
I := Succ(J);
Inc(Idx);
end;
end;
Result := P;
if KeepQuotes and Quoted then
Result := '"' + Result + '"';
end;
function GetCmdCount(CommandLine: String): Integer;
var
P: PChar;
S: string;
begin
Result := 0;
P := GetParamStr(PChar(CommandLine), S);
while True do
begin
P := GetParamStr(P, S);
if S = '' then
break;
while GetCmdStr(CommandLine, Result, True) <> '' do
Inc(Result);
end;
end;
function GetCmdStr(CommandLine: String; Index: Integer): string;
var
P: PChar;
Buffer: array [0 .. 260] of char;
begin
Result := '';
P := PChar(CommandLine);
while Index >= 0 do
begin
P := GetParamStr(P, Result);
if (Index = 0) or (Result = '') then
break;
Dec(Index);
end;
end;
end.

67
dbgenerator/DbgMain.pas
View File

@ -28,6 +28,7 @@ implementation
const
MinSize1 = 256;
MinSize2 = 65536;
HashSize = 4 * 1024 * 1024;
type
PScanInfo = ^TScanInfo;
@ -37,6 +38,13 @@ type
CRC1, CRC2: Cardinal;
end;
PHashStruct = ^THashStruct;
THashStruct = record
Size: Integer;
Hash: Cardinal;
end;
var
SearchInfo: TArray<TArray<TArray<TScanInfo>>>;
SearchCount: TArray<TArray<Integer>>;
@ -55,7 +63,7 @@ begin
WriteLn(ErrOutput, '');
WriteLn(ErrOutput, 'Parameters:');
WriteLn(ErrOutput, ' -m# - codec to use for precompression');
WriteLn(ErrOutput, ' -c# - scanning range of precompressor [16mb]');
WriteLn(ErrOutput, ' -c# - scanning range of generator [16mb]');
WriteLn(ErrOutput, ' -t# - number of working threads [50p]');
WriteLn(ErrOutput, '');
end;
@ -102,6 +110,44 @@ begin
end;
end;
function GenerateHashList(Stream: TStream;
var HashList: TArray<THashStruct>): Integer;
const
BufferSize = 65536;
var
Buffer: array [0 .. BufferSize - 1] of Byte;
I: Integer;
X, Y: Integer;
OldPos: Int64;
begin
Result := 0;
SetLength(HashList, Max(Length(HashList), IfThen(Stream.Size mod HashSize = 0,
Stream.Size div HashSize, Succ(Stream.Size div HashSize))));
OldPos := Stream.Position;
Stream.Position := 0;
try
for I := Low(HashList) to High(HashList) do
begin
HashList[I].Size := 0;
HashList[I].Hash := 0;
X := HashSize;
Y := Stream.Read(Buffer[0], Min(X, BufferSize));
while Y > 0 do
begin
Inc(HashList[I].Size, Y);
HashList[I].Hash := Utils.Hash32(HashList[I].Hash, @Buffer[0], Y);
Dec(X, Y);
Y := Stream.Read(Buffer[0], Min(X, BufferSize));
end;
Inc(Result);
if HashList[I].Size = 0 then
break;
end;
finally
Stream.Position := OldPos;
end;
end;
procedure Encode(Input1, Input2, Output: String; Options: TEncodeOptions);
const
BufferSize = 65536;
@ -117,8 +163,9 @@ var
LSInfo: PScanInfo;
LEntry: TEntryStruct;
LBytes: TBytes;
LMD5: TMD5;
Hash: TMD5Digest;
Hash: Cardinal;
HashList: TArray<THashStruct>;
HashCount: Integer;
FStream: TFileStream;
OStream, MStream: TMemoryStream;
DataStore: TDataStore1;
@ -219,6 +266,7 @@ begin
E.Position := DataStore.Position(X) + Pos;
E.OldSize := SearchInfo[C, D, Y].Size;
E.NewSize := 0;
E.DepthSize := 0;
InfoStore[X].Add(E);
Inc(Pos, E.OldSize);
F := True;
@ -239,16 +287,19 @@ begin
begin
FStream := TFileStream.Create(LList[I], fmShareDenyNone);
try
HashCount := GenerateHashList(FStream, HashList);
LastStream := 0;
MStream.Position := 0;
Found2 := False;
DataStore.ChangeInput(FStream);
DataStore.Load;
LMD5.Full(DataStore.Slot(0).Memory, MinSize2, Hash);
MStream.WriteBuffer(DataStore.Slot(0).Memory^, Int64.Size);
K := MinSize2;
MStream.WriteBuffer(K, K.Size);
MStream.WriteBuffer(Hash, SizeOf(TMD5Digest));
Hash := Utils.Hash32(0, DataStore.Slot(0).Memory, MinSize2);
MStream.WriteBuffer(DataStore.Slot(0).Memory^, Integer.Size);
MStream.WriteBuffer(PInteger(PByte(DataStore.Slot(0).Memory) +
MinSize2 - Integer.Size)^, Integer.Size);
MStream.WriteBuffer(Hash, Hash.Size);
MStream.WriteBuffer(HashCount, HashCount.Size);
MStream.WriteBuffer(HashList[0], HashCount * SizeOf(THashStruct));
LBytes := BytesOf(Options.Method);
K := Length(LBytes);
MStream.WriteBuffer(K, K.Size);

6
dbgenerator/DbgUtils.pas
View File

@ -12,14 +12,14 @@ resourcestring
SPrecompSep3 = ',';
const
XTOOL_DB = $42445458;
XTOOL_DB = $31445458;
type
PEntryStruct = ^TEntryStruct;
TEntryStruct = record
TEntryStruct = packed record
Position: Int64;
OldSize, NewSize: Integer;
OldSize, NewSize, DepthSize: Integer;
end;
TEntryStructComparer = class(TComparer<TEntryStruct>)

4
imports/GrittibanzliDLL.pas
View File

@ -26,11 +26,9 @@ begin
'grittibanzli_dll.dll'));
if DLLHandle >= 32 then
begin
DLLLoaded := True;
@Grittibanzli := GetProcAddress(DLLHandle, '__Grittibanzli');
Assert(@Grittibanzli <> nil);
@Ungrittibanzli := GetProcAddress(DLLHandle, '__Ungrittibanzli');
Assert(@Ungrittibanzli <> nil);
DLLLoaded := Assigned(Grittibanzli) and Assigned(Ungrittibanzli);
end
else
DLLLoaded := False;

54
imports/LZ4DLL.pas
View File

@ -4,7 +4,7 @@ interface
uses
WinAPI.Windows,
System.SysUtils, System.Classes;
System.SysUtils;
const
LZ4F_VERSION = 100;
@ -13,15 +13,18 @@ type
LZ4F_errorCode_t = type size_t;
LZ4F_blockSizeID_t = (LZ4F_default = 0, LZ4F_max64KB = 4, LZ4F_max256KB = 5,
LZ4F_max1MB = 6, LZ4F_max4MB = 7);
LZ4F_blockMode_t = (LZ4F_blockLinked = 0, LZ4F_blockIndependent);
LZ4F_max1MB = 6, LZ4F_max4MB = 7, LZ4F_blockSizeID_Force32 = $40000000);
LZ4F_blockMode_t = (LZ4F_blockLinked = 0, LZ4F_blockIndependent,
LZ4F_blockMode_Force32 = $40000000);
LZ4F_contentChecksum_t = (LZ4F_noContentChecksum = 0,
LZ4F_contentChecksumEnabled);
LZ4F_contentChecksumEnabled, LZ4F_contentChecksum_Force32 = $40000000);
LZ4F_blockChecksum_t = (LZ4F_noBlockChecksum = 0, LZ4F_blockChecksumEnabled);
LZ4F_blockChecksum_t = (LZ4F_noBlockChecksum = 0, LZ4F_blockChecksumEnabled,
LZ4F_blockChecksum_Force32 = $40000000);
LZ4F_frameType_t = (LZ4F_frame = 0, LZ4F_skippableFrame);
LZ4F_frameType_t = (LZ4F_frame = 0, LZ4F_skippableFrame,
LZ4F_frameType_Force32 = $40000000);
LZ4F_frameInfo_t = record
blockSizeID: LZ4F_blockSizeID_t;
@ -64,8 +67,8 @@ var
LZ4_compress_HC: function(const src: Pointer; dst: Pointer; srcSize: Integer;
maxDstSize: Integer; compressionLevel: Integer): Integer cdecl;
LZ4F_compressFrame: function(dstBuffer: Pointer; dstCapacity: size_t;
srcBuffer: Pointer; srcSize: size_t;
const preferencesPtr: LZ4F_preferences_t): size_t cdecl;
srcBuffer: Pointer; srcSize: size_t; preferencesPtr: PLZ4F_preferences_t)
: size_t cdecl;
LZ4F_compressFrameBound: function(srcSize: size_t;
preferencesPtr: PLZ4F_preferences_t): size_t cdecl;
LZ4F_createDecompressionContext: function(out dctxPtr: LZ4F_dctx;
@ -88,41 +91,29 @@ implementation
var
DLLHandle: THandle;
procedure Init;
procedure Init(Filename: String);
begin
if DLLLoaded then
Exit;
DLLHandle := 0;
DLLHandle := LoadLibrary(PWideChar(ExtractFilePath(ParamStr(0)) +
'liblz4.dll'));
DLLHandle := LoadLibrary(PWideChar(ExtractFilePath(ParamStr(0)) + Filename));
if DLLHandle >= 32 then
begin
DLLLoaded := True;
@LZ4_decompress_safe := GetProcAddress(DLLHandle, 'LZ4_decompress_safe');
Assert(@LZ4_decompress_safe <> nil);
@LZ4_decompress_fast := GetProcAddress(DLLHandle, 'LZ4_decompress_fast');
Assert(@LZ4_decompress_fast <> nil);
@LZ4_compress_default := GetProcAddress(DLLHandle, 'LZ4_compress_default');
Assert(@LZ4_compress_default <> nil);
@LZ4_compress_fast := GetProcAddress(DLLHandle, 'LZ4_compress_fast');
Assert(@LZ4_compress_fast <> nil);
@LZ4_compress_HC := GetProcAddress(DLLHandle, 'LZ4_compress_HC');
Assert(@LZ4_compress_HC <> nil);
@LZ4F_compressFrame := GetProcAddress(DLLHandle, 'LZ4F_compressFrame');
Assert(@LZ4F_compressFrame <> nil);
@LZ4F_compressFrameBound := GetProcAddress(DLLHandle,
'LZ4F_compressFrameBound');
Assert(@LZ4F_compressFrameBound <> nil);
@LZ4F_createDecompressionContext := GetProcAddress(DLLHandle,
'LZ4F_createDecompressionContext');
Assert(@LZ4F_createDecompressionContext <> nil);
@LZ4F_freeDecompressionContext := GetProcAddress(DLLHandle,
'LZ4F_freeDecompressionContext');
Assert(@LZ4F_freeDecompressionContext <> nil);
@LZ4F_decompress := GetProcAddress(DLLHandle, 'LZ4F_decompress');
Assert(@LZ4F_decompress <> nil);
@LZ4F_getFrameInfo := GetProcAddress(DLLHandle, 'LZ4F_getFrameInfo');
Assert(@LZ4F_getFrameInfo <> nil);
DLLLoaded := Assigned(LZ4_decompress_safe);
end
else
DLLLoaded := False;
@ -157,9 +148,24 @@ begin
end;
end;
const
DLLParam = '--lz4=';
var
I: Integer;
DLLFile: String;
initialization
Init;
DLLFile := 'liblz4.dll';
for I := 1 to ParamCount do
if ParamStr(I).StartsWith(DLLParam) then
begin
DLLFile := ParamStr(I).Substring(DLLParam.Length);
break;
end;
Init(DLLFile);
finalization

43
imports/LZODLL.pas
View File

@ -104,50 +104,29 @@ begin
compression_level);
end;
procedure Init;
procedure Init(Filename: String);
begin
if DLLLoaded then
Exit;
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + 'lzo2.dll'));
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename));
if DLLHandle >= 32 then
begin
DLLLoaded := True;
@lzo1x_1_compress := GetProcAddress(DLLHandle, 'lzo1x_1_compress');
Assert(@lzo1x_1_compress <> nil);
@lzo1x_1_11_compress := GetProcAddress(DLLHandle, 'lzo1x_1_11_compress');
Assert(@lzo1x_1_11_compress <> nil);
@lzo1x_1_12_compress := GetProcAddress(DLLHandle, 'lzo1x_1_12_compress');
Assert(@lzo1x_1_12_compress <> nil);
@lzo1x_1_15_compress := GetProcAddress(DLLHandle, 'lzo1x_1_15_compress');
Assert(@lzo1x_1_15_compress <> nil);
@lzo1x_999_compress := GetProcAddress(DLLHandle, 'lzo1x_999_compress');
Assert(@lzo1x_999_compress <> nil);
@lzo1x_999_compress_level := GetProcAddress(DLLHandle,
'lzo1x_999_compress_level');
Assert(@lzo1x_999_compress_level <> nil);
@lzo1x_decompress_safe := GetProcAddress(DLLHandle,
'lzo1x_decompress_safe');
Assert(@lzo1x_decompress_safe <> nil);
@lzo1c_999_compress := GetProcAddress(DLLHandle, 'lzo1c_999_compress');
Assert(@lzo1c_999_compress <> nil);
@lzo1c_decompress_safe := GetProcAddress(DLLHandle,
'lzo1c_decompress_safe');
Assert(@lzo1c_decompress_safe <> nil);
@lzo2a_999_compress := GetProcAddress(DLLHandle, 'lzo2a_999_compress');
Assert(@lzo2a_999_compress <> nil);
@lzo2a_decompress_safe := GetProcAddress(DLLHandle,
'lzo2a_decompress_safe');
Assert(@lzo2a_decompress_safe <> nil);
(* if Length(lzoprodll) > 0 then
begin
MDLLHandle := MemoryLoadLibary(@lzoprodll[0]);
@lzopro_lzo1x_w03_15_compress := MemoryGetProcAddress(MDLLHandle,
'lzopro_lzo1x_w03_15_compress');
Assert(@lzopro_lzo1x_w03_15_compress <> nil);
@lzopro_lzo1x_99_compress := MemoryGetProcAddress(MDLLHandle,
'lzopro_lzo1x_99_compress');
Assert(@lzopro_lzo1x_99_compress <> nil);
end; *)
DLLLoaded := Assigned(lzo1x_decompress_safe);
end
else
DLLLoaded := False;
@ -160,9 +139,23 @@ begin
FreeLibrary(DLLHandle);
end;
const
DLLParam = '--lzo=';
var
I: integer;
DLLFile: String;
initialization
Init;
DLLFile := 'lzo2.dll';
for I := 1 to ParamCount do
if ParamStr(I).StartsWith(DLLParam) then
begin
DLLFile := ParamStr(I).Substring(DLLParam.Length);
break;
end;
Init(DLLFile);
finalization

28
imports/OodleDLL.pas
View File

@ -77,7 +77,7 @@ var
OldGetCompressedBufferSizeNeeded: Boolean;
DLLs: TStringDynArray;
procedure Init;
procedure Init(Filename: String);
var
I: Integer;
C: Cardinal;
@ -86,6 +86,7 @@ begin
Exit;
DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'oo2core*.dll',
TSearchOption.soTopDirectoryOnly);
Insert(ExtractFilePath(ParamStr(0)) + Filename, DLLs, 0);
for I := Low(DLLs) to High(DLLs) do
begin
DLLHandle := LoadLibrary(PChar(DLLs[I]));
@ -107,8 +108,6 @@ begin
begin
DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'oodle2*.dll',
TSearchOption.soTopDirectoryOnly);
SetLength(DLLs, Succ(Length(DLLs)));
DLLs[Pred(Length(DLLs))] := ExtractFilePath(ParamStr(0)) + 'oodle.dll';
for I := Low(DLLs) to High(DLLs) do
begin
DLLHandle := LoadLibrary(PChar(DLLs[I]));
@ -118,7 +117,6 @@ begin
end;
if DLLHandle >= 32 then
begin
DLLLoaded := True;
Oodle_CheckVersion := GetProcAddress(DLLHandle, 'Oodle_CheckVersion');
if not Assigned(Oodle_CheckVersion) then
for I := 0 to 32 do
@ -128,7 +126,7 @@ begin
if Assigned(Oodle_CheckVersion) then
break;
end;
Assert(@Oodle_CheckVersion <> nil);
DLLLoaded := Assigned(Oodle_CheckVersion);
Oodle_CheckVersion(0, @C);
OldCompress := LongRec(C).Hi < $2E06;
OldGetCompressedBufferSizeNeeded := LongRec(C).Hi < $2E08;
@ -142,7 +140,6 @@ begin
if Assigned(OodleLZ_Compress_1) then
break;
end;
Assert(@OodleLZ_Compress_1 <> nil);
@OodleLZ_Compress_2 := @OodleLZ_Compress_1;
OodleLZ_Decompress := GetProcAddress(DLLHandle, 'OodleLZ_Decompress');
if not Assigned(OodleLZ_Decompress) then
@ -153,7 +150,6 @@ begin
if Assigned(OodleLZ_Decompress) then
break;
end;
Assert(@OodleLZ_Decompress <> nil);
OodleLZ_CompressOptions_GetDefault_1 := GetProcAddress(DLLHandle,
'OodleLZ_CompressOptions_GetDefault');
if not Assigned(OodleLZ_CompressOptions_GetDefault_1) then
@ -165,7 +161,6 @@ begin
if Assigned(OodleLZ_CompressOptions_GetDefault_1) then
break;
end;
Assert(@OodleLZ_CompressOptions_GetDefault_1 <> nil);
@OodleLZ_CompressOptions_GetDefault_2 :=
@OodleLZ_CompressOptions_GetDefault_1;
OodleLZ_GetCompressedBufferSizeNeeded_1 :=
@ -179,7 +174,6 @@ begin
if Assigned(OodleLZ_GetCompressedBufferSizeNeeded_1) then
break;
end;
Assert(@OodleLZ_GetCompressedBufferSizeNeeded_1 <> nil);
@OodleLZ_GetCompressedBufferSizeNeeded_2 :=
@OodleLZ_GetCompressedBufferSizeNeeded_1;
end
@ -225,9 +219,23 @@ begin
Result := OodleLZ_GetCompressedBufferSizeNeeded_2(compressor, rawSize);
end;
const
DLLParam = '--oodle=';
var
I: Integer;
DLLFile: String;
initialization
Init;
DLLFile := 'oodle.dll';
for I := 1 to ParamCount do
if ParamStr(I).StartsWith(DLLParam) then
begin
DLLFile := ParamStr(I).Substring(DLLParam.Length);
break;
end;
Init(DLLFile);
finalization

4
imports/PreflateDLL.pas
View File

@ -26,11 +26,9 @@ begin
'preflate_dll.dll'));
if DLLHandle >= 32 then
begin
DLLLoaded := True;
@preflate_decode := GetProcAddress(DLLHandle, 'decode');
Assert(@preflate_decode <> nil);
@preflate_reencode := GetProcAddress(DLLHandle, 'reencode');
Assert(@preflate_reencode <> nil);
DLLLoaded := Assigned(preflate_decode) and Assigned(preflate_reencode);
end
else
DLLLoaded := False;

15
imports/ReflateDLL.pas
View File

@ -35,33 +35,20 @@ begin
'HIF2RAW_DLL.DLL'));
if (DLLHandle1 >= 32) and (DLLHandle2 >= 32) then
begin
DLLLoaded := True;
@raw2hif_Alloc := GetProcAddress(DLLHandle1, 'raw2hif_Alloc');
Assert(@raw2hif_Alloc <> nil);
@raw2hif_Free := GetProcAddress(DLLHandle1, 'raw2hif_Free');
Assert(@raw2hif_Free <> nil);
@raw2hif_Init := GetProcAddress(DLLHandle1, 'raw2hif_Init');
Assert(@raw2hif_Init <> nil);
@raw2hif_Loop := GetProcAddress(DLLHandle1, 'raw2hif_Loop');
Assert(@raw2hif_Loop <> nil);
@raw2hif_getoutlen := GetProcAddress(DLLHandle1, 'raw2hif_getoutlen');
Assert(@raw2hif_getoutlen <> nil);
@raw2hif_getou2len := GetProcAddress(DLLHandle1, 'raw2hif_getou2len');
Assert(@raw2hif_getou2len <> nil);
@raw2hif_addbuf := GetProcAddress(DLLHandle1, 'raw2hif_addbuf');
Assert(@raw2hif_addbuf <> nil);
@hif2raw_Alloc := GetProcAddress(DLLHandle2, 'hif2raw_Alloc');
Assert(@hif2raw_Alloc <> nil);
@hif2raw_Free := GetProcAddress(DLLHandle2, 'hif2raw_Free');
Assert(@hif2raw_Free <> nil);
@hif2raw_Init := GetProcAddress(DLLHandle2, 'hif2raw_Init');
Assert(@hif2raw_Init <> nil);
@hif2raw_Loop := GetProcAddress(DLLHandle2, 'hif2raw_Loop');
Assert(@hif2raw_Loop <> nil);
@hif2raw_getoutlen := GetProcAddress(DLLHandle2, 'hif2raw_getoutlen');
Assert(@hif2raw_getoutlen <> nil);
@hif2raw_addbuf := GetProcAddress(DLLHandle2, 'hif2raw_addbuf');
Assert(@hif2raw_addbuf <> nil);
DLLLoaded := Assigned(raw2hif_Alloc) and Assigned(hif2raw_Alloc);
end
else
DLLLoaded := False;

34
imports/ZLibDLL.pas
View File

@ -90,7 +90,7 @@ var
WinAPIDLL: boolean;
DLLs: TStringDynArray;
procedure Init;
procedure Init(Filename: String);
var
I: integer;
begin
@ -99,6 +99,7 @@ begin
DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'zlib*.dll',
TSearchOption.soTopDirectoryOnly);
Insert(ExtractFilePath(ParamStr(0)) + 'zlib.dll', DLLs, Length(DLLs));
Insert(ExtractFilePath(ParamStr(0)) + Filename, DLLs, 0);
for I := Low(DLLs) to High(DLLs) do
begin
DLLHandle := LoadLibrary(PChar(DLLs[I]));
@ -110,31 +111,25 @@ begin
begin
DLLLoaded := True;
@_zlibVersion := GetProcAddress(DLLHandle, 'zlibVersion');
Assert(@_zlibVersion <> nil);
@_zlibCompileFlags := GetProcAddress(DLLHandle, 'zlibCompileFlags');
Assert(@_zlibCompileFlags <> nil);
DLLLoaded := Assigned(_zlibVersion) and Assigned(_zlibCompileFlags);
if DLLLoaded then
begin
WinAPIDLL := _zlibCompileFlags and $400 = $400;
if WinAPIDLL then
begin
@s_deflateInit2_ := GetProcAddress(DLLHandle, 'deflateInit2_');
Assert(@s_deflateInit2_ <> nil);
@s_deflate := GetProcAddress(DLLHandle, 'deflate');
Assert(@s_deflate <> nil);
@s_deflateEnd := GetProcAddress(DLLHandle, 'deflateEnd');
Assert(@s_deflateEnd <> nil);
@s_deflateReset := GetProcAddress(DLLHandle, 'deflateReset');
Assert(@s_deflateReset <> nil);
end
else
begin
@c_deflateInit2_ := GetProcAddress(DLLHandle, 'deflateInit2_');
Assert(@c_deflateInit2_ <> nil);
@c_deflate := GetProcAddress(DLLHandle, 'deflate');
Assert(@c_deflate <> nil);
@c_deflateEnd := GetProcAddress(DLLHandle, 'deflateEnd');
Assert(@c_deflateEnd <> nil);
@c_deflateReset := GetProcAddress(DLLHandle, 'deflateReset');
Assert(@c_deflateReset <> nil);
end;
end;
end
else
@ -204,9 +199,24 @@ begin
FreeLibrary(DLLHandle);
end;
const
DLLParam = '--zlib=';
var
I: integer;
DLLFile: String;
initialization
Init;
DLLFile := 'zlibwapi.dll';
for I := 1 to ParamCount do
if ParamStr(I).StartsWith(DLLParam) then
begin
DLLFile := ParamStr(I).Substring(DLLParam.Length);
break;
end;
Init(DLLFile);
finalization

99
imports/ZSTDDLL.pas
View File

@ -100,31 +100,6 @@ var
dstCapacity: size_t; const src: Pointer; srcSize: size_t;
const ddict: Pointer): size_t cdecl;
ZSTD_getParams: function(compressionLevel: Integer; estimatedSrcSize: UInt64;
dictSize: size_t): ZSTD_parameters cdecl;
ZSTD_initCStream: function(zcs: Pointer; compressionLevel: Integer)
: size_t cdecl;
ZSTD_initCStream_advanced: function(zcs: Pointer; const dict: Pointer;
dictSize: size_t; params: ZSTD_parameters; pledgedSrcSize: UInt64)
: size_t cdecl;
ZSTD_compressStream: function(zcs: Pointer; output: PZSTD_outBuffer;
input: PZSTD_inBuffer): size_t cdecl;
ZSTD_flushStream: function(zcs: Pointer; output: PZSTD_outBuffer)
: size_t cdecl;
ZSTD_endStream: function(zcs: Pointer; output: PZSTD_outBuffer): size_t cdecl;
ZSTD_createCCtxParams: function: PZSTD_CCtx_params cdecl;
ZSTD_freeCCtxParams: function(params: PZSTD_CCtx_params): size_t cdecl;
ZSTD_CCtxParams_reset: function(params: PZSTD_CCtx_params): size_t cdecl;
ZSTD_CCtxParams_init: function(cctxParams: PZSTD_CCtx_params;
compressionLevel: Integer): size_t cdecl;
ZSTD_CCtx_setParameter: function(params: PZSTD_CCtx_params;
param: ZSTD_cParameter; value: Integer): size_t cdecl;
ZSTD_CCtx_setParametersUsingCCtxParams: function(cctx: Pointer;
const params: PZSTD_CCtx_params): size_t cdecl;
ZSTD_CStreamInSize: function: size_t cdecl;
ZSTD_CStreamOutSize: function: size_t cdecl;
DLLLoaded: Boolean = False;
function ZSTD_compress_dict(cctx: Pointer; dst: Pointer; dstCapacity: size_t;
@ -155,86 +130,34 @@ end;
var
DLLHandle: THandle;
procedure Init;
procedure Init(Filename: String);
begin
if DLLLoaded then
Exit;
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + 'libzstd.dll'));
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename));
if DLLHandle >= 32 then
begin
DLLLoaded := True;
@ZSTD_compress := GetProcAddress(DLLHandle, 'ZSTD_compress');
Assert(@ZSTD_compress <> nil);
@ZSTD_decompress := GetProcAddress(DLLHandle, 'ZSTD_decompress');
Assert(@ZSTD_decompress <> nil);
@ZSTD_findFrameCompressedSize := GetProcAddress(DLLHandle,
'ZSTD_findFrameCompressedSize');
Assert(@ZSTD_findFrameCompressedSize <> nil);
@ZSTD_findDecompressedSize := GetProcAddress(DLLHandle,
'ZSTD_findDecompressedSize');
Assert(@ZSTD_findDecompressedSize <> nil);
@ZSTD_createCCtx := GetProcAddress(DLLHandle, 'ZSTD_createCCtx');
Assert(@ZSTD_createCCtx <> nil);
@ZSTD_freeCCtx := GetProcAddress(DLLHandle, 'ZSTD_freeCCtx');
Assert(@ZSTD_freeCCtx <> nil);
@ZSTD_createDCtx := GetProcAddress(DLLHandle, 'ZSTD_createDCtx');
Assert(@ZSTD_createDCtx <> nil);
@ZSTD_freeDCtx := GetProcAddress(DLLHandle, 'ZSTD_freeDCtx');
Assert(@ZSTD_freeDCtx <> nil);
@ZSTD_createCDict := GetProcAddress(DLLHandle, 'ZSTD_createCDict');
Assert(@ZSTD_createCDict <> nil);
@ZSTD_freeCDict := GetProcAddress(DLLHandle, 'ZSTD_freeCDict');
Assert(@ZSTD_freeCDict <> nil);
@ZSTD_compressCCtx := GetProcAddress(DLLHandle, 'ZSTD_compressCCtx');
Assert(@ZSTD_compressCCtx <> nil);
@ZSTD_createDDict := GetProcAddress(DLLHandle, 'ZSTD_createDDict');
Assert(@ZSTD_createDDict <> nil);
@ZSTD_freeDDict := GetProcAddress(DLLHandle, 'ZSTD_freeDDict');
Assert(@ZSTD_freeDDict <> nil);
@ZSTD_decompressDCtx := GetProcAddress(DLLHandle, 'ZSTD_decompressDCtx');
Assert(@ZSTD_decompressDCtx <> nil);
@ZSTD_compress_usingCDict := GetProcAddress(DLLHandle,
'ZSTD_compress_usingCDict');
Assert(@ZSTD_compress_usingCDict <> nil);
@ZSTD_decompress_usingDDict := GetProcAddress(DLLHandle,
'ZSTD_decompress_usingDDict');
Assert(@ZSTD_decompress_usingDDict <> nil);
@ZSTD_getParams := GetProcAddress(DLLHandle, 'ZSTD_getParams');
Assert(@ZSTD_getParams <> nil);
@ZSTD_initCStream := GetProcAddress(DLLHandle, 'ZSTD_initCStream');
Assert(@ZSTD_initCStream <> nil);
@ZSTD_initCStream_advanced := GetProcAddress(DLLHandle,
'ZSTD_initCStream_advanced');
Assert(@ZSTD_initCStream_advanced <> nil);
@ZSTD_compressStream := GetProcAddress(DLLHandle, 'ZSTD_compressStream');
Assert(@ZSTD_compressStream <> nil);
@ZSTD_flushStream := GetProcAddress(DLLHandle, 'ZSTD_flushStream');
Assert(@ZSTD_flushStream <> nil);
@ZSTD_endStream := GetProcAddress(DLLHandle, 'ZSTD_endStream');
Assert(@ZSTD_endStream <> nil);
@ZSTD_CStreamInSize := GetProcAddress(DLLHandle, 'ZSTD_CStreamInSize');
Assert(@ZSTD_CStreamInSize <> nil);
@ZSTD_CStreamOutSize := GetProcAddress(DLLHandle, 'ZSTD_CStreamOutSize');
Assert(@ZSTD_CStreamOutSize <> nil);
@ZSTD_createCCtxParams := GetProcAddress(DLLHandle,
'ZSTD_createCCtxParams');
Assert(@ZSTD_createCCtxParams <> nil);
@ZSTD_freeCCtxParams := GetProcAddress(DLLHandle, 'ZSTD_freeCCtxParams');
Assert(@ZSTD_freeCCtxParams <> nil);
@ZSTD_CCtxParams_reset := GetProcAddress(DLLHandle,
'ZSTD_CCtxParams_reset');
Assert(@ZSTD_CCtxParams_reset <> nil);
@ZSTD_CCtxParams_init := GetProcAddress(DLLHandle, 'ZSTD_CCtxParams_init');
Assert(@ZSTD_CCtxParams_init <> nil);
@ZSTD_CCtx_setParameter := GetProcAddress(DLLHandle,
'ZSTD_CCtx_setParameter');
Assert(@ZSTD_CCtx_setParameter <> nil);
@ZSTD_CCtx_setParametersUsingCCtxParams :=
GetProcAddress(DLLHandle, 'ZSTD_CCtx_setParametersUsingCCtxParams');
Assert(@ZSTD_CCtx_setParametersUsingCCtxParams <> nil);
DLLLoaded := Assigned(ZSTD_compress) and Assigned(ZSTD_decompress);
end
else
DLLLoaded := False;
@ -247,9 +170,23 @@ begin
FreeLibrary(DLLHandle);
end;
const
DLLParam = '--zstd=';
var
I: Integer;
DLLFile: String;
initialization
Init;
DLLFile := 'libzstd.dll';
for I := 1 to ParamCount do
if ParamStr(I).StartsWith(DLLParam) then
begin
DLLFile := ParamStr(I).Substring(DLLParam.Length);
break;
end;
Init(DLLFile);
finalization

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;

265
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);
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,11 +217,12 @@ begin
CloseHandleEx(hstdinw);
FTask.Wait;
CloseHandleEx(hstdoutr);
end;
Result := GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode) and
(dwExitCode = 0);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);
CloseHandleEx(ProcessInfo.hProcess);
end;
Result := dwExitCode = 0;
end;
end
else
begin
@ -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,12 +694,15 @@ 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
for K := Low(List) to High(List) do
begin
New(ExeStruct);
Insert(SL[I], Codec.Names, Length(Codec.Names));
ExeStruct^.Name := SL[I];
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
@ -623,11 +712,12 @@ begin
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) do
for J := 1 to GetCmdCount(S1) - 1 do
begin
S2 := GetCmdStr(S1, J);
if ContainsText(S2, '<library>') then
@ -649,34 +739,51 @@ begin
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);
ExeStruct^.InFile := S2;
ExeStruct^.InFile := ReplaceStr(ExeStruct^.InFile,
'<filein>', FILE_IN);
ExeStruct^.InFile := ReplaceStr(ExeStruct^.InFile,
'[filein]', FILE_IN);
if ContainsText(S2, '[filein]') then
continue;
end
else if ContainsText(S2, '<fileout>') or ContainsText(S2, '[fileout]')
then
if ContainsText(S2, '<filein>') 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
continue;
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;
S2 := IfThen(Pos(' ', S2) > 0, '"' + S2 + '"', S2);
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;
ExeStruct^.Param[X] := Trim(ExeStruct^.Param[X]);
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.

31
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
Inc(Pos);
continue;
end;
for Y := Low(Conditions) to High(Conditions) do
if Round(Parser.Evaluate(Conditions[Y])) = 0 then
begin
Status := TScanStatus.Fail;
break;
end;
if (Length(Conditions) = 0) or (Y = High(Conditions)) then
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,9 +425,6 @@ 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);
end
else
@ -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

92
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,32 +263,46 @@ 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:
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
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:
begin
Params := '';
Res1 := LZ4_compress_default(Input, Buffer, StreamInfo.NewSize,
LZ4F_compressFrameBound(StreamInfo.NewSize, nil));
end;
LZ4HC_CODEC:
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);

42
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:
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,24 +320,19 @@ 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
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:
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);

152
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,6 +2070,7 @@ begin
Stopwatch := TStopwatch.Create;
Stopwatch.Start;
ConTask.Perform(EncodeStats);
if not VERBOSE then
ConTask.Start;
try
EncInit(Input, Output, @Options);
@ -1947,6 +2082,8 @@ begin
Stopwatch.Stop;
end;
end;
if VERBOSE then
EncodeStats;
ConTask.Wait;
ConTask.Free;
InternalSync.Leave;
@ -1960,6 +2097,7 @@ begin
Stopwatch := TStopwatch.Create;
Stopwatch.Start;
ConTask.Perform(DecodeStats);
if not VERBOSE then
ConTask.Start;
NStream := TArrayStream.Create;
try
@ -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

274
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
begin
if (PWord(Buff + BlkSize + 2)^ = (((Buff + 1)^ shl 8) + $4C)) or
((First = True) and ((Buff + BlkSize + 2)^ in [$0C, $4C])) then
if (StreamInfo^.CSize + BlkSize + 3 <= Size) and
((Buff + BlkSize + 2)^ in [$0C, $4C]) and
((Buff + BlkSize + 3)^ = (Buff + 1)^) then
begin
Inc(StreamInfo^.CSize, BlkSize + 2);
Inc(StreamInfo^.DSize, BlkSize);
end;
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;
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,7 +428,23 @@ begin
SetBits(SI.Option, HYDRA_CODEC, 0, 5);
SetBits(SI.Option, Integer(StreamInfo^.HasCRC), 12, 1);
SI.Status := TStreamStatus.None;
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;
@ -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,23 +718,25 @@ 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
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;

140
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);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdoutw);
try
while ReadFile(hstdoutr, Buffer, Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(Instance, @Buffer[0], BytesRead);
CloseHandle(hstdoutr);
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);
CloseHandleEx(ProcessInfo.hThread);
CloseHandleEx(hstdinr);
CloseHandleEx(hstdoutw);
try
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
CloseHandleEx(hstdinw);
while ReadFile(hstdoutr, Buffer[0], Length(Buffer), BytesRead, nil) and
(BytesRead > 0) do
Output(Instance, @Buffer[0], BytesRead);
CloseHandle(hstdoutr);
Result := True;
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;
try
FileWriteBuffer(hstdinw, InBuff^, InSize);
CloseHandle(hstdinw);
finally
CloseHandleEx(hstdinw);
LTask.Wait;
if LTask.Status <> TThreadStatus.tsErrored then
LTask.Free;
CloseHandle(hstdoutr);
Result := True;
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;

103
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,7 +87,6 @@ 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'));
end
else if (CompareText(S, ZlibCodecs[PREFLATE_CODEC]) = 0) and PreflateDLL.DLLLoaded
@ -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;

47
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:
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);

35
xtool.dpr
View File

@ -186,6 +186,39 @@ begin
end;
{ changelog
ES_R29 (0.4.7)
- updated oodle scanner
- updated external executable support
- updated configuration based plugin support to add depth information
- updated verbose mode
ES_R28 (0.4.6)
- generate database feature fixed
- fixed external executable support issues
- fixed lz4f level setting bug
ES_R28 (0.4.5)
- removed leviathan codec restriction
ES_R27 (0.4.4)
- fixed issue of lz4 codec loading incorrect library
- fixed issue with handling endianess via configuration based plugins
- updated framework of library based plugins
ES_R26 (0.4.3)
- added verbose mode
- added feature that allows you to enforce a different library to be loaded
- fixed issues related to imperfect stream patching
- fixed issues with old libraries with missing functions that cause xtool to crash on startup
- updated oodle codec
- updated reflate codec
- updated zstd codec
ES_R25 (0.4.2)
- removed debugging code from encryption and executable codec
- fixed issue with depth when using search codec
- fixed external executable support issues
ES_R24 (0.4.1)
- fixed issue of status not reporting when encoding
- added depth method support for search support
@ -195,6 +228,8 @@ end;
- updated lz4f codec and removed temporarily removed support for universal scanning
- added option to change recompression level to be used by reflate
- updated external executable support
- generate database feature currently bugged, wait for next update
- search database structure changed, older database files will no longer work with newer releases
ES_R23 (0.4.0)
- project made open source