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

67
dbgenerator/DbgMain.pas
View File

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

6
dbgenerator/DbgUtils.pas
View File

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

4
imports/GrittibanzliDLL.pas
View File

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

54
imports/LZ4DLL.pas
View File

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

43
imports/LZODLL.pas
View File

@ -104,50 +104,29 @@ begin
compression_level); compression_level);
end; end;
procedure Init; procedure Init(Filename: String);
begin begin
if DLLLoaded then if DLLLoaded then
Exit; Exit;
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + 'lzo2.dll')); DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename));
if DLLHandle >= 32 then if DLLHandle >= 32 then
begin begin
DLLLoaded := True;
@lzo1x_1_compress := GetProcAddress(DLLHandle, 'lzo1x_1_compress'); @lzo1x_1_compress := GetProcAddress(DLLHandle, 'lzo1x_1_compress');
Assert(@lzo1x_1_compress <> nil);
@lzo1x_1_11_compress := GetProcAddress(DLLHandle, 'lzo1x_1_11_compress'); @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'); @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'); @lzo1x_1_15_compress := GetProcAddress(DLLHandle, 'lzo1x_1_15_compress');
Assert(@lzo1x_1_15_compress <> nil);
@lzo1x_999_compress := GetProcAddress(DLLHandle, 'lzo1x_999_compress'); @lzo1x_999_compress := GetProcAddress(DLLHandle, 'lzo1x_999_compress');
Assert(@lzo1x_999_compress <> nil);
@lzo1x_999_compress_level := GetProcAddress(DLLHandle, @lzo1x_999_compress_level := GetProcAddress(DLLHandle,
'lzo1x_999_compress_level'); 'lzo1x_999_compress_level');
Assert(@lzo1x_999_compress_level <> nil);
@lzo1x_decompress_safe := GetProcAddress(DLLHandle, @lzo1x_decompress_safe := GetProcAddress(DLLHandle,
'lzo1x_decompress_safe'); 'lzo1x_decompress_safe');
Assert(@lzo1x_decompress_safe <> nil);
@lzo1c_999_compress := GetProcAddress(DLLHandle, 'lzo1c_999_compress'); @lzo1c_999_compress := GetProcAddress(DLLHandle, 'lzo1c_999_compress');
Assert(@lzo1c_999_compress <> nil);
@lzo1c_decompress_safe := GetProcAddress(DLLHandle, @lzo1c_decompress_safe := GetProcAddress(DLLHandle,
'lzo1c_decompress_safe'); 'lzo1c_decompress_safe');
Assert(@lzo1c_decompress_safe <> nil);
@lzo2a_999_compress := GetProcAddress(DLLHandle, 'lzo2a_999_compress'); @lzo2a_999_compress := GetProcAddress(DLLHandle, 'lzo2a_999_compress');
Assert(@lzo2a_999_compress <> nil);
@lzo2a_decompress_safe := GetProcAddress(DLLHandle, @lzo2a_decompress_safe := GetProcAddress(DLLHandle,
'lzo2a_decompress_safe'); 'lzo2a_decompress_safe');
Assert(@lzo2a_decompress_safe <> nil); DLLLoaded := Assigned(lzo1x_decompress_safe);
(* 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; *)
end end
else else
DLLLoaded := False; DLLLoaded := False;
@ -160,9 +139,23 @@ begin
FreeLibrary(DLLHandle); FreeLibrary(DLLHandle);
end; end;
const
DLLParam = '--lzo=';
var
I: integer;
DLLFile: String;
initialization 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 finalization

28
imports/OodleDLL.pas
View File

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

4
imports/PreflateDLL.pas
View File

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

15
imports/ReflateDLL.pas
View File

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

34
imports/ZLibDLL.pas
View File

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

99
imports/ZSTDDLL.pas
View File

@ -100,31 +100,6 @@ var
dstCapacity: size_t; const src: Pointer; srcSize: size_t; dstCapacity: size_t; const src: Pointer; srcSize: size_t;
const ddict: Pointer): size_t cdecl; 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; DLLLoaded: Boolean = False;
function ZSTD_compress_dict(cctx: Pointer; dst: Pointer; dstCapacity: size_t; function ZSTD_compress_dict(cctx: Pointer; dst: Pointer; dstCapacity: size_t;
@ -155,86 +130,34 @@ end;
var var
DLLHandle: THandle; DLLHandle: THandle;
procedure Init; procedure Init(Filename: String);
begin begin
if DLLLoaded then if DLLLoaded then
Exit; Exit;
DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + 'libzstd.dll')); DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename));
if DLLHandle >= 32 then if DLLHandle >= 32 then
begin begin
DLLLoaded := True;
@ZSTD_compress := GetProcAddress(DLLHandle, 'ZSTD_compress'); @ZSTD_compress := GetProcAddress(DLLHandle, 'ZSTD_compress');
Assert(@ZSTD_compress <> nil);
@ZSTD_decompress := GetProcAddress(DLLHandle, 'ZSTD_decompress'); @ZSTD_decompress := GetProcAddress(DLLHandle, 'ZSTD_decompress');
Assert(@ZSTD_decompress <> nil);
@ZSTD_findFrameCompressedSize := GetProcAddress(DLLHandle, @ZSTD_findFrameCompressedSize := GetProcAddress(DLLHandle,
'ZSTD_findFrameCompressedSize'); 'ZSTD_findFrameCompressedSize');
Assert(@ZSTD_findFrameCompressedSize <> nil);
@ZSTD_findDecompressedSize := GetProcAddress(DLLHandle, @ZSTD_findDecompressedSize := GetProcAddress(DLLHandle,
'ZSTD_findDecompressedSize'); 'ZSTD_findDecompressedSize');
Assert(@ZSTD_findDecompressedSize <> nil);
@ZSTD_createCCtx := GetProcAddress(DLLHandle, 'ZSTD_createCCtx'); @ZSTD_createCCtx := GetProcAddress(DLLHandle, 'ZSTD_createCCtx');
Assert(@ZSTD_createCCtx <> nil);
@ZSTD_freeCCtx := GetProcAddress(DLLHandle, 'ZSTD_freeCCtx'); @ZSTD_freeCCtx := GetProcAddress(DLLHandle, 'ZSTD_freeCCtx');
Assert(@ZSTD_freeCCtx <> nil);
@ZSTD_createDCtx := GetProcAddress(DLLHandle, 'ZSTD_createDCtx'); @ZSTD_createDCtx := GetProcAddress(DLLHandle, 'ZSTD_createDCtx');
Assert(@ZSTD_createDCtx <> nil);
@ZSTD_freeDCtx := GetProcAddress(DLLHandle, 'ZSTD_freeDCtx'); @ZSTD_freeDCtx := GetProcAddress(DLLHandle, 'ZSTD_freeDCtx');
Assert(@ZSTD_freeDCtx <> nil);
@ZSTD_createCDict := GetProcAddress(DLLHandle, 'ZSTD_createCDict'); @ZSTD_createCDict := GetProcAddress(DLLHandle, 'ZSTD_createCDict');
Assert(@ZSTD_createCDict <> nil);
@ZSTD_freeCDict := GetProcAddress(DLLHandle, 'ZSTD_freeCDict'); @ZSTD_freeCDict := GetProcAddress(DLLHandle, 'ZSTD_freeCDict');
Assert(@ZSTD_freeCDict <> nil);
@ZSTD_compressCCtx := GetProcAddress(DLLHandle, 'ZSTD_compressCCtx'); @ZSTD_compressCCtx := GetProcAddress(DLLHandle, 'ZSTD_compressCCtx');
Assert(@ZSTD_compressCCtx <> nil);
@ZSTD_createDDict := GetProcAddress(DLLHandle, 'ZSTD_createDDict'); @ZSTD_createDDict := GetProcAddress(DLLHandle, 'ZSTD_createDDict');
Assert(@ZSTD_createDDict <> nil);
@ZSTD_freeDDict := GetProcAddress(DLLHandle, 'ZSTD_freeDDict'); @ZSTD_freeDDict := GetProcAddress(DLLHandle, 'ZSTD_freeDDict');
Assert(@ZSTD_freeDDict <> nil);
@ZSTD_decompressDCtx := GetProcAddress(DLLHandle, 'ZSTD_decompressDCtx'); @ZSTD_decompressDCtx := GetProcAddress(DLLHandle, 'ZSTD_decompressDCtx');
Assert(@ZSTD_decompressDCtx <> nil);
@ZSTD_compress_usingCDict := GetProcAddress(DLLHandle, @ZSTD_compress_usingCDict := GetProcAddress(DLLHandle,
'ZSTD_compress_usingCDict'); 'ZSTD_compress_usingCDict');
Assert(@ZSTD_compress_usingCDict <> nil);
@ZSTD_decompress_usingDDict := GetProcAddress(DLLHandle, @ZSTD_decompress_usingDDict := GetProcAddress(DLLHandle,
'ZSTD_decompress_usingDDict'); 'ZSTD_decompress_usingDDict');
Assert(@ZSTD_decompress_usingDDict <> nil); DLLLoaded := Assigned(ZSTD_compress) and Assigned(ZSTD_decompress);
@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);
end end
else else
DLLLoaded := False; DLLLoaded := False;
@ -247,9 +170,23 @@ begin
FreeLibrary(DLLHandle); FreeLibrary(DLLHandle);
end; end;
const
DLLParam = '--zstd=';
var
I: Integer;
DLLFile: String;
initialization 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 finalization

50
precompressor/PrecompCrypto.pas
View File

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

265
precompressor/PrecompEXE.pas
View File

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

31
precompressor/PrecompINI.pas
View File

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

92
precompressor/PrecompLZ4.pas
View File

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

42
precompressor/PrecompLZO.pas
View File

@ -186,7 +186,7 @@ var
LZOSI: TLZOSI; LZOSI: TLZOSI;
SI: _StrInfo1; SI: _StrInfo1;
DI1, DI2: TDepthInfo; DI1, DI2: TDepthInfo;
DS: TPrecompCmd; DS: TPrecompStr;
begin begin
DI1 := Funcs^.GetDepthInfo(Instance); DI1 := Funcs^.GetDepthInfo(Instance);
DS := Funcs^.GetCodec(DI1.Codec, 0, False); DS := Funcs^.GetCodec(DI1.Codec, 0, False);
@ -216,9 +216,12 @@ begin
SI.Status := TStreamStatus.Predicted SI.Status := TStreamStatus.Predicted
else else
SI.Status := TStreamStatus.None; 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.OldSize := SI.NewSize;
DI2.NewSize := 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); Add(Instance, @SI, DI1.Codec, @DI2);
end; end;
exit; exit;
@ -237,6 +240,8 @@ begin
SI.NewSize := LZOSI.DSize; SI.NewSize := LZOSI.DSize;
SI.Option := 0; SI.Option := 0;
SI.Status := TStreamStatus.None; SI.Status := TStreamStatus.None;
Funcs^.LogScan1(LZOCodecs[GetBits(SI.Option, 0, 5)], SI.Position,
SI.OldSize, SI.NewSize);
Add(Instance, @SI, nil, nil); Add(Instance, @SI, nil, nil);
Inc(Pos, LZOSI.CSize); Inc(Pos, LZOSI.CSize);
continue; continue;
@ -269,6 +274,8 @@ begin
begin begin
StreamInfo^.NewSize := Res; StreamInfo^.NewSize := Res;
Output(Instance, Buffer, Res); Output(Instance, Buffer, Res);
Funcs^.LogScan2(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)],
StreamInfo^.OldSize, StreamInfo^.NewSize);
Result := True; Result := True;
end; end;
end; end;
@ -277,6 +284,7 @@ function LZOProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer;
StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var var
Buffer: PByte; Buffer: PByte;
Params: String;
I: Integer; I: Integer;
X: Integer; X: Integer;
Res1: NativeUInt; Res1: NativeUInt;
@ -298,9 +306,13 @@ begin
LZO1X_CODEC: LZO1X_CODEC:
case GetBits(StreamInfo^.Option, 12, 5) of case GetBits(StreamInfo^.Option, 12, 5) of
LZO1X_999: LZO1X_999:
begin
Params := 'l' + I.ToString + ':' + 'v' +
GetBits(StreamInfo^.Option, 12, 5).ToString;
if not lzo1x_999_compress_level(NewInput, StreamInfo^.NewSize, if not lzo1x_999_compress_level(NewInput, StreamInfo^.NewSize,
Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, I) = 0 then Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, I) = 0 then
Res1 := 0; Res1 := 0;
end;
{ if not lzo1x_1_compress(NewInput, StreamInfo^.NewSize, Buffer, { if not lzo1x_1_compress(NewInput, StreamInfo^.NewSize, Buffer,
@Res1, @WrkMem[Instance, 0]) = 0 then @Res1, @WrkMem[Instance, 0]) = 0 then
Res1 := 0; } Res1 := 0; }
@ -308,24 +320,19 @@ begin
end; end;
Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer, Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer,
StreamInfo^.OldSize); StreamInfo^.OldSize);
Funcs^.LogProcess(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)],
PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result);
if Result then if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
break; break;
end; 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 if (Result = False) and ((StreamInfo^.Status = TStreamStatus.Predicted) or
(SOList[Instance][X].Count = 1)) then (SOList[Instance][X].Count = 1)) then
begin begin
Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1)); Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1));
Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1, Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1,
Buffer + Res1, Max(StreamInfo^.OldSize, 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) if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= DIFF_TOLERANCE)
then then
begin begin
@ -335,12 +342,18 @@ begin
Result := True; Result := True;
end; end;
end; end;
if Result then
begin
SetBits(StreamInfo^.Option, I, 5, 7);
SOList[Instance][X].Add(I);
end;
end; end;
function LZORestore(Instance, Depth: Integer; Input, InputExt: Pointer; function LZORestore(Instance, Depth: Integer; Input, InputExt: Pointer;
StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean;
var var
Buffer: PByte; Buffer: PByte;
Params: String;
X: Integer; X: Integer;
Res1: NativeUInt; Res1: NativeUInt;
Res2: NativeUInt; Res2: NativeUInt;
@ -355,17 +368,24 @@ begin
LZO1X_CODEC: LZO1X_CODEC:
case GetBits(StreamInfo.Option, 12, 5) of case GetBits(StreamInfo.Option, 12, 5) of
LZO1X_999: 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, if not lzo1x_999_compress_level(Input, StreamInfo.NewSize, Buffer,
@Res1, @WrkMem[Instance, 0], nil, 0, nil, @Res1, @WrkMem[Instance, 0], nil, 0, nil,
GetBits(StreamInfo.Option, 5, 7)) = 0 then GetBits(StreamInfo.Option, 5, 7)) = 0 then
Res1 := 0; Res1 := 0;
end; end;
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 if GetBits(StreamInfo.Option, 31, 1) = 1 then
begin begin
Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize); Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize);
Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1, Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1,
Buffer + Res1, StreamInfo.OldSize); Buffer + Res1, StreamInfo.OldSize);
Funcs^.LogPatch2(StreamInfo.OldSize, Res1, StreamInfo.ExtSize, Res2 > 0);
if Res2 > 0 then if Res2 > 0 then
begin begin
Output(Instance, Buffer + Res1, StreamInfo.OldSize); 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 PrecompGetDepthInfo(Index: Integer): TDepthInfo cdecl;
function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer; function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer;
Count: Integer): Integer cdecl; 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; procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer); Size: Integer);
@ -163,7 +174,7 @@ begin
S := ReplaceText(S, 'p', '%'); S := ReplaceText(S, 'p', '%');
S := ReplaceText(S, '%', '%*' + CPUCount.ToString); S := ReplaceText(S, '%', '%*' + CPUCount.ToString);
Options.Threads := Max(1, Round(ExpParse.Evaluate(S))); 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'); Options.LowMem := ArgParse.AsBoolean('-lm');
UseDB := ArgParse.AsBoolean('--dbase'); UseDB := ArgParse.AsBoolean('--dbase');
Options.DBaseFile := ArgParse.AsString('--dbase='); Options.DBaseFile := ArgParse.AsString('--dbase=');
@ -174,10 +185,13 @@ begin
S := ArgParse.AsString('--diff=', 0, '5p'); S := ArgParse.AsString('--diff=', 0, '5p');
S := ReplaceText(S, 'p', '%'); S := ReplaceText(S, 'p', '%');
DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S)); DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S));
VERBOSE := ArgParse.AsBoolean('--verbose');
finally finally
ArgParse.Free; ArgParse.Free;
ExpParse.Free; ExpParse.Free;
end; end;
if VERBOSE then
Options.Threads := 1;
end; end;
procedure Parse(ParamArg: TArray<string>; out Options: TDecodeOptions); procedure Parse(ParamArg: TArray<string>; out Options: TDecodeOptions);
@ -209,10 +223,13 @@ begin
Options.DedupSysMem := Max(0, Round(ExpParse.Evaluate(S))); Options.DedupSysMem := Max(0, Round(ExpParse.Evaluate(S)));
if B then if B then
Options.DedupSysMem := -Options.DedupSysMem; Options.DedupSysMem := -Options.DedupSysMem;
VERBOSE := ArgParse.AsBoolean('--verbose');
finally finally
ArgParse.Free; ArgParse.Free;
ExpParse.Free; ExpParse.Free;
end; end;
if VERBOSE then
Options.Threads := 1;
end; end;
function GetIndex(Scanned, Processed: TArray<Boolean>): Integer; function GetIndex(Scanned, Processed: TArray<Boolean>): Integer;
@ -264,6 +281,8 @@ var
ThrIdx: TArray<Integer>; ThrIdx: TArray<Integer>;
WorkStream: TArray<TMemoryStream>; WorkStream: TArray<TMemoryStream>;
Scanned1, Scanned2, Processed: TArray<Boolean>; Scanned1, Scanned2, Processed: TArray<Boolean>;
LogInt: Integer;
LogInt64: Int64;
procedure CodecInit(Count: Integer; Method: String); procedure CodecInit(Count: Integer; Method: String);
var var
@ -323,7 +342,7 @@ var
begin begin
for I := Low(CurCodec) to High(CurCodec) do for I := Low(CurCodec) to High(CurCodec) do
begin begin
CurCodec[I] := X; CurCodec[I] := 0;
CurDepth[I] := 0; CurDepth[I] := 0;
end; end;
for I := Low(Codecs) to High(Codecs) do for I := Low(Codecs) to High(Codecs) do
@ -371,6 +390,98 @@ begin
end; end;
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; procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer;
Size: Integer); Size: Integer);
begin begin
@ -452,6 +563,7 @@ begin
SI1.Resource := Info^.Resource; SI1.Resource := Info^.Resource;
SI1.Thread := Instance; SI1.Thread := Instance;
SI1.Codec := LCodec; SI1.Codec := LCodec;
SI1.Scan2 := False;
SI1.Option := LOption; SI1.Option := LOption;
SI1.Checksum := Utils.Hash32(0, PByte(DataStore.Slot(Instance).Memory) + SI1.Checksum := Utils.Hash32(0, PByte(DataStore.Slot(Instance).Memory) +
SI1.ActualPosition, SI1.OldSize); SI1.ActualPosition, SI1.OldSize);
@ -469,6 +581,7 @@ begin
SI2.NewSize := Info^.NewSize; SI2.NewSize := Info^.NewSize;
SI2.Resource := Info^.Resource; SI2.Resource := Info^.Resource;
SI2.Codec := LCodec; SI2.Codec := LCodec;
SI2.Scan2 := True;
SI2.Option := LOption; SI2.Option := LOption;
SI2.Status := Info^.Status; SI2.Status := Info^.Status;
if Assigned(DepthInfo) then if Assigned(DepthInfo) then
@ -582,7 +695,7 @@ begin
I := InfoStore2[Index, ISIndex[Index].ToInteger].Get(SI2); I := InfoStore2[Index, ISIndex[Index].ToInteger].Get(SI2);
while I >= 0 do while I >= 0 do
begin 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 Pred(DataStore.Position(Index) + DataStore.Size(Index))) then
begin begin
CurPos1[Index] := MemOutput1[Index].Position; CurPos1[Index] := MemOutput1[Index].Position;
@ -596,6 +709,7 @@ begin
J := 0; J := 0;
X := DataStore.ActualSize(Index) - X := DataStore.ActualSize(Index) -
NativeInt(SI2.Position - DataStore.Position(Index)); NativeInt(SI2.Position - DataStore.Position(Index));
LogInt64 := SI2.Position;
if (SI1.OldSize <= X) and Codecs[SI2.Codec].Scan2(Index, Depth, if (SI1.OldSize <= X) and Codecs[SI2.Codec].Scan2(Index, Depth,
PByte(DataStore.Slot(Index).Memory) + PByte(DataStore.Slot(Index).Memory) +
NativeInt(SI2.Position - DataStore.Position(Index)), X, @SI1, @J, NativeInt(SI2.Position - DataStore.Position(Index)), X, @SI1, @J,
@ -617,6 +731,7 @@ begin
SI3.Resource := SI1.Resource; SI3.Resource := SI1.Resource;
SI3.Thread := Index; SI3.Thread := Index;
SI3.Codec := SI2.Codec; SI3.Codec := SI2.Codec;
SI3.Scan2 := False;
SI3.Option := SI1.Option; SI3.Option := SI1.Option;
SI3.Status := SI1.Status; SI3.Status := SI1.Status;
SI3.Checksum := SI3.Checksum :=
@ -657,6 +772,7 @@ begin
SI1.Resource := SI2.Resource; SI1.Resource := SI2.Resource;
SI1.Option := SI2.Option; SI1.Option := SI2.Option;
SI1.Status := SI2.Status; SI1.Status := SI2.Status;
LogInt64 := DataStore.Position(0) + SI2.ActualPosition;
if UseDB and (SI2.Codec > 2) then if UseDB and (SI2.Codec > 2) then
begin begin
DBBool := CheckDB(Database, SI2, DBTyp); DBBool := CheckDB(Database, SI2, DBTyp);
@ -757,7 +873,15 @@ begin
begin begin
if InRange(Y, Low(InfoStore1), High(InfoStore1)) then if InRange(Y, Low(InfoStore1), High(InfoStore1)) then
begin 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); Scan1(Y, W);
if VERBOSE then
WriteLn(ErrOutput, '');
if W = 0 then if W = 0 then
begin begin
Scanned1[Y] := True; Scanned1[Y] := True;
@ -785,6 +909,12 @@ begin
end end
else else
Z := Y; 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]); X := AtomicIncrement(StrIdx[Z]);
while X < InfoStore1[Z].Count do while X < InfoStore1[Z].Count do
begin begin
@ -803,6 +933,8 @@ begin
end; end;
X := AtomicIncrement(StrIdx[Z]); X := AtomicIncrement(StrIdx[Z]);
end; end;
if VERBOSE and (InfoStore1[Z].Count > 0) then
WriteLn(ErrOutput, '');
if W = 0 then if W = 0 then
begin begin
if Z < -1 then if Z < -1 then
@ -1733,6 +1865,8 @@ var
UI32: UInt32; UI32: UInt32;
I, J: Integer; I, J: Integer;
begin begin
if Depth = 0 then
LogInt64 := 0;
with ComVars2[Depth] do with ComVars2[Depth] do
begin begin
DecInput[Index] := Input; DecInput[Index] := Input;
@ -1936,6 +2070,7 @@ begin
Stopwatch := TStopwatch.Create; Stopwatch := TStopwatch.Create;
Stopwatch.Start; Stopwatch.Start;
ConTask.Perform(EncodeStats); ConTask.Perform(EncodeStats);
if not VERBOSE then
ConTask.Start; ConTask.Start;
try try
EncInit(Input, Output, @Options); EncInit(Input, Output, @Options);
@ -1947,6 +2082,8 @@ begin
Stopwatch.Stop; Stopwatch.Stop;
end; end;
end; end;
if VERBOSE then
EncodeStats;
ConTask.Wait; ConTask.Wait;
ConTask.Free; ConTask.Free;
InternalSync.Leave; InternalSync.Leave;
@ -1960,6 +2097,7 @@ begin
Stopwatch := TStopwatch.Create; Stopwatch := TStopwatch.Create;
Stopwatch.Start; Stopwatch.Start;
ConTask.Perform(DecodeStats); ConTask.Perform(DecodeStats);
if not VERBOSE then
ConTask.Start; ConTask.Start;
NStream := TArrayStream.Create; NStream := TArrayStream.Create;
try try
@ -1973,6 +2111,8 @@ begin
Stopwatch.Stop; Stopwatch.Stop;
end; end;
end; end;
if VERBOSE then
DecodeStats;
ConTask.Wait; ConTask.Wait;
ConTask.Free; ConTask.Free;
InternalSync.Leave; InternalSync.Leave;
@ -2014,6 +2154,12 @@ PrecompFunctions.ExecStdio := @PrecompExecStdio;
PrecompFunctions.ExecStdioSync := @PrecompExecStdioSync; PrecompFunctions.ExecStdioSync := @PrecompExecStdioSync;
PrecompFunctions.GetDepthCodec := @PrecompGetDepthCodec; PrecompFunctions.GetDepthCodec := @PrecompGetDepthCodec;
PrecompFunctions.ReadFuture := @PrecompReadFuture; PrecompFunctions.ReadFuture := @PrecompReadFuture;
PrecompFunctions.LogScan1 := PrecompLogScan1;
PrecompFunctions.LogScan2 := PrecompLogScan2;
PrecompFunctions.LogProcess := PrecompLogProcess;
PrecompFunctions.LogRestore := PrecompLogRestore;
PrecompFunctions.LogPatch1 := PrecompLogPatch1;
PrecompFunctions.LogPatch2 := PrecompLogPatch2;
finalization finalization

274
precompressor/PrecompOodle.pas
View File

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

20
precompressor/PrecompSearch.pas
View File

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

140
precompressor/PrecompUtils.pas
View File

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

103
precompressor/PrecompZLib.pas
View File

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

47
precompressor/PrecompZSTD.pas
View File

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

35
xtool.dpr
View File

@ -186,6 +186,39 @@ begin
end; end;
{ changelog { 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) ES_R24 (0.4.1)
- fixed issue of status not reporting when encoding - fixed issue of status not reporting when encoding
- added depth method support for search support - added depth method support for search support
@ -195,6 +228,8 @@ end;
- updated lz4f codec and removed temporarily removed support for universal scanning - updated lz4f codec and removed temporarily removed support for universal scanning
- added option to change recompression level to be used by reflate - added option to change recompression level to be used by reflate
- updated external executable support - 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) ES_R23 (0.4.0)
- project made open source - project made open source