From 97c6b15949d51fa6b4ffb4b92dda15cd14995d19 Mon Sep 17 00:00:00 2001 From: Razor12911 Date: Thu, 17 Feb 2022 08:11:04 +0200 Subject: [PATCH] update to v0.4.1 --- common/Utils.pas | 167 ++++- imports/LZ4DLL.pas | 116 +++- precompressor/PrecompCrypto.pas | 29 +- precompressor/PrecompDLL.pas | 3 +- precompressor/PrecompEXE.pas | 636 +++++++++++------ precompressor/PrecompINI.pas | 5 +- precompressor/PrecompLZ4.pas | 175 ++--- precompressor/PrecompLZO.pas | 61 +- precompressor/PrecompMain - Copy.pas | 991 --------------------------- precompressor/PrecompMain.pas | 202 +++--- precompressor/PrecompOodle.pas | 110 ++- precompressor/PrecompSearch.pas | 126 +++- precompressor/PrecompUtils.pas | 246 ++----- precompressor/PrecompZLib.pas | 82 ++- precompressor/PrecompZSTD.pas | 61 +- xtool.dpr | 158 +---- 16 files changed, 1327 insertions(+), 1841 deletions(-) delete mode 100644 precompressor/PrecompMain - Copy.pas diff --git a/common/Utils.pas b/common/Utils.pas index 96fa879..8269507 100644 --- a/common/Utils.pas +++ b/common/Utils.pas @@ -243,7 +243,11 @@ type private const FBufferSize = 65536; private + FSync: TSynLocker; FInput: TStream; + FTemp: TFileStream; + FTempFile: String; + FTempPos: Int64; FBuffer: array [0 .. FBufferSize - 1] of Byte; FDynamic: Boolean; FIndex: Integer; @@ -255,9 +259,11 @@ type FDone, FFirstRead, FLastRead: Boolean; public constructor Create(AInput: TStream; ADynamic: Boolean; - ASlots, ASize: NativeInt); + ASlots, ASize: NativeInt; ATempFile: String = ''); destructor Destroy; override; procedure ChangeInput(AInput: TStream); + function Read(Index: Integer; Position: NativeInt; var Buffer; + Count: Integer): Integer; function Slot(Index: Integer): TMemoryStream; override; function Position(Index: Integer): Int64; override; function Size(Index: Integer): NativeInt; override; @@ -416,6 +422,7 @@ function GetFileList(const APath: TArray; SubDir: Boolean = True) : TArray; procedure FileReadBuffer(Handle: THandle; var Buffer; Count: NativeInt); procedure FileWriteBuffer(Handle: THandle; const Buffer; Count: NativeInt); +procedure CloseHandleEx(var Handle: THandle); function Exec(Executable, CommandLine, WorkDir: string): Boolean; function ExecStdin(Executable, CommandLine, WorkDir: string; InBuff: Pointer; @@ -1337,12 +1344,15 @@ begin end; constructor TDataStore1.Create(AInput: TStream; ADynamic: Boolean; - ASlots, ASize: NativeInt); + ASlots, ASize: NativeInt; ATempFile: String); var I: Integer; begin inherited Create; + FSync.Init; FInput := AInput; + FTempFile := ATempFile; + FTempPos := 0; FDynamic := ADynamic; FIndex := 0; FSlots := ASlots; @@ -1380,10 +1390,16 @@ destructor TDataStore1.Destroy; var I: Integer; begin + if Assigned(FTemp) then + begin + FTemp.Free; + DeleteFile(FTempFile); + end; for I := Low(FMemData) to High(FMemData) do FMemData[I].Free; FMemStm.Free; FreeMemory(FMemPtr); + FSync.Done; inherited Destroy; end; @@ -1408,6 +1424,62 @@ begin FLastRead := False; end; +function TDataStore1.Read(Index: Integer; Position: NativeInt; var Buffer; + Count: Integer): Integer; +const + BuffSize = 65536; +var + Buff: array [0 .. BuffSize - 1] of Byte; + I: Integer; + LPos: NativeInt; + LMemSize: NativeInt; +begin + Result := 0; + LPos := Position; + LMemSize := 0; + for I := Index to High(FMemData) do + Inc(LMemSize, IfThen(I = High(FMemData), ActualSize(I), Size(I))); + if LPos < LMemSize then + begin + I := Min(LMemSize - LPos, Count); + Move((PByte(FMemData[Index].Memory) + LPos)^, Buffer, I); + Result := I; + end + else + begin + FSync.Lock; + try + if not Assigned(FTemp) then + FTemp := TFileStream.Create(FTempFile, fmCreate); + Dec(LPos, LMemSize); + if LPos > FTemp.Size then + begin + FTemp.Position := FTemp.Size; + while LPos > FTemp.Size do + begin + I := FInput.Read(Buff[0], BuffSize); + if I = 0 then + exit; + FTemp.WriteBuffer(Buff[0], I); + end; + end; + if (LPos = FTemp.Position) and (LPos = FTemp.Size) then + begin + I := FInput.Read(Buffer, Count); + FTemp.WriteBuffer(Buffer, I); + Result := I; + end + else + begin + FTemp.Position := LPos; + Result := FTemp.Read(Buffer, Count) + end; + finally + FSync.UnLock; + end; + end; +end; + function TDataStore1.Slot(Index: Integer): TMemoryStream; begin Result := FMemData[Index]; @@ -1460,8 +1532,21 @@ begin end; while FMemStm.Position < FMemStm.Size do begin - X := FInput.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, - FBufferSize)); + if Assigned(FTemp) and (FTempPos < FTemp.Size) then + begin + FTemp.Position := FTempPos; + X := FTemp.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, + FBufferSize)); + Inc(FTempPos, X); + if FTempPos = FTemp.Size then + begin + FTempPos := 0; + FTemp.Size := 0; + end; + end + else + X := FInput.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, + FBufferSize)); if X > 0 then FMemStm.WriteBuffer(FBuffer[0], X) else @@ -1479,8 +1564,21 @@ begin FMemStm.Position := 0; while FMemStm.Position < FMemStm.Size do begin - X := FInput.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, - FBufferSize)); + if Assigned(FTemp) and (FTempPos < FTemp.Size) then + begin + FTemp.Position := FTempPos; + X := FTemp.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, + FBufferSize)); + Inc(FTempPos, X); + if FTempPos = FTemp.Size then + begin + FTempPos := 0; + FTemp.Size := 0; + end; + end + else + X := FInput.Read(FBuffer[0], Min(FMemStm.Size - FMemStm.Position, + FBufferSize)); if X > 0 then FMemStm.WriteBuffer(FBuffer[0], X) else @@ -1511,7 +1609,19 @@ begin W := FMemStm.Position + FSize; while FMemStm.Position < W do begin - X := FInput.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); + if Assigned(FTemp) and (FTempPos < FTemp.Size) then + begin + FTemp.Position := FTempPos; + X := FTemp.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); + Inc(FTempPos, X); + if FTempPos = FTemp.Size then + begin + FTempPos := 0; + FTemp.Size := 0; + end; + end + else + X := FInput.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); if X > 0 then FMemStm.WriteBuffer(FBuffer[0], X) else @@ -1529,7 +1639,19 @@ begin W := FMemStm.Position + FSize; while FMemStm.Position < W do begin - X := FInput.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); + if Assigned(FTemp) and (FTempPos < FTemp.Size) then + begin + FTemp.Position := FTempPos; + X := FTemp.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); + Inc(FTempPos, X); + if FTempPos = FTemp.Size then + begin + FTempPos := 0; + FTemp.Size := 0; + end; + end + else + X := FInput.Read(FBuffer[0], Min(W - FMemStm.Position, FBufferSize)); if X > 0 then FMemStm.WriteBuffer(FBuffer[0], X) else @@ -2794,6 +2916,18 @@ begin end end; +procedure CloseHandleEx(var Handle: THandle); +var + lpdwFlags: DWORD; +begin + if Handle = 0 then + exit; + if GetHandleInformation(Handle, lpdwFlags) then + if lpdwFlags <> HANDLE_FLAG_PROTECT_FROM_CLOSE then + CloseHandle(Handle); + Handle := 0; +end; + function Exec(Executable, CommandLine, WorkDir: string): Boolean; var StartupInfo: TStartupInfo; @@ -2804,6 +2938,11 @@ begin Result := False; FillChar(StartupInfo, sizeof(StartupInfo), #0); StartupInfo.cb := sizeof(StartupInfo); + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; + StartupInfo.hStdInput := 0; + StartupInfo.hStdOutput := 0; + StartupInfo.hStdError := 0; if WorkDir <> '' then LWorkDir := Pointer(WorkDir) else @@ -2835,7 +2974,8 @@ begin SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0); ZeroMemory(@StartupInfo, sizeof(StartupInfo)); StartupInfo.cb := sizeof(StartupInfo); - StartupInfo.dwFlags := STARTF_USESTDHANDLES; + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; StartupInfo.hStdInput := hstdinr; StartupInfo.hStdOutput := 0; StartupInfo.hStdError := 0; @@ -2881,7 +3021,8 @@ begin SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0); ZeroMemory(@StartupInfo, sizeof(StartupInfo)); StartupInfo.cb := sizeof(StartupInfo); - StartupInfo.dwFlags := STARTF_USESTDHANDLES; + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; StartupInfo.hStdInput := 0; StartupInfo.hStdOutput := hstdoutw; StartupInfo.hStdError := 0; @@ -2932,7 +3073,8 @@ begin SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0); ZeroMemory(@StartupInfo, sizeof(StartupInfo)); StartupInfo.cb := sizeof(StartupInfo); - StartupInfo.dwFlags := STARTF_USESTDHANDLES; + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; StartupInfo.hStdInput := hstdinr; StartupInfo.hStdOutput := hstdoutw; StartupInfo.hStdError := 0; @@ -3001,7 +3143,8 @@ begin SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0); ZeroMemory(@StartupInfo, sizeof(StartupInfo)); StartupInfo.cb := sizeof(StartupInfo); - StartupInfo.dwFlags := STARTF_USESTDHANDLES; + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; StartupInfo.hStdInput := hstdinr; StartupInfo.hStdOutput := hstdoutw; StartupInfo.hStdError := 0; diff --git a/imports/LZ4DLL.pas b/imports/LZ4DLL.pas index 8c910bf..8adb550 100644 --- a/imports/LZ4DLL.pas +++ b/imports/LZ4DLL.pas @@ -3,23 +3,86 @@ unit LZ4DLL; interface uses - MemoryModule, WinAPI.Windows, System.SysUtils, System.Classes; +const + LZ4F_VERSION = 100; + +type + LZ4F_errorCode_t = type size_t; + + LZ4F_blockSizeID_t = (LZ4F_default = 0, LZ4F_max64KB = 4, LZ4F_max256KB = 5, + LZ4F_max1MB = 6, LZ4F_max4MB = 7); + LZ4F_blockMode_t = (LZ4F_blockLinked = 0, LZ4F_blockIndependent); + + LZ4F_contentChecksum_t = (LZ4F_noContentChecksum = 0, + LZ4F_contentChecksumEnabled); + + LZ4F_blockChecksum_t = (LZ4F_noBlockChecksum = 0, LZ4F_blockChecksumEnabled); + + LZ4F_frameType_t = (LZ4F_frame = 0, LZ4F_skippableFrame); + + LZ4F_frameInfo_t = record + blockSizeID: LZ4F_blockSizeID_t; + blockMode: LZ4F_blockMode_t; + contentChecksumFlag: LZ4F_contentChecksum_t; + frameType: LZ4F_frameType_t; + contentSize: UInt64; + dictID: Cardinal; + blockChecksumFlag: LZ4F_blockChecksum_t; + end; + + LZ4F_preferences_t = record + frameInfo: LZ4F_frameInfo_t; + compressionLevel: Integer; + autoFlush: Cardinal; + favorDecSpeed: Cardinal; + reserved: packed array [0 .. 2] of Cardinal; + end; + + PLZ4F_preferences_t = ^LZ4F_preferences_t; + + LZ4F_dctx = type Pointer; + + LZ4F_decompressOptions_t = record + stableDst: Cardinal; + reserved: packed array [0 .. 2] of Cardinal; + end; + + PLZ4F_decompressOptions_t = ^LZ4F_decompressOptions_t; + var LZ4_decompress_safe: function(source: Pointer; dest: Pointer; - compressedSize: integer; maxDecompressedSize: integer): integer cdecl; + compressedSize: Integer; maxDecompressedSize: Integer): Integer cdecl; LZ4_decompress_fast: function(source: Pointer; dest: Pointer; - originalSize: integer): integer cdecl; + originalSize: Integer): Integer cdecl; LZ4_compress_default: function(src, dst: Pointer; - srcSize, dstCapacity: integer): integer cdecl; - LZ4_compress_fast: function(src, dst: Pointer; srcSize, dstCapacity: integer; - acceleration: integer): integer cdecl; - LZ4_compress_HC: function(const src: Pointer; dst: Pointer; srcSize: integer; - maxDstSize: integer; compressionLevel: integer): integer cdecl; + srcSize, dstCapacity: Integer): Integer cdecl; + LZ4_compress_fast: function(src, dst: Pointer; srcSize, dstCapacity: Integer; + acceleration: Integer): Integer cdecl; + LZ4_compress_HC: function(const src: Pointer; dst: Pointer; srcSize: Integer; + maxDstSize: Integer; compressionLevel: Integer): Integer cdecl; + LZ4F_compressFrame: function(dstBuffer: Pointer; dstCapacity: size_t; + srcBuffer: Pointer; srcSize: size_t; + const preferencesPtr: LZ4F_preferences_t): size_t cdecl; + LZ4F_compressFrameBound: function(srcSize: size_t; + preferencesPtr: PLZ4F_preferences_t): size_t cdecl; + LZ4F_createDecompressionContext: function(out dctxPtr: LZ4F_dctx; + version: Cardinal = LZ4F_VERSION): LZ4F_errorCode_t cdecl; + LZ4F_freeDecompressionContext: function(dctx: LZ4F_dctx) + : LZ4F_errorCode_t cdecl; + LZ4F_decompress: function(dctx: LZ4F_dctx; dstBuffer: Pointer; + var dstSizePtr: size_t; srcBuffer: Pointer; var srcSizePtr: size_t; + dOptPtr: PLZ4F_decompressOptions_t): size_t cdecl; + LZ4F_getFrameInfo: function(dctx: LZ4F_dctx; + out frameInfoPtr: LZ4F_frameInfo_t; srcBuffer: Pointer; + out srcSizePtr: size_t): size_t cdecl; DLLLoaded: Boolean = False; +function LZ4F_decompress_safe(source: Pointer; dest: Pointer; + compressedSize: Integer; maxDecompressedSize: Integer): Integer; + implementation var @@ -45,6 +108,21 @@ begin Assert(@LZ4_compress_fast <> nil); @LZ4_compress_HC := GetProcAddress(DLLHandle, 'LZ4_compress_HC'); Assert(@LZ4_compress_HC <> nil); + @LZ4F_compressFrame := GetProcAddress(DLLHandle, 'LZ4F_compressFrame'); + Assert(@LZ4F_compressFrame <> nil); + @LZ4F_compressFrameBound := GetProcAddress(DLLHandle, + 'LZ4F_compressFrameBound'); + Assert(@LZ4F_compressFrameBound <> nil); + @LZ4F_createDecompressionContext := GetProcAddress(DLLHandle, + 'LZ4F_createDecompressionContext'); + Assert(@LZ4F_createDecompressionContext <> nil); + @LZ4F_freeDecompressionContext := GetProcAddress(DLLHandle, + 'LZ4F_freeDecompressionContext'); + Assert(@LZ4F_freeDecompressionContext <> nil); + @LZ4F_decompress := GetProcAddress(DLLHandle, 'LZ4F_decompress'); + Assert(@LZ4F_decompress <> nil); + @LZ4F_getFrameInfo := GetProcAddress(DLLHandle, 'LZ4F_getFrameInfo'); + Assert(@LZ4F_getFrameInfo <> nil); end else DLLLoaded := False; @@ -57,6 +135,28 @@ begin FreeLibrary(DLLHandle); end; +function LZ4F_decompress_safe(source: Pointer; dest: Pointer; + compressedSize: Integer; maxDecompressedSize: Integer): Integer; +var + ctx: LZ4F_dctx; + srcSizePtr, dstSizePtr: size_t; +begin + Result := 0; + if NativeUInt(LZ4F_createDecompressionContext(ctx)) = 0 then + try + srcSizePtr := compressedSize; + dstSizePtr := maxDecompressedSize; + try + if LZ4F_decompress(ctx, dest, dstSizePtr, source, srcSizePtr, nil) = 0 + then + Result := dstSizePtr; + finally + LZ4F_freeDecompressionContext(ctx); + end; + except + end; +end; + initialization Init; diff --git a/precompressor/PrecompCrypto.pas b/precompressor/PrecompCrypto.pas index 84dcded..5bc5285 100644 --- a/precompressor/PrecompCrypto.pas +++ b/precompressor/PrecompCrypto.pas @@ -68,16 +68,18 @@ begin end; function CryptoScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Res: Integer; begin Result := False; - Res := 0; - Funcs^.GetResource(StreamInfo^.Resource, nil, @Res); - if (Res > 0) or (StreamInfo^.OldSize > 0) or - (StreamInfo^.OldSize = StreamInfo^.NewSize) then + Res := -1; + if not Funcs^.GetResource(StreamInfo^.Resource, nil, @Res) then + exit; + if (Res > 0) and (StreamInfo^.OldSize > 0) then begin + StreamInfo^.NewSize := StreamInfo^.OldSize; Output(Instance, Input, StreamInfo^.OldSize); Result := True; end; @@ -93,10 +95,16 @@ begin Result := False; X := GetBits(StreamInfo^.Option, 0, 5); Res := 0; - Funcs^.GetResource(StreamInfo^.Resource, nil, @Res); + if not Funcs^.GetResource(StreamInfo^.Resource, nil, @Res) then + exit; Buffer := Funcs^.Allocator(Instance, Res); if Funcs^.GetResource(StreamInfo^.Resource, Buffer, @Res) then begin + with TFileStream.Create('xtest1', fmCreate) do + begin + WriteBuffer(NewInput^, StreamInfo^.NewSize); + Free; + end; case X of XOR_CODEC: Funcs^.Decrypt('xor', NewInput, StreamInfo^.NewSize, Buffer, Res); @@ -107,6 +115,12 @@ begin else exit; end; + with TFileStream.Create('xtest2', fmCreate) do + begin + WriteBuffer(NewInput^, StreamInfo^.NewSize); + Free; + end; + ShowMessage(''); Result := True; end; end; @@ -121,7 +135,8 @@ begin Result := False; X := GetBits(StreamInfo.Option, 0, 5); Res := 0; - Funcs^.GetResource(StreamInfo.Resource, nil, @Res); + if not Funcs^.GetResource(StreamInfo.Resource, nil, @Res) then + exit; Buffer := Funcs^.Allocator(Instance, Res); if Funcs^.GetResource(StreamInfo.Resource, Buffer, @Res) then begin diff --git a/precompressor/PrecompDLL.pas b/precompressor/PrecompDLL.pas index d188133..49dd018 100644 --- a/precompressor/PrecompDLL.pas +++ b/precompressor/PrecompDLL.pas @@ -185,7 +185,8 @@ begin end; function DLLScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var SI: TStrInfo2; begin diff --git a/precompressor/PrecompEXE.pas b/precompressor/PrecompEXE.pas index b451acb..c23f203 100644 --- a/precompressor/PrecompEXE.pas +++ b/precompressor/PrecompEXE.pas @@ -3,7 +3,8 @@ unit PrecompExe; interface uses - Utils, SynCommons, SynCrypto, + Utils, Threading, + SynCommons, SynCrypto, PrecompUtils, WinAPI.Windows, System.SysUtils, System.Classes, System.StrUtils, @@ -24,11 +25,12 @@ type TExeStruct = record Name: String; + ID: Cardinal; Exec, Param: array [0 .. 1] of String; WorkDir: array of array [0 .. 1] of String; Mode: array [0 .. 1] of Byte; InFile, OutFile: String; - Continuous: Boolean; + IsLib: array [0 .. 1] of Boolean; Ctx: array of array [0 .. 1] of Pointer; end; @@ -48,6 +50,182 @@ var Index: Integer; Size: Integer): Pointer cdecl; CodecExe: TArray; +type + PExecCtx = ^TExecCtx; + + TExecCtx = record + FInstance: Integer; + FLib: Boolean; + FExecutable, FCommandLine, FWorkDir: string; + hstdinr, hstdinw: THandle; + hstdoutr, hstdoutw: THandle; + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + FTask, MTask: TTask; + end; + +procedure ExecReadTask(Instance, Handle, Stream: IntPtr); +const + BufferSize = 65536; +var + Buffer: array [0 .. BufferSize - 1] of Byte; + BytesRead: DWORD; +begin + while ReadFile(Handle, Buffer[0], Length(Buffer), BytesRead, nil) and + (BytesRead > 0) do + PExecOutput(Pointer(Stream))^(Instance, @Buffer[0], BytesRead); +end; + +procedure ExecMonTask(Process, Stdin, Stdout: IntPtr); +begin + WaitForSingleObject(PHandle(Process)^, INFINITE); + CloseHandleEx(PHandle(Process)^); + CancelIo(PHandle(Stdin)^); + CloseHandleEx(PHandle(Stdin)^); + CancelIo(PHandle(Stdout)^); + CloseHandleEx(PHandle(Stdout)^); +end; + +function ExecStdioInit(Instance: Integer; Executable, CommandLine, + WorkDir: PChar; IsLib: Boolean): PExecCtx; +begin + New(Result); + with Result^ do + begin + FInstance := Instance; + FLib := IsLib; + FExecutable := Executable; + FCommandLine := CommandLine; + if WorkDir <> '' then + FWorkDir := WorkDir + else + FWorkDir := GetCurrentDir; + FTask := TTask.Create; + FTask.Perform(ExecReadTask); + MTask := TTask.Create(IntPtr(@ProcessInfo.hProcess), IntPtr(@hstdinw), + IntPtr(@hstdoutr)); + MTask.Perform(ExecMonTask); + ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo)); + end; +end; + +procedure ExecStdioFree(Ctx: PExecCtx); +begin + with Ctx^ do + begin + TerminateProcess(ProcessInfo.hProcess, 0); + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + FTask.Free; + MTask.Wait; + MTask.Free; + end; + Dispose(Ctx); +end; + +function ExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer; InSize: Integer; + Output: _ExecOutput): Boolean; + + function ProcessLib(Instance: Integer; Stdin, Stdout: THandle): Boolean; + const + BufferSize = 65536; + var + Buffer: array [0 .. BufferSize - 1] of Byte; + BytesRead: DWORD; + OutSize: Integer; + begin + Result := False; + try + FileWriteBuffer(Stdin, InSize, InSize.Size); + FileWriteBuffer(Stdin, InBuff^, InSize); + FileReadBuffer(Stdout, OutSize, OutSize.Size); + if OutSize <= 0 then + exit + else + begin + while OutSize > 0 do + begin + BytesRead := Min(OutSize, Length(Buffer)); + FileReadBuffer(Stdout, Buffer[0], BytesRead); + Output(Instance, @Buffer[0], BytesRead); + Dec(OutSize, BytesRead); + end; + Result := True; + end; + except + end; + if not Result then + with Ctx^ do + begin + TerminateProcess(ProcessInfo.hProcess, 0); + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + end; + end; + +const + PipeSecurityAttributes: TSecurityAttributes = + (nLength: SizeOf(PipeSecurityAttributes); bInheritHandle: True); +var + dwExitCode: DWORD; +begin + Result := False; + with Ctx^ do + begin + if FLib and (WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT) + then + Result := ProcessLib(FInstance, hstdinw, hstdoutr) + else + begin + CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0); + CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0); + SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0); + SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0); + ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); + StartupInfo.cb := SizeOf(StartupInfo); + StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_HIDE; + StartupInfo.hStdInput := hstdinr; + StartupInfo.hStdOutput := hstdoutw; + StartupInfo.hStdError := 0; + ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo)); + if CreateProcess(nil, PChar('"' + FExecutable + '" ' + FCommandLine), nil, + nil, True, NORMAL_PRIORITY_CLASS, nil, PChar(FWorkDir), StartupInfo, + ProcessInfo) then + begin + CloseHandleEx(ProcessInfo.hThread); + CloseHandleEx(hstdinr); + CloseHandleEx(hstdoutw); + if FLib then + begin + MTask.Start; + Result := ProcessLib(FInstance, hstdinw, hstdoutr) + end + else + begin + FTask.Update(FInstance, hstdoutr, NativeInt(@Output)); + FTask.Start; + try + FileWriteBuffer(hstdinw, InBuff^, InSize); + finally + CloseHandleEx(hstdinw); + FTask.Wait; + CloseHandleEx(hstdoutr); + end; + Result := GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode) and + (dwExitCode = 0); + CloseHandleEx(ProcessInfo.hProcess); + end; + end + else + begin + CloseHandleEx(hstdinr); + CloseHandleEx(hstdinw); + CloseHandleEx(hstdoutr); + CloseHandleEx(hstdoutw); + end; + end; + end; +end; + procedure ExecOutput1(Instance: Integer; const Buffer: Pointer; Size: Integer)cdecl; begin @@ -65,91 +243,16 @@ begin Inc(CodecSize[Instance], Size); end; -function ExeInit(Command: PChar; Count: Integer; Funcs: PPrecompFuncs): Boolean; -var - X, Y, Z: Integer; -begin - Result := True; - Randomize; - SetLength(WrkMem, Count); - SetLength(CodecSize, Count); - SetLength(CodecOutput, Count); - SetLength(CodecAllocator, Count); - for X := Low(CodecExe) to High(CodecExe) do - begin - SetLength(CodecExe[X].WorkDir, Count); - SetLength(CodecExe[X].Ctx, Count); - for Z := 0 to 1 do - for Y := Low(CodecSize) to High(CodecSize) do - begin - repeat - CodecExe[X].WorkDir[Y, Z] := IncludeTrailingBackSlash - (IncludeTrailingBackSlash(GetCurrentDir) + CodecExe[X].Name + '_' + - IntToHex(Random($FFFF), 4)); - until DirectoryExists(CodecExe[X].WorkDir[Y, Z]) = False; - IncludeTrailingBackSlash(CodecExe[X].WorkDir[Y, Z]); - if CodecExe[X].Mode[Z] = STDIO_MODE then - begin - CodecExe[X].Ctx[Y, Z] := PrecompExecStdioInit(Y, - PChar(CodecExe[X].Exec[Z]), PChar(CodecExe[X].Param[Z]), - PChar(CodecExe[X].WorkDir[Y, Z])); - end; - end; - AddMethod(CodecExe[X].Name); - end; -end; - -procedure ExeFree(Funcs: PPrecompFuncs); -var - X, Y, Z: Integer; -begin - for X := Low(CodecExe) to High(CodecExe) do - for Z := 0 to 1 do - for Y := Low(CodecSize) to High(CodecSize) do - begin - if DirectoryExists(CodecExe[X].WorkDir[Y, Z]) then - RemoveDir(CodecExe[X].WorkDir[Y, Z]); - PrecompExecStdioFree(CodecExe[X].Ctx[Y, Z]); - end; -end; - -function ExeParse(Command: PChar; Option: PInteger; - Funcs: PPrecompFuncs): Boolean; -var - I: Integer; -begin - Result := False; - Option^ := 0; - for I := Low(CodecExe) to High(CodecExe) do - begin - if Funcs^.GetCodec(Command, 0, False) = CodecExe[I].Name then - begin - SetBits(Option^, I, 0, 24); - Result := True; - break; - end; - end; -end; - -procedure ExeScan1(Instance, Depth: Integer; Input: PByte; - Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd; - Funcs: PPrecompFuncs); -begin - // maybe add feature later... -end; - -function ExeScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; +function ExeEncode(Index, Instance: Integer; Input: Pointer; StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; var - X, Y: Integer; + X: Integer; Executed: Boolean; begin Result := False; - Executed := False; - X := GetBits(StreamInfo^.Option, 0, 24); CodecSize[Instance] := 0; CodecOutput[Instance] := Output; - with CodecExe[X] do + with CodecExe[Index] do begin if not DirectoryExists(WorkDir[Instance, 0]) then CreateDir(WorkDir[Instance, 0]); @@ -177,8 +280,8 @@ begin Executed := PrecompExecStdin(PChar(Exec[0]), PChar(Param[0]), PChar(WorkDir[Instance, 0]), Input, StreamInfo^.OldSize) else - Executed := PrecompExecStdioProcess(Ctx[Instance, 0], Input, - StreamInfo^.OldSize, ExecOutput1, Continuous); + Executed := ExecStdioProcess(Ctx[Instance, 0], Input, + StreamInfo^.OldSize, ExecOutput1); end; end; if Executed then @@ -189,11 +292,11 @@ begin with TFileStream.Create(WorkDir[Instance, 0] + OutFile, fmShareDenyNone) do try - Y := Read(WrkMem[Instance, 0], E_WORKMEM); - while Y > 0 do + X := Read(WrkMem[Instance, 0], E_WORKMEM); + while X > 0 do begin - ExecOutput1(Instance, @WrkMem[Instance, 0], Y); - Y := Read(WrkMem[Instance, 0], E_WORKMEM); + ExecOutput1(Instance, @WrkMem[Instance, 0], X); + X := Read(WrkMem[Instance, 0], E_WORKMEM); end; finally Free; @@ -206,107 +309,16 @@ begin end; end; -function ExeProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; +function ExeDecode(Index, Instance: Integer; Input: Pointer; + StreamInfo: _StrInfo2; Funcs: PPrecompFuncs): Boolean; var - Buffer: PByte; - X, Y: Integer; - Res1: Integer; - Res2: NativeUInt; + X: Integer; Executed: Boolean; begin Result := False; - X := GetBits(StreamInfo^.Option, 0, 24); CodecSize[Instance] := 0; CodecAllocator[Instance] := Funcs^.Allocator; - with CodecExe[X] do - begin - if not DirectoryExists(WorkDir[Instance, 1]) then - CreateDir(WorkDir[Instance, 1]); - DeleteFile(WorkDir[Instance, 1] + InFile); - DeleteFile(WorkDir[Instance, 1] + OutFile); - case Mode[1] of - FILE_MODE, STDOUT_MODE: - begin - with TFileStream.Create(WorkDir[Instance, 1] + OutFile, fmCreate) do - try - WriteBuffer(NewInput^, StreamInfo^.NewSize); - finally - Free; - end; - if Mode[1] = FILE_MODE then - Executed := PrecompExec(PChar(Exec[1]), PChar(Param[1]), - PChar(WorkDir[Instance, 1])) - else - Executed := PrecompExecStdout(Instance, PChar(Exec[1]), - PChar(Param[1]), PChar(WorkDir[Instance, 1]), ExecOutput2); - end; - else - begin - if Mode[1] = STDIN_MODE then - Executed := PrecompExecStdin(PChar(Exec[1]), PChar(Param[1]), - PChar(WorkDir[Instance, 1]), NewInput, StreamInfo^.NewSize) - else - Executed := PrecompExecStdioProcess(Ctx[Instance, 1], NewInput, - StreamInfo^.NewSize, ExecOutput2, Continuous); - end; - end; - - if Executed then - begin - case Mode[1] of - FILE_MODE, STDIN_MODE: - begin - with TFileStream.Create(WorkDir[Instance, 1] + InFile, - fmShareDenyNone) do - try - Y := Read(WrkMem[Instance, 0], E_WORKMEM); - while Y > 0 do - begin - ExecOutput2(Instance, @WrkMem[Instance, 0], Y); - Y := Read(WrkMem[Instance, 0], E_WORKMEM); - end; - finally - Free; - end; - end; - end; - Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]); - Res1 := CodecSize[Instance]; - Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer, - StreamInfo^.OldSize); - if Result = False then - begin - Buffer := Funcs^.Allocator(Instance, - Res1 + Max(StreamInfo^.OldSize, Res1)); - Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1, - Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); - if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= - DIFF_TOLERANCE) then - begin - Output(Instance, Buffer + Res1, Res2); - SetBits(StreamInfo^.Option, 1, 31, 1); - Result := True; - end; - end; - end; - end; -end; - -function ExeRestore(Instance, Depth: Integer; Input, InputExt: Pointer; - StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; -var - Buffer: PByte; - X, Y: Integer; - Res1: Integer; - Res2: NativeUInt; - Executed: Boolean; -begin - Result := False; - X := GetBits(StreamInfo.Option, 0, 24); - CodecSize[Instance] := 0; - CodecAllocator[Instance] := Funcs^.Allocator; - with CodecExe[X] do + with CodecExe[Index] do begin if not DirectoryExists(WorkDir[Instance, 1]) then CreateDir(WorkDir[Instance, 1]); @@ -334,8 +346,8 @@ begin Executed := PrecompExecStdin(PChar(Exec[1]), PChar(Param[1]), PChar(WorkDir[Instance, 1]), Input, StreamInfo.NewSize) else - Executed := PrecompExecStdioProcess(Ctx[Instance, 1], Input, - StreamInfo.NewSize, ExecOutput2, Continuous); + Executed := ExecStdioProcess(Ctx[Instance, 1], Input, + StreamInfo.NewSize, ExecOutput2); end; end; if Executed then @@ -346,46 +358,246 @@ begin with TFileStream.Create(WorkDir[Instance, 1] + InFile, fmShareDenyNone) do try - Y := Read(WrkMem[Instance, 0], E_WORKMEM); - while Y > 0 do + X := Read(WrkMem[Instance, 0], E_WORKMEM); + while X > 0 do begin - ExecOutput2(Instance, @WrkMem[Instance, 0], Y); - Y := Read(WrkMem[Instance, 0], E_WORKMEM); + ExecOutput2(Instance, @WrkMem[Instance, 0], X); + X := Read(WrkMem[Instance, 0], E_WORKMEM); end; finally Free; end; end; end; - Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]); - Res1 := CodecSize[Instance]; - if GetBits(StreamInfo.Option, 31, 1) = 1 then + Result := True; + end; + end; +end; + +function ExeInit(Command: PChar; Count: Integer; Funcs: PPrecompFuncs): Boolean; +var + X, Y, Z: Integer; +begin + Result := True; + Randomize; + SetLength(WrkMem, Count); + SetLength(CodecSize, Count); + SetLength(CodecOutput, Count); + SetLength(CodecAllocator, Count); + for X := Low(CodecExe) to High(CodecExe) do + begin + SetLength(CodecExe[X].WorkDir, Count); + SetLength(CodecExe[X].Ctx, Count); + for Z := 0 to 1 do + for Y := Low(CodecSize) to High(CodecSize) do begin - Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize); - Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1, - Buffer + Res1, StreamInfo.OldSize); - if Res2 > 0 then - begin - Output(Instance, Buffer + Res1, StreamInfo.OldSize); - Result := True; - end; - exit; + repeat + CodecExe[X].WorkDir[Y, Z] := IncludeTrailingBackSlash + (IncludeTrailingBackSlash(GetCurrentDir) + CodecExe[X].Name + '_' + + IntToHex(Random($10000), 4)); + until DirectoryExists(CodecExe[X].WorkDir[Y, Z]) = False; + IncludeTrailingBackSlash(CodecExe[X].WorkDir[Y, Z]); + if CodecExe[X].Mode[Z] = STDIO_MODE then + CodecExe[X].Ctx[Y, Z] := ExecStdioInit(Y, PChar(CodecExe[X].Exec[Z]), + PChar(CodecExe[X].Param[Z]), PChar(CodecExe[X].WorkDir[Y, Z]), + CodecExe[X].IsLib[Z]); end; - if Res1 = StreamInfo.OldSize then + AddMethod(CodecExe[X].Name); + end; +end; + +procedure ExeFree(Funcs: PPrecompFuncs); +var + X, Y, Z: Integer; +begin + for X := Low(CodecExe) to High(CodecExe) do + for Z := 0 to 1 do + for Y := Low(CodecSize) to High(CodecSize) do begin - Output(Instance, Buffer, StreamInfo.OldSize); + if CodecExe[X].Mode[Z] = STDIO_MODE then + ExecStdioFree(CodecExe[X].Ctx[Y, Z]); + if DirectoryExists(CodecExe[X].WorkDir[Y, Z]) then + RemoveDir(CodecExe[X].WorkDir[Y, Z]); + end; +end; + +function ExeParse(Command: PChar; Option: PInteger; + Funcs: PPrecompFuncs): Boolean; +var + I: Integer; +begin + Result := False; + Option^ := 0; + for I := Low(CodecExe) to High(CodecExe) do + begin + if Funcs^.GetCodec(Command, 0, False) = CodecExe[I].Name then + begin + SetBits(Option^, CodecExe[I].ID, 0, 31); + Result := True; + break; + end; + end; +end; + +procedure ExeScan1(Instance, Depth: Integer; Input: PByte; + Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd; + Funcs: PPrecompFuncs); +var + Buffer: PByte; + X, Y: Integer; + SI1: _StrInfo1; + SI2: _StrInfo2; + DI1, DI2: TDepthInfo; + DS: TPrecompCmd; +begin + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); + if DS <> '' then + begin + X := IndexText(DS, Codec.Names); + if (X < 0) or (DI1.OldSize <> SizeEx) then + exit; + SI2.OldSize := SizeEx; + SI2.NewSize := 0; + if ExeEncode(X, Instance, Input, @SI2, Output, Funcs) then + begin + Output(Instance, Buffer, Y); + SI1.Position := 0; + SI1.OldSize := DI1.OldSize; + SI1.NewSize := Y; + ShowMessage(SI1.OldSize.ToString + ' >> ' + SI1.NewSize.ToString); + SetBits(SI1.Option, CodecExe[X].ID, 0, 31); + if System.Pos(SPrecompSep2, DI1.Codec) > 0 then + SI1.Status := TStreamStatus.Predicted + else + SI1.Status := TStreamStatus.None; + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI1.NewSize; + DI2.NewSize := SI1.NewSize; + Add(Instance, @SI1, DI1.Codec, @DI2); + end; + exit; + end; +end; + +function ExeScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; +var + I: Integer; + X: Integer; +begin + Result := False; + X := -1; + for I := Low(CodecExe) to High(CodecExe) do + begin + if GetBits(CodecExe[I].ID, 0, 31) = GetBits(StreamInfo^.Option, 0, 31) then + begin + X := I; + break; + end; + end; + Result := ExeEncode(X, Instance, Input, StreamInfo, Output, Funcs); +end; + +function ExeProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer; + StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; +var + Buffer: PByte; + I: Integer; + X: Integer; + Res1: Integer; + Res2: NativeUInt; +begin + Result := False; + X := -1; + for I := Low(CodecExe) to High(CodecExe) do + begin + if GetBits(CodecExe[I].ID, 0, 31) = GetBits(StreamInfo^.Option, 0, 31) then + begin + X := I; + break; + end; + end; + if ExeDecode(X, Instance, NewInput, StreamInfo^, Funcs) then + begin + Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]); + Res1 := CodecSize[Instance]; + Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer, + StreamInfo^.OldSize); + if Result = False then + begin + Buffer := Funcs^.Allocator(Instance, + Res1 + Max(StreamInfo^.OldSize, Res1)); + Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1, + Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); + if (Res2 > 0) and ((Res2 / Max(StreamInfo^.OldSize, Res1)) <= + DIFF_TOLERANCE) then + begin + Output(Instance, Buffer + Res1, Res2); + SetBits(StreamInfo^.Option, 1, 31, 1); Result := True; end; end; end; end; +function ExeRestore(Instance, Depth: Integer; Input, InputExt: Pointer; + StreamInfo: _StrInfo3; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; +var + Buffer: PByte; + I: Integer; + X: Integer; + Res1: Integer; + Res2: NativeUInt; + SI: _StrInfo2; +begin + Result := False; + X := -1; + for I := Low(CodecExe) to High(CodecExe) do + begin + if GetBits(CodecExe[I].ID, 0, 31) = GetBits(StreamInfo.Option, 0, 31) then + begin + X := I; + break; + end; + end; + SI.OldSize := StreamInfo.OldSize; + SI.NewSize := StreamInfo.NewSize; + SI.Resource := StreamInfo.Resource; + SI.Option := StreamInfo.Option; + if ExeDecode(X, Instance, Input, SI, Funcs) then + begin + Buffer := Funcs^.Allocator(Instance, CodecSize[Instance]); + Res1 := CodecSize[Instance]; + if GetBits(StreamInfo.Option, 31, 1) = 1 then + begin + Buffer := Funcs^.Allocator(Instance, Res1 + StreamInfo.OldSize); + Res2 := PrecompDecodePatch(InputExt, StreamInfo.ExtSize, Buffer, Res1, + Buffer + Res1, StreamInfo.OldSize); + if Res2 > 0 then + begin + Output(Instance, Buffer + Res1, StreamInfo.OldSize); + Result := True; + end; + exit; + end; + if Res1 = StreamInfo.OldSize then + begin + Output(Instance, Buffer, StreamInfo.OldSize); + Result := True; + end; + end; +end; + var I, J, X: Integer; S1, S2: String; + Bytes: TBytes; Ini: TMemIniFile; SL: TStringList; ExeStruct: PExeStruct; + Y, Z: Integer; initialization @@ -397,14 +609,16 @@ begin Ini.ReadSections(SL); for I := 0 to SL.Count - 1 do if FileExists(ExtractFilePath(Utils.GetModuleName) + - GetCmdStr(Ini.ReadString(SL[I], 'Encode', ''), 0)) then + GetCmdStr(Ini.ReadString(SL[I], 'Decode', ''), 0)) then begin New(ExeStruct); Insert(SL[I], Codec.Names, Length(Codec.Names)); ExeStruct^.Name := SL[I]; - ExeStruct^.Continuous := Ini.ReadBool(SL[I], 'Continous', False); + Bytes := BytesOf(ExeStruct^.Name); + ExeStruct^.ID := Utils.Hash32(0, @Bytes[0], Length(Bytes)); for X := 0 to 1 do begin + ExeStruct^.IsLib[X] := False; if X = 0 then S1 := Ini.ReadString(SL[I], 'Encode', '') else @@ -416,7 +630,13 @@ begin for J := 1 to GetCmdCount(S1) do begin S2 := GetCmdStr(S1, J); - if ContainsText(S2, '') then + if ContainsText(S2, '') then + begin + SetBits(ExeStruct^.Mode[X], STDIO_MODE, 0, 2); + ExeStruct^.IsLib[X] := True; + continue; + end + else if ContainsText(S2, '') then begin SetBits(ExeStruct^.Mode[X], 1, 0, 1); continue; @@ -469,4 +689,12 @@ Codec.Scan2 := @ExeScan2; Codec.Process := @ExeProcess; Codec.Restore := @ExeRestore; +finalization + +for X := Low(CodecExe) to High(CodecExe) do + for Z := 0 to 1 do + for Y := Low(CodecSize) to High(CodecSize) do + if DirectoryExists(CodecExe[X].WorkDir[Y, Z]) then + RemoveDir(CodecExe[X].WorkDir[Y, Z]); + end. diff --git a/precompressor/PrecompINI.pas b/precompressor/PrecompINI.pas index 3188ee9..198a4e6 100644 --- a/precompressor/PrecompINI.pas +++ b/precompressor/PrecompINI.pas @@ -198,6 +198,8 @@ var StreamPosInt, StreamOffsetInt, OldSizeInt, NewSizeInt: NativeInt; SI: _StrInfo1; begin + if Depth > 0 then + exit; for I := Low(CodecCfg[Instance]) to High(CodecCfg[Instance]) do for J := Low(CodecCfg[Instance, I]) to High(CodecCfg[Instance, I]) do if CodecEnabled[I, J] then @@ -308,7 +310,8 @@ begin end; function ConfigScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; begin Result := False; end; diff --git a/precompressor/PrecompLZ4.pas b/precompressor/PrecompLZ4.pas index 702ee31..b0c0978 100644 --- a/precompressor/PrecompLZ4.pas +++ b/precompressor/PrecompLZ4.pas @@ -14,10 +14,11 @@ var implementation const - LZ4Codecs: array of PChar = ['lz4', 'lz4hc']; - CODEC_COUNT = 2; + LZ4Codecs: array of PChar = ['lz4', 'lz4hc', 'lz4f']; + CODEC_COUNT = 3; LZ4_CODEC = 0; LZ4HC_CODEC = 1; + LZ4F_CODEC = 2; const L_MAXSIZE = 16 * 1024 * 1024; @@ -62,6 +63,15 @@ begin for I := Low(SOList) to High(SOList) do SOList[I][LZ4HC_CODEC].Update ([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True); + end + else if (CompareText(S, LZ4Codecs[LZ4F_CODEC]) = 0) and LZ4DLL.DLLLoaded + then + begin + CodecEnabled[LZ4F_CODEC] := True; + if Funcs^.GetParam(Command, X, 'l') <> '' then + for I := Low(SOList) to High(SOList) do + SOList[I][LZ4F_CODEC].Update + ([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True); end; Inc(X); end; @@ -107,6 +117,14 @@ begin if Funcs^.GetParam(Command, I, 'l') <> '' then SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'l')), 5, 7); Result := True; + end + else if (CompareText(S, LZ4Codecs[LZ4F_CODEC]) = 0) and LZ4DLL.DLLLoaded + then + begin + SetBits(Option^, 2, 0, 5); + if Funcs^.GetParam(Command, I, 'l') <> '' then + SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'l')), 5, 7); + Result := True; end; Inc(I); end; @@ -117,85 +135,55 @@ procedure LZ4Scan1(Instance, Depth: Integer; Input: PByte; Funcs: PPrecompFuncs); var Buffer: PByte; - Pos: NativeInt; - LSize: NativeInt; - P: Integer; - Frame: Byte; - CSize, DSize: Integer; + X, Y: Integer; SI: _StrInfo1; - DI: TDepthInfo; + DI1, DI2: TDepthInfo; DS: TPrecompCmd; begin - if BoolArray(CodecEnabled, False) then - exit; - Buffer := Funcs^.Allocator(Instance, L_MAXSIZE); - Pos := 0; - LSize := Size - 11; - while Pos < LSize do - begin - if (PInteger(Input + Pos)^ = $184D2204) then - begin - P := 0; - Inc(P, 4); - Frame := PByte(Input + Pos + P)^; - if Frame = $64 then - begin - Inc(P, 3); - CSize := PInteger(Input + Pos + P)^; - Inc(P, 4); - DSize := LZ4_decompress_safe((Input + Pos + P), Buffer, CSize, - L_MAXSIZE); - if CSize > DSize then - begin - Inc(Pos); - continue; - end - else - begin - Output(Instance, Buffer, DSize); - SI.Position := Pos + P; - SI.OldSize := CSize; - SI.NewSize := DSize; - SI.Option := 0; - SI.Status := TStreamStatus.None; - Add(Instance, @SI, nil, nil); - Inc(Pos, P); - continue; - end; - end; - end; - Inc(Pos); - end; - DI := Funcs^.GetDepthInfo(Instance); - DS := Funcs^.GetCodec(DI.Codec, 0, False); + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); if DS <> '' then begin - if IndexTextW(@DS[0], LZ4Codecs) < 0 then + X := IndexTextW(@DS[0], LZ4Codecs); + if (X < 0) or (DI1.OldSize <> SizeEx) then exit; - end - else + if not CodecAvailable[X] then + exit; + Y := Max(DI1.NewSize, L_MAXSIZE); + Buffer := Funcs^.Allocator(Instance, Y); + case X of + LZ4_CODEC, LZ4HC_CODEC: + Y := LZ4_decompress_safe(Input, Buffer, DI1.OldSize, Y); + LZ4F_CODEC: + Y := LZ4F_decompress_safe(Input, Buffer, DI1.OldSize, Y); + end; + if (Y > DI1.OldSize) then + begin + Output(Instance, Buffer, Y); + SI.Position := 0; + SI.OldSize := DI1.OldSize; + SI.NewSize := Y; + 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; + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI.NewSize; + DI2.NewSize := SI.NewSize; + Add(Instance, @SI, DI1.Codec, @DI2); + end; exit; - if (DI.OldSize <> Size) or (DI.OldSize >= DI.NewSize) then - exit; - Buffer := Funcs^.Allocator(Instance, DI.NewSize); - DSize := LZ4_decompress_safe(Input, Buffer, Size, DI.NewSize); - if (DSize > DI.OldSize) then - begin - Output(Instance, Buffer, DSize); - SI.Position := 0; - SI.OldSize := DI.OldSize; - SI.NewSize := DSize; - SI.Option := 0; - if System.Pos(SPrecompSep2, DI.Codec) > 0 then - SI.Status := TStreamStatus.Predicted - else - SI.Status := TStreamStatus.None; - Add(Instance, @SI, DI.Codec, nil); end; + if BoolArray(CodecEnabled, False) then + exit; + // end; function LZ4Scan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Buffer: PByte; X: Integer; @@ -203,18 +191,19 @@ var begin Result := False; X := GetBits(StreamInfo^.Option, 0, 5); - if StreamInfo^.NewSize <= 0 then + if StreamInfo^.OldSize <= 0 then exit; + StreamInfo^.NewSize := Max(StreamInfo^.NewSize, L_MAXSIZE); Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); case X of LZ4_CODEC, LZ4HC_CODEC: Res := LZ4_decompress_safe(Input, Buffer, StreamInfo^.OldSize, StreamInfo^.NewSize); - else - Res := LZ4_decompress_safe(Input, Buffer, StreamInfo^.OldSize, - StreamInfo^.NewSize); + LZ4F_CODEC: + Res := LZ4F_decompress_safe(Input, Buffer, StreamInfo^.OldSize, + StreamInfo^.NewSize); end; - if Res = StreamInfo^.NewSize then + if Res > StreamInfo^.OldSize then begin StreamInfo^.NewSize := Res; Output(Instance, Buffer, Res); @@ -227,15 +216,17 @@ function LZ4Process(Instance, Depth: Integer; OldInput, NewInput: Pointer; var Buffer, Ptr: PByte; I: Integer; - X: Integer; + X, Y: Integer; Res1: Integer; Res2: NativeUInt; + LZ4FT: LZ4F_preferences_t; begin Result := False; X := GetBits(StreamInfo^.Option, 0, 5); if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then exit; - Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); + Y := LZ4F_compressFrameBound(StreamInfo^.NewSize, nil); + Buffer := Funcs^.Allocator(Instance, Y); SOList[Instance][X].Index := 0; while SOList[Instance][X].Get(I) >= 0 do begin @@ -244,11 +235,16 @@ begin continue; case X of LZ4_CODEC: - Res1 := LZ4_compress_default(NewInput, Buffer, StreamInfo^.NewSize, - StreamInfo^.NewSize); + Res1 := LZ4_compress_default(NewInput, Buffer, StreamInfo^.NewSize, Y); LZ4HC_CODEC: - Res1 := LZ4_compress_HC(NewInput, Buffer, StreamInfo^.NewSize, - StreamInfo^.NewSize, I); + Res1 := LZ4_compress_HC(NewInput, Buffer, StreamInfo^.NewSize, Y, I); + LZ4F_CODEC: + begin + FillChar(LZ4FT, SizeOf(LZ4F_preferences_t), 0); + LZ4FT.compressionLevel := I; + Res1 := LZ4F_compressFrame(Buffer, Y, NewInput, + StreamInfo^.NewSize, LZ4FT); + end; end; Result := (Res1 = StreamInfo^.OldSize) and CompareMem(OldInput, Buffer, StreamInfo^.OldSize); @@ -283,19 +279,30 @@ var X: Integer; Res1: Integer; Res2: NativeUInt; + LZ4FT: LZ4F_preferences_t; begin Result := False; X := GetBits(StreamInfo.Option, 0, 5); if BoolArray(CodecAvailable, False) or (CodecAvailable[X] = False) then exit; - Buffer := Funcs^.Allocator(Instance, StreamInfo.NewSize); + Buffer := Funcs^.Allocator(Instance, + LZ4F_compressFrameBound(StreamInfo.NewSize, nil)); case X of LZ4_CODEC: Res1 := LZ4_compress_default(Input, Buffer, StreamInfo.NewSize, - StreamInfo.NewSize); + LZ4F_compressFrameBound(StreamInfo.NewSize, nil)); LZ4HC_CODEC: Res1 := LZ4_compress_HC(Input, Buffer, StreamInfo.NewSize, - StreamInfo.NewSize, GetBits(StreamInfo.Option, 5, 7)); + LZ4F_compressFrameBound(StreamInfo.NewSize, nil), + GetBits(StreamInfo.Option, 5, 7)); + LZ4F_CODEC: + begin + FillChar(LZ4FT, SizeOf(LZ4F_preferences_t), 0); + LZ4FT.compressionLevel := GetBits(StreamInfo.Option, 5, 7); + Res1 := LZ4F_compressFrame(Buffer, + LZ4F_compressFrameBound(StreamInfo.NewSize, nil), Input, + StreamInfo.NewSize, LZ4FT); + end; end; if GetBits(StreamInfo.Option, 31, 1) = 1 then begin diff --git a/precompressor/PrecompLZO.pas b/precompressor/PrecompLZO.pas index a3ed271..e8d85b6 100644 --- a/precompressor/PrecompLZO.pas +++ b/precompressor/PrecompLZO.pas @@ -180,10 +180,49 @@ procedure LZOScan1(Instance, Depth: Integer; Input: PByte; Funcs: PPrecompFuncs); var Buffer: PByte; + X: Integer; + Res: NativeUInt; Pos: NativeInt; LZOSI: TLZOSI; SI: _StrInfo1; + DI1, DI2: TDepthInfo; + DS: TPrecompCmd; begin + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); + if DS <> '' then + begin + X := IndexTextW(@DS[0], LZOCodecs); + if (X < 0) or (DI1.OldSize <> SizeEx) then + exit; + if not CodecAvailable[X] then + exit; + Res := Max(DI1.NewSize, L_MAXSIZE); + Buffer := Funcs^.Allocator(Instance, Res); + case X of + LZO1X_CODEC: + if not lzo1x_decompress_safe(Input, DI1.OldSize, Buffer, @Res) = 0 then + Res := 0; + end; + if (Res > DI1.OldSize) then + begin + Output(Instance, Buffer, Res); + SI.Position := 0; + SI.OldSize := DI1.OldSize; + SI.NewSize := Res; + 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; + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI.NewSize; + DI2.NewSize := SI.NewSize; + Add(Instance, @SI, DI1.Codec, @DI2); + end; + exit; + end; if BoolArray(CodecEnabled, False) then exit; Buffer := Funcs^.Allocator(Instance, L_MAXSIZE); @@ -207,34 +246,26 @@ begin end; function LZOScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Buffer: PByte; X: Integer; Res: NativeUInt; - LZOSI: TLZOSI; begin Result := False; X := GetBits(StreamInfo^.Option, 0, 5); - if (StreamInfo^.OldSize = 0) or (StreamInfo^.NewSize = 0) then - begin - Buffer := Funcs^.Allocator(Instance, L_MAXSIZE); - if GetLZOSI(Input, Size, Buffer, L_MAXSIZE, @LZOSI) then - begin - StreamInfo^.OldSize := LZOSI.CSize; - StreamInfo^.NewSize := LZOSI.DSize; - end; - end - else - Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); - Res := StreamInfo^.NewSize; + if StreamInfo^.OldSize <= 0 then + exit; + Res := Max(StreamInfo^.NewSize, L_MAXSIZE); + Buffer := Funcs^.Allocator(Instance, Res); case X of LZO1X_CODEC: if not lzo1x_decompress_safe(Input, StreamInfo^.OldSize, Buffer, @Res) = 0 then Res := 0; end; - if Res = StreamInfo^.NewSize then + if Res > StreamInfo^.OldSize then begin StreamInfo^.NewSize := Res; Output(Instance, Buffer, Res); diff --git a/precompressor/PrecompMain - Copy.pas b/precompressor/PrecompMain - Copy.pas deleted file mode 100644 index 904f968..0000000 --- a/precompressor/PrecompMain - Copy.pas +++ /dev/null @@ -1,991 +0,0 @@ -unit PrecompMain; - -interface - -uses - Main, Threading, Utils, ParseClass, ParseExpr, - PrecompUtils, PrecompZLib, - WinAPI.Windows, - System.SysUtils, System.Classes, System.SyncObjs, System.Math, System.Types, - System.StrUtils, System.RTLConsts, - System.Generics.Defaults, System.Generics.Collections; - -const - XTOOL_PRECOMP = $304C5458; - -type - TEncodeOptions = record - Method: AnsiString; - ChunkSize, Threads: Integer; - Depth: Integer; - LowMem: Boolean; - HistorySize: Boolean; - HistoryFile: String; - end; - - TDecodeOptions = record - Method: AnsiString; - Threads: Integer; - end; - -procedure PrintHelp; -procedure Parse(ParamArg: TArray; out Options: TEncodeOptions); - overload; -procedure Parse(ParamArg: TArray; out Options: TDecodeOptions); - overload; -// reuse resources when going in-depth -// make an array of all common resources for depth -// depth will be hard af to add -// check if at least one of the functions exists in a dll before using it -// number of chunks to process when decoding -procedure Encode(Input, Output: TStream; Options: TEncodeOptions); -procedure Decode(Input, Output: TStream; Options: TDecodeOptions); - -function PrecompGetCodec(Cmd: PAnsiChar; Index: Integer; WithParams: Boolean) - : PAnsiChar stdcall; -function PrecompGetParam(Cmd: PAnsiChar; Index: Integer; Param: PAnsiChar) - : PAnsiChar stdcall; -function PrecompAllocator(Instance: Integer; Size: Integer): Pointer stdcall; - -procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer; - Size: Integer)stdcall; -procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer; - Size: Integer)stdcall; -procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer; - Size: Integer)stdcall; -procedure PrecompAddStream1(Instance: Integer; Info: PStrInfo1; - Codec: PAnsiChar)stdcall; - -implementation - -var - Codecs: array of TPrecompressor; - PrecompFunctions: _PrecompFuncs; - -procedure PrintHelp; -var - I, J: Integer; - S: string; -begin - Console.Write('precomp - data precompressor'); - Console.Write(''); - Console.Write('Usage:'); - Console.Write - (' xtool precomp:method1,method2,methodN...:param1,param2,paramN... input output'); - Console.Write(''); - (* Console.Write('Methods:'); - for I := Low(Codecs) to High(Codecs) do - begin - S := ''; - for J := Low(Codecs[I]) to High(Codecs[I]) do - begin - if (IndexText(Codecs[I][J], Codecs[I]) = J) then - S := S + Codecs[I][J] + ', '; - end; - Delete(S, Length(S) - 1, 2); - Console.Write(' ' + S); - end; *) - Console.Write(''); - Console.Write('Parameters:'); - Console.Write(' c# - scanning range of precompressor [16mb]'); - Console.Write(' t# - number of working threads [Threads/2]'); - Console.Write(' lm - low memory mode'); - Console.Write(' hs - enable history database'); - Console.Write(' hf# - history database file'); - Console.Write(''); -end; - -procedure Parse(ParamArg: TArray; out Options: TEncodeOptions); -var - ArgParse: TArgParser; - ExpParse: TExpressionParser; - S: String; -begin - ArgParse := TArgParser.Create(ParamArg); - ExpParse := TExpressionParser.Create; - try - Options.Method := AnsiString(ArgParse.AsString('-m')); - S := ArgParse.AsString('-c', '16mb'); - S := ReplaceText(S, 'KB', '* 1024^1'); - S := ReplaceText(S, 'MB', '* 1024^2'); - S := ReplaceText(S, 'GB', '* 1024^3'); - Options.ChunkSize := Max(4194304, Round(ExpParse.Evaluate(S))); - S := ArgParse.AsString('-t', '50p'); - S := ReplaceText(S, 'p', '%'); - S := ReplaceText(S, '%', '%*' + CPUCount.ToString); - Options.Threads := Max(1, Round(ExpParse.Evaluate(S))); - Options.Depth := Succ(ArgParse.AsInteger('-d')); - Options.LowMem := ArgParse.AsBoolean('-lm'); - finally - ArgParse.Free; - ExpParse.Free; - end; -end; - -procedure Parse(ParamArg: TArray; out Options: TDecodeOptions); -var - ArgParse: TArgParser; - ExpParse: TExpressionParser; - S: String; -begin - ArgParse := TArgParser.Create(ParamArg); - ExpParse := TExpressionParser.Create; - try - Options.Method := AnsiString(ArgParse.AsString('-m')); - S := ArgParse.AsString('-t', '50p'); - S := ReplaceText(S, 'p', '%'); - S := ReplaceText(S, '%', '%*' + CPUCount.ToString); - Options.Threads := Max(1, Round(ExpParse.Evaluate(S))); - finally - ArgParse.Free; - ExpParse.Free; - end; -end; - -function GetIndex(Scanned, Processed: TArray): Integer; -var - I: Integer; -begin - if BoolArray(Processed, True) then - begin - Result := -2; - exit; - end - else - Result := -1; - for I := Low(Scanned) to High(Scanned) do - begin - if (Scanned[I] = True) and (Processed[I] = False) then - begin - Result := I; - break; - end; - end; -end; - -type - TCommonVars = record - MemStream: TMemoryStream; - DataStore: TDataStore; - MemOutput: TArray; - InfoStore1: TArray>; - InfoStore2: TList; - Scanned1, Scanned2, Processed: TArray; - CurPos: TArray; - CurCodec: TArray; - StrIdx: TArray; - ThrIdx: TArray; - end; - -var - ComVars: TArray; - DepIdx: TArray; - Sync: TCriticalSection; - Tasks: TArray; - WorkStream: TArray; - History: TDictionary; - Duplicates: TDictionary; - - // history should not depend on the streams about to be processed, check before doing this - -procedure CodecInit(Count: Integer; Method: AnsiString); -var - I, X, Y: Integer; - S: AnsiString; - List: TStringDynArray; -begin - PrecompFunctions.GetCodec := @PrecompGetCodec; - PrecompFunctions.GetParam := @PrecompGetParam; - PrecompFunctions.Allocator := @PrecompAllocator; - if Method = '' then - exit; - Insert(PrecompZLib.Codec, Codecs, Length(Codecs)); - for X := High(Codecs) downto Low(Codecs) do - for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do - Insert(String(Codecs[X].Names[Y]), List, Length(List)); - I := 0; - while Assigned(PrecompGetCodec(PAnsiChar(Method), I, False)) do - begin - if IndexText(String(PrecompGetCodec(PAnsiChar(Method), I, False)), List) < 0 - then - raise Exception.CreateFmt(SPrecompError1, - [String(PrecompGetCodec(PAnsiChar(Method), I, False))]); - Inc(I); - end; - for X := High(Codecs) downto Low(Codecs) do - begin - S := ''; - for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do - begin - I := 0; - while Assigned(PrecompGetCodec(PAnsiChar(Method), I, False)) do - begin - if SameText(String(PrecompGetCodec(PAnsiChar(Method), I, False)), - String(Codecs[X].Names[Y])) then - S := S + AnsiString(PrecompGetCodec(PAnsiChar(Method), I, - True)) + '+'; - Inc(I); - end; - end; - if S <> '' then - begin - SetLength(S, Length(S) - 1); - Codecs[X].Initialized := Codecs[X].Init(PAnsiChar(S), Count, - @PrecompFunctions); - end - else - Delete(Codecs, X, 1); - end; -end; - -procedure CodecFree(Count: Integer); -var - I: Integer; -begin - for I := Low(Codecs) to High(Codecs) do - if Codecs[I].Initialized then - Codecs[I].Free(@PrecompFunctions); -end; - -function PrecompGetCodec(Cmd: PAnsiChar; Index: Integer; WithParams: Boolean) - : PAnsiChar; -var - List: TStringDynArray; -begin - Result := nil; - if Assigned(Cmd) then - begin - List := DecodeStr(String(Cmd), '+'); - if InRange(Index, Low(List), High(List)) then - if WithParams then - Result := PAnsiChar(AnsiString(List[Index])) - else - Result := PAnsiChar(AnsiString(DecodeStr(List[Index], ':')[0])); - end; -end; - -function PrecompGetParam(Cmd: PAnsiChar; Index: Integer; Param: PAnsiChar) - : PAnsiChar; -var - List1, List2: TStringDynArray; - I: Integer; -begin - Result := nil; - if Assigned(Cmd) then - begin - List1 := DecodeStr(String(Cmd), '+'); - if InRange(Index, Low(List1), High(List1)) then - begin - List2 := DecodeStr(List1[Index], ':'); - if Length(List2) > 1 then - begin - if not Assigned(Param) then - Result := PAnsiChar(AnsiString(List2[1])) - else - begin - List1 := DecodeStr(List2[1], ','); - for I := Low(List1) to High(List1) do - if List1[I].StartsWith(String(Param), True) then - Result := PAnsiChar - (AnsiString(List1[I].Substring(Length(String(Param))))); - end; - end; - end; - end; -end; - -function PrecompAllocator(Instance: Integer; Size: Integer): Pointer; -begin - with ComVars[DepIdx[Instance]] do - begin - if WorkStream[Instance].Size < Size then - WorkStream[Instance].Size := Size; - Result := WorkStream[Instance].Memory; - end; -end; - -procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer; - Size: Integer); -begin - with ComVars[DepIdx[Instance]] do - begin - case Size of - - 1: - MemOutput[Instance].Position := CurPos[Instance]; - else - MemOutput[Instance].WriteBuffer(Buffer^, Size); - end; - end; -end; - -// TMemoryMap - -procedure PrecompAddStream1(Instance: Integer; Info: PStrInfo1; - Codec: PAnsiChar); -var - SI1: TEncodeSI; - SI2: TFutureSI; - LValid: Boolean; - LCodec: Byte; - LOption: Integer; - I, X, Y: Integer; - S: String; -begin - // add overhead function - with ComVars[DepIdx[Instance]] do - begin - if (Info^.Position < 0) or (MemOutput[Instance].Position - CurPos[Instance] - <> Info^.NewSize) then - begin - MemOutput[Instance].Position := CurPos[Instance]; - exit; - end; - if Assigned(Codec) then - begin - LValid := False; - I := 0; - while Assigned(PrecompGetCodec(Codec, I, False)) do - begin - for X := Low(Codecs) to High(Codecs) do - begin - for Y := Low(Codecs[X].Names) to High(Codecs[X].Names) do - if SameText(String(PrecompGetCodec(Codec, I, False)), - String(Codecs[X].Names[Y])) then - begin - LCodec := X; - if Codecs[X].Initialized then - if Codecs[X].Parse(PrecompGetCodec(Codec, I, True), @LOption, - @PrecompFunctions) then - begin - LValid := True; - break; - end; - end; - if LValid then - break; - end; - Inc(I); - end; - if not LValid then - begin - MemOutput[Instance].Position := CurPos[Instance]; - exit; - end; - end - else - begin - LCodec := CurCodec[Instance]; - LOption := Info^.Option; - end; - if Info^.Position < Min(DataStore.Size, DataStore.Slot[Instance].Size) then - begin - FillChar(SI1, SizeOf(TEncodeSI), 0); - SI1.ActualPosition := Info^.Position; - SI1.StorePosition := CurPos[Instance]; - SI1.OriginalSize := Info^.OldSize; - SI1.UnpackedSize := Info^.NewSize; - SI1.Codec := LCodec; - SI1.Option := LOption; - SI1.Status := Info^.Status; - InfoStore1[Instance].Add(SI1); - end - else - begin - FillChar(SI2, SizeOf(TFutureSI), 0); - SI2.Position := DataStore.Position[Instance] + Info^.Position; - SI2.OriginalSize := Info^.OldSize; - SI2.UnpackedSize := Info^.NewSize; - SI2.Codec := LCodec; - SI2.Option := LOption; - SI2.Status := Info^.Status; - Sync.Acquire; - InfoStore2.Add(SI2); - Sync.Release; - end; - CurPos[Instance] := MemOutput[Instance].Position; - end; -end; - -// endian(CSize,4) - -procedure Scan1(Index: Integer); -var - I: Integer; -begin - with ComVars[DepIdx[Index]] do - for I := Low(Codecs) to High(Codecs) do - begin - try - CurPos[Index] := MemOutput[Index].Position; - CurCodec[Index] := I; - Codecs[I].Scan1(Index, DataStore.Slot[Index].Memory, - Min(DataStore.Size, DataStore.Slot[Index].Size), - DataStore.Slot[Index].Size, @PrecompOutput1, @PrecompAddStream1, - @PrecompFunctions); - except - end; - end; -end; - -procedure Scan2(Index: Integer); -var - I: Integer; -begin - (* while StrIdx2[Index] < InfoStore2.Count do - begin - // if InfoStore2[StrIdx2[Index]].Position then - // there is a problem here with the count when multi threading... - Inc(StrIdx2[Index]); - end; - for I := Low(Codecs) to High(Codecs) do - begin - try - CurPos[Index] := MemOutput[Index].Position; - CurCodec[Index] := I; - Codecs[Index][I].Scan2(Index, DataStore.Slot[Index].Memory, - Min(DataStore.Size, DataStore.Slot[Index].Size), - DataStore.Slot[Index].Size, @PrecompAllocator, @PrecompCompress, - @PrecompOutput1, @PrecompAddStream1); - except - end; - end; *) -end; - -// use TDictionary for history and deduplication - -procedure Process(Index, ThreadIndex, StreamIndex: Integer); -var - SI1: _StrInfo2; - SI2: TEncodeSI; - Res: Boolean; -begin - with ComVars[DepIdx[Index]] do - begin - SI2 := InfoStore1[ThreadIndex][StreamIndex]; - SI1.OldSize := SI2.OriginalSize; - SI1.NewSize := SI2.UnpackedSize; - SI1.Option := SI2.Option; - SI1.Status := SI2.Status; - CurPos[Index] := MemOutput[Index].Position; - CurCodec[Index] := SI2.Codec; - try - Res := Codecs[SI2.Codec].Process(Index, - PByte(DataStore.Slot[ThreadIndex].Memory) + SI2.ActualPosition, - PByte(MemOutput[ThreadIndex].Memory) + SI2.StorePosition, @SI1, - @PrecompOutput1, @PrecompFunctions); - except - Res := False; - end; - if Res then - begin - SI2.OriginalSize := SI1.OldSize; - SI2.UnpackedSize := SI1.NewSize; - SI2.Option := SI1.Option; - SI2.Status := TStreamStatus(SuccessStatus); - SI2.ExtPosition := CurPos[Index]; - SI2.ExtSize := MemOutput[Index].Position - CurPos[Index]; - SI2.ExtThread := Index; - InfoStore1[ThreadIndex][StreamIndex] := SI2; - CurPos[Index] := MemOutput[Index].Position; - end; - end; -end; - -procedure EncThread(Y: Integer); -var - X, Z: Integer; - History: Boolean; -begin - with ComVars[DepIdx[Y]] do - begin - if InRange(Y, Low(InfoStore1), High(InfoStore1)) then - begin - Scan1(Y); - Scanned1[Y] := True; - // try to process even before scan finishes - (* if ExternalInUse(EOptions.Method) then - while BoolArray(Scanned1, False) do - Sleep(10); *) - // Scan2(Y); - InfoStore1[Y].Sort; - Scanned2[Y] := True; - end; - // if index < count give the thread index, check this for all threads - // should give more speed - while True do - begin - Z := GetIndex(Scanned2, Processed); - while Z = -1 do - begin - Sleep(10); - Z := GetIndex(Scanned2, Processed); - end; - ThrIdx[Y] := Z; - if Z < -1 then - break; - X := AtomicIncrement(StrIdx[Z]); - while X < InfoStore1[Z].Count do - begin - History := False; - Process(Y, Z, X); - if History = False then - begin - // Int64Rec(HD.Tag).Lo := SI.Checksum; - // Int64Rec(HD.Tag).Hi := SI.UnpackedSize; - end; - Z := GetIndex(Scanned2, Processed); - while Z = -1 do - begin - Sleep(10); - Z := GetIndex(Scanned2, Processed); - end; - ThrIdx[Y] := Z; - if Z < -1 then - break; - X := AtomicIncrement(StrIdx[Z]); - end; - if Z < -1 then - break; - if X >= InfoStore1[Z].Count then - Processed[Z] := True; - end; - end; -end; - -procedure InternalEncode(Input, Output: TStream; Options: TEncodeOptions; - Index, Depth: Integer); -var - GUID: TGUID; - StreamInfo: TEncodeSI; - StreamHeader: TStreamHeader; - StreamCount: Int32; - BlockSize: Int64; - UI32: UInt32; - I, J: Integer; - LastStream, LastPos: Int64; -begin - I := XTOOL_PRECOMP; - Output.WriteBuffer(I, I.Size); - CreateGUID(GUID); - Output.WriteBuffer(GUID, SizeOf(GUID)); - LongRec(I).Bytes[0] := Length(Options.Method); - Output.WriteBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size); - Output.WriteBuffer(Options.Method[1], LongRec(I).Bytes[0]); - Sync := TCriticalSection.Create; - if Index = 0 then - begin - SetLength(DepIdx, Options.Threads); - SetLength(ComVars, Options.Depth); - for J := Low(ComVars) to High(ComVars) do - with ComVars[J] do - begin - MemStream := TMemoryStream.Create; - SetLength(MemOutput, Options.Threads); - SetLength(ThrIdx, Options.Threads); - if Options.LowMem then - I := 1 - else - I := Options.Threads; - SetLength(InfoStore1, I); - SetLength(StrIdx, I); - SetLength(Scanned1, I); - SetLength(Scanned2, I); - SetLength(Processed, I); - SetLength(CurPos, I); - SetLength(CurCodec, I); - end; - end; - SetLength(Tasks, Options.Threads); - SetLength(WorkStream, Options.Threads); - for I := Low(Tasks) to High(Tasks) do - begin - if Length(Tasks) > 1 then - Tasks[I] := TTask.Create(I); - MemOutput[I] := TMemoryStream.Create; - WorkStream[I] := TMemoryStream.Create; - end; - for I := Low(InfoStore1) to High(InfoStore1) do - InfoStore1[I] := TListEx.Create(EncodeSICmp); - InfoStore2 := TList.Create(FutureSICmp); - // if FileExists(Options.HistoryFile) then - // LoadHistory(HistoryList, Options.HistoryFile); - DataStore := TDataStore.Create(Input, True, Length(InfoStore1), - Options.ChunkSize); - CodecInit(Options.Threads, Options.Method); - LastStream := 0; - DataStore.Load; - while not DataStore.Done do - begin - if Length(Tasks) > 1 then - if IsErrored(Tasks) then - for I := Low(Tasks) to High(Tasks) do - Tasks[I].RaiseLastError; - for I := Low(InfoStore1) to High(InfoStore1) do - begin - InfoStore1[I].Count := 0; - StrIdx[I] := -1; - Scanned1[I] := False; - Scanned2[I] := False; - Processed[I] := False; - CurPos[I] := 0; - end; - for I := Low(Tasks) to High(Tasks) do - begin - ThrIdx[I] := 0; - MemOutput[I].Position := 0; - if Length(Tasks) > 1 then - begin - Tasks[I].Perform(EncThread); - Tasks[I].Start; - end - else - EncThread(0); - end; - for I := Low(InfoStore1) to High(InfoStore1) do - begin - while Processed[I] = False do - Sleep(10); - for J := Low(ThrIdx) to High(ThrIdx) do - while ThrIdx[J] = I do - Sleep(10); - // DEC MEM LIMIT HERE - LastPos := LastStream; - MemStream.Position := 0; - StreamCount := 0; - BlockSize := 0; - MemStream.WriteBuffer(StreamCount, StreamCount.Size); - MemStream.WriteBuffer(BlockSize, BlockSize.Size); - if InfoStore1[I].Count > 0 then - begin - InfoStore1[I].Index := 0; - J := InfoStore1[I].Get(StreamInfo); - while J >= 0 do - begin - if (Integer(StreamInfo.Status) <> SuccessStatus) or - (LastStream > StreamInfo.ActualPosition) or - (StreamInfo.ActualPosition >= Options.ChunkSize) then - InfoStore1[I].Delete(J) - else - begin - Inc(StreamCount); - StreamHeader.Kind := DEFAULT_STREAM; - if StreamInfo.ExtSize > 0 then - StreamHeader.Kind := StreamHeader.Kind or EXTENDED_STREAM; - StreamHeader.OldSize := StreamInfo.OriginalSize; - StreamHeader.NewSize := StreamInfo.UnpackedSize; - if StreamInfo.ExtSize > 0 then - begin - Inc(StreamHeader.NewSize, StreamInfo.ExtSize); - Inc(StreamHeader.NewSize, StreamInfo.ExtSize.Size); - end; - StreamHeader.Codec := StreamInfo.Codec; - StreamHeader.Option := StreamInfo.Option; - Inc(BlockSize, StreamHeader.NewSize); - MemStream.WriteBuffer(StreamHeader, SizeOf(TStreamHeader)); - LastStream := Int64(StreamInfo.ActualPosition) + - StreamInfo.OriginalSize; - end; - J := InfoStore1[I].Get(StreamInfo); - end; - MemStream.Position := 0; - MemStream.WriteBuffer(StreamCount, StreamCount.Size); - MemStream.WriteBuffer(BlockSize, BlockSize.Size); - Output.WriteBuffer(MemStream.Memory^, MemStream.Position + StreamCount * - SizeOf(TStreamHeader)); - InfoStore1[I].Index := 0; - J := InfoStore1[I].Get(StreamInfo); - while J >= 0 do - begin - Output.WriteBuffer - ((PByte(MemOutput[I].Memory) + StreamInfo.StorePosition)^, - StreamInfo.UnpackedSize); - if StreamInfo.ExtSize > 0 then - begin - Output.WriteBuffer((PByte(MemOutput[StreamInfo.ExtThread].Memory) + - StreamInfo.ExtPosition)^, StreamInfo.ExtSize); - Output.WriteBuffer(StreamInfo.ExtSize, StreamInfo.ExtSize.Size); - end; - J := InfoStore1[I].Get(StreamInfo); - end; - InfoStore1[I].Index := 0; - J := InfoStore1[I].Get(StreamInfo); - while J >= 0 do - begin - UI32 := StreamInfo.ActualPosition - LastPos; - Output.WriteBuffer(UI32, UI32.Size); - if UI32 > 0 then - Output.WriteBuffer((PByte(DataStore.Slot[I].Memory) + - LastPos)^, UI32); - LastPos := StreamInfo.ActualPosition + StreamInfo.OriginalSize; - J := InfoStore1[I].Get(StreamInfo); - end; - end - else - Output.WriteBuffer(StreamCount, StreamCount.Size); - UI32 := Max(Min(Options.ChunkSize, DataStore.Slot[I].Size) - LastPos, 0); - Output.WriteBuffer(UI32, UI32.Size); - if UI32 > 0 then - Output.WriteBuffer((PByte(DataStore.Slot[I].Memory) + LastPos)^, UI32); - LastStream := Max(LastStream - Options.ChunkSize, 0); - if I > 0 then - DataStore.LoadEx; - end; - DataStore.LoadEx; - if Length(Tasks) > 1 then - WaitForAll(Tasks); - end; - StreamCount := StreamCount.MinValue; - Output.WriteBuffer(StreamCount, StreamCount.Size); - CodecFree(Options.Threads); - for I := Low(Tasks) to High(Tasks) do - begin - if Length(Tasks) > 1 then - Tasks[I].Free; - MemOutput[I].Free; - WorkStream[I].Free; - end; - for I := Low(InfoStore1) to High(InfoStore1) do - InfoStore1[I].Free; - InfoStore2.Free; - DataStore.Free; - // if Options.HistoryFile <> '' then - // SaveHistory(HistoryList, Options.HistoryFile); - // SetLength(HistoryList, 0); - MemStream.Free; - Sync.Free; -end; - -var - DecInput, DecOutput: TStream; - Idx: Integer; - StreamPos: TArray; - Completed: TArray; - StreamCount: Int32; - BlockPos: Int64; - MemInput: TMemoryStream; - -procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer; - Size: Integer); -begin - DecOutput.WriteBuffer(Buffer^, Size); -end; - -procedure PrecompOutput3(Instance: Integer; const Buffer: Pointer; - Size: Integer); -begin - MemOutput[Instance].WriteBuffer(Buffer^, Size); -end; - -procedure Restore(MT: Boolean; ThreadIndex: Integer); -var - X: Integer; - Pos: Int64; - X64: Int64; - SI: _StrInfo3; - SH: PStreamHeader; - UI32: UInt32; - Ptr1, Ptr2: PByte; - LOutput: _PrecompOutput; -begin - Pos := 0; - X := AtomicIncrement(Idx); - while X < StreamCount do - begin - SH := PStreamHeader((PByte(MemStream.Memory) + X * SizeOf(TStreamHeader))); - if MT then - begin - LOutput := @PrecompOutput3; - Pos := StreamPos[X]; - X64 := Pos + SH^.NewSize; - while (BlockPos < X64) do - begin - if IsErrored(Tasks) or (BlockPos < 0) then - exit; - Sleep(1); - end; - MemOutput[ThreadIndex].Position := 0; - end - else - begin - LOutput := @PrecompOutput2; - DecInput.ReadBuffer(UI32, UI32.Size); - if UI32 > 0 then - DecOutput.CopyFrom(DecInput, UI32); - end; - SI.OldSize := SH^.OldSize; - SI.NewSize := SH^.NewSize; - SI.Option := SH^.Option; - Ptr1 := PByte(MemInput.Memory) + Pos; - if SH^.Kind and EXTENDED_STREAM = EXTENDED_STREAM then - begin - SI.ExtSize := PInteger(Ptr1 + SI.NewSize - SI.NewSize.Size)^; - SI.NewSize := SI.NewSize - SI.ExtSize - SI.ExtSize.Size; - Ptr2 := PByte(MemInput.Memory) + Pos + SI.NewSize; - end - else - Ptr2 := nil; - if (Codecs[SH^.Codec].Restore(ThreadIndex, Ptr1, Ptr2, SI, LOutput, - @PrecompFunctions) = False) then - raise Exception.CreateFmt(SPrecompError3, - [String(Codecs[SH^.Codec].Names[0])]); - if MT then - begin - Move(MemOutput[ThreadIndex].Memory^, Ptr1^, SI.OldSize); - Completed[X] := True; - end - else - begin - Inc(Pos, SH^.NewSize); - end; - X := AtomicIncrement(Idx);; - end; -end; - -procedure DecThread(Y: Integer); -begin - Restore(True, Y); -end; - -procedure ReadCallback(Pos: Int64); -begin - BlockPos := Pos; -end; - -// restore stuff by chunk - -procedure InternalDecode(Input, Output: TStream; Options: TDecodeOptions; - Index, Depth: Integer); -var - GUID: TGUID; - StreamHeader: PStreamHeader; - BlockSize: Int64; - CurrPos: Int64; - UI32: UInt32; - I, J: Integer; -begin - DecInput := Input; - DecOutput := Output; - Input.ReadBuffer(GUID, SizeOf(GUID)); - Input.ReadBuffer(LongRec(I).Bytes[0], LongRec(I).Bytes[0].Size); - SetLength(Options.Method, LongRec(I).Bytes[0]); - Input.ReadBuffer(Options.Method[1], LongRec(I).Bytes[0]); - MemStream := TMemoryStream.Create; - SetLength(Tasks, Options.Threads); - SetLength(MemOutput, Options.Threads); - SetLength(WorkStream, Options.Threads); - for I := Low(Tasks) to High(Tasks) do - begin - if Length(Tasks) > 1 then - Tasks[I] := TTask.Create(I); - MemOutput[I] := TMemoryStream.Create; - WorkStream[I] := TMemoryStream.Create; - end; - MemInput := TMemoryStream.Create; - CodecInit(Options.Threads, Options.Method); - Input.ReadBuffer(StreamCount, StreamCount.Size); - while StreamCount >= 0 do - begin - if Length(Tasks) > 1 then - if IsErrored(Tasks) then - for I := Low(Tasks) to High(Tasks) do - Tasks[I].RaiseLastError; - if StreamCount > 0 then - begin - BlockPos := 0; - Input.ReadBuffer(BlockSize, BlockSize.Size); - MemStream.Position := 0; - MemStream.CopyFrom(Input, StreamCount * SizeOf(TStreamHeader)); - CurrPos := 0; - if (Options.Threads > 1) and (StreamCount > 1) then - begin - if StreamCount > Length(StreamPos) then - SetLength(StreamPos, StreamCount); - SetLength(Completed, Length(StreamPos)); - for J := 0 to StreamCount - 1 do - begin - StreamPos[J] := CurrPos; - Completed[J] := False; - StreamHeader := - PStreamHeader((PByte(MemStream.Memory) + J * - SizeOf(TStreamHeader))); - Inc(CurrPos, Max(StreamHeader^.OldSize, StreamHeader^.NewSize)); - end; - end; - if MemInput.Size < BlockSize then - MemInput.Size := BlockSize; - MemInput.Position := 0; - Idx := -1; - if (Options.Threads > 1) and (StreamCount > 1) then - begin - for I := Low(Tasks) to High(Tasks) do - begin - Tasks[I].Perform(DecThread); - Tasks[I].Start; - end; - for J := 0 to StreamCount - 1 do - begin - StreamHeader := - PStreamHeader((PByte(MemStream.Memory) + J * - SizeOf(TStreamHeader))); - MemInput.Size := Max(MemInput.Size, MemInput.Position + - Max(StreamHeader^.OldSize, StreamHeader^.NewSize)); - if CopyStream(Input, MemInput, StreamHeader^.NewSize) <> - StreamHeader^.NewSize then - begin - BlockPos := -1; - raise EReadError.CreateRes(@SReadError); - end; - Inc(BlockPos, Max(StreamHeader^.OldSize, StreamHeader^.NewSize)); - end; - end - else - MemInput.CopyFrom(Input, BlockSize); - if (Options.Threads > 1) and (StreamCount > 1) then - begin - for J := 0 to StreamCount - 1 do - begin - Input.ReadBuffer(UI32, UI32.Size); - if UI32 > 0 then - Output.CopyFrom(Input, UI32); - while (Completed[J] = False) and (IsErrored(Tasks) = False) do - Sleep(1); - if IsErrored(Tasks) then - for I := Low(Tasks) to High(Tasks) do - Tasks[I].RaiseLastError; - Output.WriteBuffer((PByte(MemInput.Memory) + StreamPos[J])^, - PStreamHeader((PByte(MemStream.Memory) + J * SizeOf(TStreamHeader))) - ^.OldSize); - end; - WaitForAll(Tasks); - end - else - Restore(False, 0); - end; - Input.ReadBuffer(UI32, UI32.Size); - if UI32 > 0 then - Output.CopyFrom(Input, UI32); - Input.ReadBuffer(StreamCount, StreamCount.Size); - end; - CodecFree(Options.Threads); - MemInput.Free; - for I := Low(Tasks) to High(Tasks) do - begin - if Length(Tasks) > 1 then - Tasks[I].Free; - MemOutput[I].Free; - WorkStream[I].Free; - end; - MemStream.Free; -end; - -procedure Encode(Input, Output: TStream; Options: TEncodeOptions); -begin - InternalEncode(Input, Output, Options, 0, 0); -end; - -procedure Decode(Input, Output: TStream; Options: TDecodeOptions); -begin - InternalDecode(Input, Output, Options, 0, 0); -end; - -end. diff --git a/precompressor/PrecompMain.pas b/precompressor/PrecompMain.pas index 45f8038..07cbcac 100644 --- a/precompressor/PrecompMain.pas +++ b/precompressor/PrecompMain.pas @@ -48,6 +48,8 @@ procedure Decode(Input, Output: TStream; Options: TDecodeOptions); function PrecompAllocator(Instance: Integer; Size: Integer): Pointer cdecl; function PrecompGetDepthInfo(Index: Integer): TDepthInfo cdecl; +function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer; + Count: Integer): Integer cdecl; procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer; Size: Integer); @@ -241,7 +243,8 @@ type MemOutput1, MemOutput2, MemOutput3: TArray; CurPos1, CurPos2: TArray; InfoStore1: TArray>; - InfoStore2: TArray>; + InfoStore2: TArray>>; + ISIndex: TArray; StrIdx: TArray; end; @@ -343,12 +346,37 @@ begin Result := DepthInfo[Index]; end; +function PrecompReadFuture(Index: Integer; Position: NativeInt; Buffer: Pointer; + Count: Integer): Integer; +var + X: NativeInt; +begin + Result := 0; + with ComVars1[CurDepth[Index]] do + begin + if CurDepth[Index] > 0 then + begin + X := TDataStore2(ComVars1[CurDepth[Index]].DataStore).ActualSize(Index); + if Position < X then + begin + X := Min(X - Position, Count); + Move(TDataStore2(ComVars1[CurDepth[Index]].DataStore).Slot(Index) + .Memory^, Buffer^, X); + Result := X; + end; + end + else + Result := TDataStore1(ComVars1[CurDepth[Index]].DataStore). + Read(Index, Position, Buffer^, Count); + end; +end; + procedure PrecompOutput1(Instance: Integer; const Buffer: Pointer; Size: Integer); begin with ComVars1[CurDepth[Instance]] do begin - if Assigned(Buffer) then + if Assigned(Buffer) and (Size >= 0) then MemOutput1[Instance].WriteBuffer(Buffer^, Size) else MemOutput1[Instance].Position := CurPos1[Instance]; @@ -451,7 +479,7 @@ begin I := Instance; ThreadSync[I].Enter; try - InfoStore2[I].Add(SI2); + InfoStore2[I, ISIndex[I].ToInteger].Add(SI2); finally ThreadSync[I].Leave; end; @@ -518,90 +546,98 @@ begin with ComVars1[Depth] do for I := Low(Codecs) to High(Codecs) do begin - try - CurPos1[Index] := MemOutput1[Index].Position; - CurCodec[Index] := I; - CurDepth[Index] := Depth; - if Depth = 0 then - begin - LPtr := DataStore.Slot(Index).Memory; - LSize := DataStore.Size(Index); - LSizeEx := DataStore.ActualSize(Index); - end - else - begin - LPtr := PByte(DataStore.Slot(Index).Memory) + Integer.Size; - LSize := PInteger(DataStore.Slot(Index).Memory)^; - LSizeEx := LSize; - end; - Codecs[I].Scan1(Index, Depth, LPtr, LSize, LSizeEx, @PrecompOutput1, - @PrecompAddStream, @PrecompFunctions); - except + CurPos1[Index] := MemOutput1[Index].Position; + CurCodec[Index] := I; + CurDepth[Index] := Depth; + if Depth = 0 then + begin + LPtr := DataStore.Slot(Index).Memory; + LSize := DataStore.Size(Index); + LSizeEx := DataStore.ActualSize(Index); + end + else + begin + LPtr := PByte(DataStore.Slot(Index).Memory) + Integer.Size; + LSize := PInteger(DataStore.Slot(Index).Memory)^; + LSizeEx := LSize; end; + Codecs[I].Scan1(Index, Depth, LPtr, LSize, LSizeEx, @PrecompOutput1, + @PrecompAddStream, @PrecompFunctions); end; end; procedure Scan2(Index, Depth: Integer); var - I: Integer; + I, J: Integer; X: NativeInt; SI1: _StrInfo2; SI2: TFutureSI; SI3: TEncodeSI; begin with ComVars1[Depth] do - begin - InfoStore2[Index].Index := 0; - I := InfoStore2[Index].Get(SI2); - while I >= 0 do - begin - if InRange(SI2.Position, DataStore.Position(Index), - Pred(DataStore.Position(Index) + DataStore.Size(Index))) then + try + InfoStore2[Index, (not ISIndex[Index]).ToInteger].Count := 0; + InfoStore2[Index, ISIndex[Index].ToInteger].Sort; + InfoStore2[Index, ISIndex[Index].ToInteger].Index := 0; + I := InfoStore2[Index, ISIndex[Index].ToInteger].Get(SI2); + while I >= 0 do begin - CurPos1[Index] := MemOutput1[Index].Position; - CurCodec[Index] := SI2.Codec; - CurDepth[Index] := Depth; - SI1.OldSize := SI2.OldSize; - SI1.NewSize := SI2.NewSize; - SI1.Resource := SI2.Resource; - SI1.Option := SI2.Option; - SI1.Status := SI2.Status; - X := DataStore.ActualSize(Index) - - NativeInt(SI2.Position - DataStore.Position(Index)); - if (SI1.OldSize <= X) and Codecs[SI2.Codec].Scan2(Index, Depth, - PByte(DataStore.Slot(Index).Memory) + NativeInt(SI2.Position - - DataStore.Position(Index)), X, @SI1, @PrecompOutput1, - @PrecompFunctions) then + if InRange(SI2.Position, DataStore.Position(Index), + Pred(DataStore.Position(Index) + DataStore.Size(Index))) then begin - if MemOutput1[Index].Position - CurPos1[Index] = SI1.NewSize then + CurPos1[Index] := MemOutput1[Index].Position; + CurCodec[Index] := SI2.Codec; + CurDepth[Index] := Depth; + SI1.OldSize := SI2.OldSize; + SI1.NewSize := SI2.NewSize; + SI1.Resource := SI2.Resource; + SI1.Option := SI2.Option; + SI1.Status := SI2.Status; + J := 0; + X := DataStore.ActualSize(Index) - + NativeInt(SI2.Position - DataStore.Position(Index)); + if (SI1.OldSize <= X) and Codecs[SI2.Codec].Scan2(Index, Depth, + PByte(DataStore.Slot(Index).Memory) + + NativeInt(SI2.Position - DataStore.Position(Index)), X, @SI1, @J, + @PrecompOutput1, @PrecompFunctions) then begin - AtomicIncrement(EncInfo.Count); - FillChar(SI3, SizeOf(TEncodeSI), 0); - SI3.ActualPosition := - NativeInt(SI2.Position - DataStore.Position(Index)); - SI3.StorePosition := CurPos1[Index]; - SI3.OldSize := SI1.OldSize; - SI3.NewSize := SI1.NewSize; - SI3.Resource := SI1.Resource; - SI3.Thread := Index; - SI3.Codec := SI2.Codec; - SI3.Option := SI1.Option; - SI3.Status := SI1.Status; - SI3.Checksum := Utils.Hash32(0, PByte(DataStore.Slot(Index).Memory) - + SI3.ActualPosition, SI3.OldSize); - SI3.DepthInfo := SI2.DepthInfo; - InfoStore1[Index].Add(SI3); - end; + if InRange(SI2.Position + J, DataStore.Position(Index), + DataStore.Position(Index) + DataStore.Size(Index)) and + InRange(SI2.Position + J + SI1.OldSize, DataStore.Position(Index), + DataStore.Position(Index) + DataStore.ActualSize(Index)) and + (MemOutput1[Index].Position - CurPos1[Index] = SI1.NewSize) then + begin + AtomicIncrement(EncInfo.Count); + FillChar(SI3, SizeOf(TEncodeSI), 0); + SI3.ActualPosition := + NativeInt(SI2.Position - DataStore.Position(Index)) + J; + SI3.StorePosition := CurPos1[Index]; + SI3.OldSize := SI1.OldSize; + SI3.NewSize := SI1.NewSize; + SI3.Resource := SI1.Resource; + SI3.Thread := Index; + SI3.Codec := SI2.Codec; + SI3.Option := SI1.Option; + SI3.Status := SI1.Status; + SI3.Checksum := + Utils.Hash32(0, PByte(DataStore.Slot(Index).Memory) + + SI3.ActualPosition, SI3.OldSize); + SI3.DepthInfo := SI2.DepthInfo; + InfoStore1[Index].Add(SI3); + end + else + MemOutput1[Index].Position := CurPos1[Index]; + end + else + MemOutput1[Index].Position := CurPos1[Index]; end else - MemOutput1[Index].Position := CurPos1[Index]; - InfoStore2[Index].Delete(I); - end - else - break; - I := InfoStore2[Index].Get(SI2); + InfoStore2[Index, (not ISIndex[Index]).ToInteger].Add(SI2); + I := InfoStore2[Index, ISIndex[Index].ToInteger].Get(SI2); + end; + finally + ISIndex[Index] := not ISIndex[Index]; end; - end; end; function Process(ThreadIndex, StreamIndex, Index, Depth: Integer): Boolean; @@ -783,7 +819,7 @@ end; procedure EncInit(Input, Output: TStream; Options: PEncodeOptions); var UI32: UInt32; - I, J: Integer; + I, J, K: Integer; Bytes: TBytes; NI: NativeInt; DBKey: Int64; @@ -842,7 +878,8 @@ begin else I := Options^.Threads; SetLength(InfoStore1, I); - SetLength(InfoStore2, I); + SetLength(InfoStore2, I, 2); + SetLength(ISIndex, I); SetLength(StrIdx, I); for I := Low(Tasks) to High(Tasks) do begin @@ -857,14 +894,18 @@ begin for I := Low(InfoStore1) to High(InfoStore1) do begin InfoStore1[I] := TListEx.Create(EncodeSICmp); - InfoStore2[I] := TListEx.Create(FutureSICmp); + for K := Low(InfoStore2[I]) to High(InfoStore2[I]) do + InfoStore2[I, K] := TListEx.Create(FutureSICmp); + ISIndex[I] := False; end; if J = 0 then begin DataStore := TDataStore1.Create(Input, True, Length(InfoStore1), - Options^.ChunkSize); + Options^.ChunkSize, + LowerCase(ChangeFileExt(ExtractFileName(Utils.GetModuleName), + '_' + Random($7FFFFFFF).ToHexString + '-storage.tmp'))); IntArray[0] := Options^.ChunkSize; - IntArray[1] := Options^.Threads; + IntArray[1] := I; end else DataStore := TDataStore2.Create(Length(InfoStore1)); @@ -951,7 +992,7 @@ end; procedure EncFree; var UI32: UInt32; - I, J: Integer; + I, J, K: Integer; begin if Length(Tasks) > 1 then WaitForAll(Tasks); @@ -971,7 +1012,8 @@ begin for I := Low(InfoStore1) to High(InfoStore1) do begin InfoStore1[I].Free; - InfoStore2[I].Free; + for K := Low(InfoStore2[I]) to High(InfoStore2[I]) do + InfoStore2[I, K].Free; end; DataStore.Free; end; @@ -1019,7 +1061,6 @@ var DBTyp: TDatabase; DupTyp: TDuplicate; begin - // make the encoder read/write/scan/process at the same time if (Depth = 0) then begin if (DupFile = '') and StoreDD then @@ -1895,7 +1936,7 @@ begin Stopwatch := TStopwatch.Create; Stopwatch.Start; ConTask.Perform(EncodeStats); - // ConTask.Start; + ConTask.Start; try EncInit(Input, Output, @Options); EncData(Input, Output, 0, 0); @@ -1971,9 +2012,8 @@ PrecompFunctions.ExecStdin := @PrecompExecStdin; PrecompFunctions.ExecStdout := @PrecompExecStdout; PrecompFunctions.ExecStdio := @PrecompExecStdio; PrecompFunctions.ExecStdioSync := @PrecompExecStdioSync; -PrecompFunctions.ExecStdioInit := @PrecompExecStdioInit; -PrecompFunctions.ExecStdioFree := @PrecompExecStdioFree; -PrecompFunctions.ExecStdioProcess := @PrecompExecStdioProcess; +PrecompFunctions.GetDepthCodec := @PrecompGetDepthCodec; +PrecompFunctions.ReadFuture := @PrecompReadFuture; finalization diff --git a/precompressor/PrecompOodle.pas b/precompressor/PrecompOodle.pas index 87fd7bd..d70a404 100644 --- a/precompressor/PrecompOodle.pas +++ b/precompressor/PrecompOodle.pas @@ -41,6 +41,7 @@ const const O_TRADEOFF = 256; + O_MAXSIZE = 16 * 1024 * 1024; var SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList; @@ -445,9 +446,70 @@ procedure OodleScan1(Instance, Depth: Integer; Input: PByte; Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd; Funcs: PPrecompFuncs); var + Buffer: PByte; Pos: NativeInt; + X: Integer; + Res: Integer; + SI: _StrInfo1; OodleSI: TOodleSI; + DI1, DI2: TDepthInfo; + DS: TPrecompCmd; begin + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); + if DS <> '' then + begin + X := IndexTextW(@DS[0], OodleCodecs); + if (X < 0) or (DI1.OldSize <> SizeEx) then + exit; + if not CodecAvailable[X] then + exit; + if (X in [LZNA_CODEC, LEVIATHAN_CODEC]) and (DI1.NewSize <= 0) then + exit; + if DI1.NewSize <= 0 then + Res := O_MAXSIZE + else + Res := DI1.NewSize; + Buffer := Funcs^.Allocator(Instance, Res); + case X of + KRAKEN_CODEC, MERMAID_CODEC, SELKIE_CODEC, HYDRA_CODEC: + begin + if DI1.NewSize <= 0 then + begin + if not CustomLZ_Decompress(Input, Buffer, DI1.OldSize, Res, $32, Res) + then + Res := 0; + end + else + Res := OodleLZ_Decompress(Input, DI1.OldSize, Buffer, Res); + end; + else + begin + if DI1.NewSize > 0 then + Res := OodleLZ_Decompress(Input, DI1.OldSize, Buffer, Res) + else + Res := 0; + end; + end; + if (Res > DI1.OldSize) then + begin + Output(Instance, Buffer, Res); + SI.Position := 0; + SI.OldSize := DI1.OldSize; + SI.NewSize := Res; + 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; + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI.NewSize; + DI2.NewSize := SI.NewSize; + Add(Instance, @SI, DI1.Codec, @DI2); + end; + exit; + end; if BoolArray(CodecEnabled, False) then exit; Pos := 0; @@ -465,32 +527,44 @@ begin end; function OodleScan2(Instance, Depth: Integer; Input: Pointer; Size: cardinal; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Buffer: PByte; + X: Integer; Res: Integer; OodleSI: TOodleSI; begin Result := False; - if StreamInfo^.NewSize <= 0 then - exit; - Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); - if StreamInfo^.OldSize <= Size then + X := GetBits(StreamInfo^.Option, 0, 5); + if (X <> LZNA_CODEC) and (StreamInfo^.OldSize <= 0) then begin - if GetBits(StreamInfo^.Option, 0, 5) = LZNA_CODEC then - OodleSI.CSize := StreamInfo^.OldSize - else - GetOodleSI(Input, Size, @OodleSI); - if (OodleSI.CSize > 0) then + GetOodleSI(Input, Size, @OodleSI); + StreamInfo^.OldSize := OodleSI.CSize; + end + else + exit; + if StreamInfo^.NewSize > 0 then + begin + Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); + Res := OodleLZ_Decompress(Input, StreamInfo^.OldSize, Buffer, + StreamInfo^.NewSize); + if Res = StreamInfo^.NewSize then begin - Res := OodleLZ_Decompress(Input, OodleSI.CSize, Buffer, - StreamInfo^.NewSize); - if Res = StreamInfo^.NewSize then - begin - StreamInfo^.OldSize := OodleSI.CSize; - Output(Instance, Buffer, Res); - Result := True; - end; + Output(Instance, Buffer, Res); + Result := True; + end; + end + else if (not X in [LZNA_CODEC, LEVIATHAN_CODEC]) and (StreamInfo^.NewSize <= 0) + then + begin + Buffer := Funcs^.Allocator(Instance, OodleSI.DSize); + if CustomLZ_Decompress(Input, Buffer, StreamInfo^.OldSize, OodleSI.DSize, + $32, Res) then + begin + StreamInfo^.NewSize := Res; + Output(Instance, Buffer, Res); + Result := True; end; end; end; diff --git a/precompressor/PrecompSearch.pas b/precompressor/PrecompSearch.pas index 8e97558..336dedb 100644 --- a/precompressor/PrecompSearch.pas +++ b/precompressor/PrecompSearch.pas @@ -10,13 +10,16 @@ uses System.Types, System.Math, System.IOUtils; const - XTOOL_DB = $42445458; + XTOOL_DB = $31445458; var Codec: TPrecompressor; implementation +const + MinSize = 65536; + type PEntryStruct = ^TEntryStruct; @@ -27,11 +30,18 @@ type PSearchStruct = ^TSearchStruct; + PHashStruct = ^THashStruct; + + THashStruct = record + Size: Integer; + Hash: Cardinal; + end; + TSearchStruct = record Name: String; - SearchInt: Int64; - HashSize: Integer; - HashDigest: TMD5Digest; + SearchInt1, SearchInt2: Integer; + Hash: Cardinal; + HashList: TArray; Codec: String; Resource: Integer; EntryList: TArray; @@ -44,12 +54,45 @@ var CodecSearch: TArray>; CodecAvailable, CodecEnabled: TArray; +function CheckHashList(Instance: Integer; Position: NativeInt; + HashList: TArray; Funcs: PPrecompFuncs): Boolean; +const + BufferSize = 65536; +var + Buffer: array [0 .. BufferSize - 1] of Byte; + LPos: NativeInt; + I: Integer; + X, Y: Integer; + CRC: Cardinal; +begin + Result := False; + LPos := Position; + for I := Low(HashList) to High(HashList) do + begin + X := HashList[I].Size; + CRC := 0; + Y := Funcs^.ReadFuture(Instance, LPos, @Buffer[0], Min(X, BufferSize)); + while Y > 0 do + begin + Inc(LPos, Y); + CRC := Utils.Hash32(CRC, @Buffer[0], Y); + Dec(X, Y); + Y := Funcs^.ReadFuture(Instance, LPos, @Buffer[0], Min(X, BufferSize)); + end; + if (X > 0) or (CRC <> HashList[I].Hash) then + break; + if I = High(HashList) then + Result := True; + end; +end; + function SearchInit(Command: PChar; Count: Integer; Funcs: PPrecompFuncs): Boolean; var I: Integer; - X, Y, Z: Integer; + W, X, Y, Z: Integer; S: String; + List: System.Types.TStringDynArray; begin Result := True; for X := Low(CodecAvailable) to High(CodecAvailable) do @@ -76,6 +119,12 @@ begin for X := Low(CodecEnabled) to High(CodecEnabled) do if CodecEnabled[X] then begin + for Y := Low(CodecSearch[X]) to High(CodecSearch[X]) do + begin + List := DecodeStr(CodecSearch[X, Y].Codec, SPrecompSep4); + for W := Low(List) to High(List) do + AddMethod(PrecompGetCodec(PChar(List[W]), 0, False)); + end; SetLength(SearchInfo[X], $10000); SetLength(SearchCount[X], $10000); for Z := Low(SearchInfo[X]) to High(SearchInfo[X]) do @@ -83,13 +132,12 @@ begin SearchCount[X, Z] := 0; for Y := Low(CodecSearch[X]) to High(CodecSearch[X]) do begin - LongRec(I).Words[0] := Int64Rec(CodecSearch[X, Y].SearchInt).Words[0]; + LongRec(I).Words[0] := LongRec(CodecSearch[X, Y].SearchInt1).Words[0]; if Z = I then begin Inc(SearchCount[X, Z]); Insert(Y, SearchInfo[X, Z], Length(SearchInfo[X, Z])); end; - AddMethod(PrecompGetCodec(PChar(CodecSearch[X, Y].Codec), 0, False)); end; end; end; @@ -121,42 +169,44 @@ procedure SearchScan1(Instance, Depth: Integer; Input: PByte; var I: Integer; J: Word; - X, Y, Z: Integer; + X, Y: Integer; Pos, LSize: NativeInt; SI: _StrInfo1; + DI: TDepthInfo; SS: PSearchStruct; - MD5: TMD5; - Digest: TMD5Digest; - MD5Checked: Boolean; + CRC: Cardinal; + Checked: Boolean; begin + if Depth > 0 then + exit; for I := Low(CodecSearch) to High(CodecSearch) do if CodecEnabled[I] then begin Pos := 0; - LSize := Size - Pred(Int64.Size); + LSize := Size - Pred(Integer.Size); while Pos < LSize do begin J := PWord(Input + Pos)^; - if (SearchCount[I, J] > 0) and - (CodecSearch[I, 0].HashSize <= (SizeEx - Pos)) then + if (SearchCount[I, J] > 0) and (MinSize <= (SizeEx - Pos)) then begin - MD5Checked := False; + Checked := False; for X := 0 to SearchCount[I, J] - 1 do begin - if (PInt64(Input + Pos)^ = CodecSearch[I, SearchInfo[I, J, X]] - .SearchInt) then + if (PInteger(Input + Pos)^ = CodecSearch[I, SearchInfo[I, J, X]] + .SearchInt1) and (PInteger(Input + Pos + MinSize - Integer.Size) + ^ = CodecSearch[I, SearchInfo[I, J, X]].SearchInt2) then begin - if not MD5Checked then + if not Checked then begin - MD5.Full(Input + Pos, CodecSearch[I, 0].HashSize, Digest); - MD5Checked := True; + CRC := Utils.Hash32(0, Input + Pos, MinSize); + Checked := True; end; - // fix this - if CompareMem(@CodecSearch[I, SearchInfo[I, J, X]].HashDigest[0], - @Digest[0], sizeof(TMD5Digest)) then + if (CodecSearch[I, SearchInfo[I, J, X]].Hash = CRC) and + CheckHashList(Instance, Pos, CodecSearch[I, SearchInfo[I, J, X]] + .HashList, Funcs) then begin SS := @CodecSearch[I, SearchInfo[I, J, X]]; - Output(Instance, nil, -1); + Output(Instance, nil, 0); for Y := Low(SS^.EntryList) to High(SS^.EntryList) do begin SI.Position := Pos + SS^.EntryList[Y].Position; @@ -168,7 +218,10 @@ begin SI.Status := TStreamStatus.Predicted else SI.Status := TStreamStatus.None; - Add(Instance, @SI, PChar(SS^.Codec), nil); + DI.Codec := Funcs^.GetDepthCodec(PChar(SS^.Codec)); + DI.OldSize := SI.NewSize; + DI.NewSize := SI.NewSize; + Add(Instance, @SI, PChar(SS^.Codec), @DI); end; end; end; @@ -180,7 +233,8 @@ begin end; function SearchScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; begin Result := False; end; @@ -204,6 +258,7 @@ var FStream: TFileStream; I32: Integer; SearchStruct: PSearchStruct; + HList: TArray; initialization @@ -213,7 +268,7 @@ for I := Low(SearchList) to High(SearchList) do begin FStream := TFileStream.Create(SearchList[I], fmShareDenyNone); try - if FStream.Size >= 4 then + if FStream.Size >= 8 then begin FStream.ReadBuffer(I32, I32.Size); if (I32 = XTOOL_DB) then @@ -229,11 +284,14 @@ begin begin New(SearchStruct); SearchStruct^.Name := S; - FStream.ReadBuffer(SearchStruct^.SearchInt, - SearchStruct^.SearchInt.Size); - FStream.ReadBuffer(SearchStruct^.HashSize, - SearchStruct^.HashSize.Size); - FStream.ReadBuffer(SearchStruct^.HashDigest, sizeof(THash128)); + FStream.ReadBuffer(SearchStruct^.SearchInt1, + SearchStruct^.SearchInt1.Size); + FStream.ReadBuffer(SearchStruct^.SearchInt2, + SearchStruct^.SearchInt2.Size); + FStream.ReadBuffer(SearchStruct^.Hash, SearchStruct^.Hash.Size); + FStream.ReadBuffer(I32, I32.Size); + SetLength(HList, I32); + FStream.ReadBuffer(HList[0], I32 * sizeof(THashStruct)); FStream.ReadBuffer(I32, I32.Size); SetLength(Bytes, I32); FStream.ReadBuffer(Bytes[0], I32); @@ -241,6 +299,9 @@ begin Insert(SearchStruct^, CodecSearch[J], Length(CodecSearch[J])); FStream.ReadBuffer(I32, I32.Size); K := Pred(Length(CodecSearch[J])); + SetLength(CodecSearch[J, K].HashList, Length(HList)); + Move(HList[0], CodecSearch[J, K].HashList[0], + Length(HList) * sizeof(THashStruct)); SetLength(CodecSearch[J, K].EntryList, I32); FStream.ReadBuffer(CodecSearch[J, K].EntryList[0], I32 * sizeof(TEntryStruct)); @@ -251,7 +312,6 @@ begin FStream.Free; end; end; - Codec.Initialised := False; Codec.Init := @SearchInit; Codec.Free := @SearchFree; diff --git a/precompressor/PrecompUtils.pas b/precompressor/PrecompUtils.pas index 460a02f..4d1e7a2 100644 --- a/precompressor/PrecompUtils.pas +++ b/precompressor/PrecompUtils.pas @@ -15,6 +15,7 @@ resourcestring SPrecompSep1 = '+'; SPrecompSep2 = ':'; SPrecompSep3 = ','; + SPrecompSep4 = '/'; const SuccessStatus = 3; @@ -28,14 +29,14 @@ const type PPrecompCmd = ^TPrecompCmd; - TPrecompCmd = array [0 .. 255] of Char; + TPrecompCmd = array [0 .. 63] of Char; TStreamStatus = (None, Invalid, Predicted); PDepthInfo = ^TDepthInfo; TDepthInfo = packed record - Codec: array [0 .. 59] of Char; + Codec: TPrecompCmd; OldSize: Integer; NewSize: Integer; end; @@ -172,12 +173,10 @@ type ExecStdioSync: function(Instance: Integer; Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer; Output: _ExecOutput): Boolean cdecl; - ExecStdioInit: function(Instance: Integer; - Executable, CommandLine, WorkDir: PChar): Pointer cdecl; - ExecStdioFree: procedure(Ctx: Pointer)cdecl; - ExecStdioProcess: function(Ctx: Pointer; InBuff: Pointer; InSize: Integer; - Output: _ExecOutput; Continous: Boolean): Boolean cdecl; - Reserved: array [0 .. (PRECOMP_FCOUNT - 1) - 34] of Pointer; + GetDepthCodec: function(Cmd: PChar): TPrecompCmd cdecl; + ReadFuture: function(Index: Integer; Position: NativeInt; Buffer: Pointer; + Count: Integer): Integer cdecl; + Reserved: array [0 .. (PRECOMP_FCOUNT - 1) - 33] of Pointer; end; _PrecompOutput = procedure(Instance: Integer; const Buffer: Pointer; @@ -194,8 +193,8 @@ type Size, SizeEx: NativeInt; Output: _PrecompOutput; Add: _PrecompAdd; Funcs: PPrecompFuncs); _PrecompScan2 = function(Instance, Depth: Integer; Input: Pointer; - Size: NativeInt; StreamInfo: PStrInfo2; Output: _PrecompOutput; - Funcs: PPrecompFuncs): Boolean; + Size: NativeInt; StreamInfo: PStrInfo2; Offset: PInteger; + Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; _PrecompProcess = function(Instance, Depth: Integer; OldInput, NewInput: Pointer; StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; @@ -272,19 +271,6 @@ type Size: Integer; end; - PExecCtx = ^TExecCtx; - - TExecCtx = record - FInstance: Integer; - FExecutable, FCommandLine, FWorkDir: string; - hstdinr, hstdinw: THandle; - hstdoutr, hstdoutw: THandle; - StartupInfo: TStartupInfo; - ProcessInfo: TProcessInformation; - FTask: TTask; - FDone: Boolean; - end; - function DuplicateSortCompare(const Left, Right): Integer; procedure AddMethod(Method: String); @@ -297,6 +283,7 @@ function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean) : TPrecompCmd cdecl; function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar) : TPrecompCmd cdecl; +function PrecompGetDepthCodec(Cmd: PChar): TPrecompCmd cdecl; function PrecompCompress(Codec: PChar; InBuff: Pointer; InSize: Integer; OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer) : Integer cdecl; @@ -348,12 +335,6 @@ function PrecompExecStdio(Instance: Integer; function PrecompExecStdioSync(Instance: Integer; Executable, CommandLine, WorkDir: PChar; InBuff: Pointer; InSize: Integer; Output: _ExecOutput): Boolean cdecl; -function PrecompExecStdioInit(Instance: Integer; - Executable, CommandLine, WorkDir: PChar): PExecCtx cdecl; -procedure PrecompExecStdioFree(Ctx: PExecCtx)cdecl; -function PrecompExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer; - InSize: Integer; Output: _ExecOutput; Continous: Boolean = False) - : Boolean cdecl; var PrecompFunctions: _PrecompFuncs; @@ -366,9 +347,7 @@ var implementation uses - DECCipherBase, DECCipherModes, DECCipherFormats, DECCiphers, BDiffEncoder, BDiffDecoder, - Crypt2, ZLibDLL, LZ4DLL, LZODLL, ZSTDDLL, OodleDLL, XDeltaDLL, SynCommons, SynCrypto; @@ -414,23 +393,26 @@ end; function RegisterResources(Cmd: String): Integer; var - List1, List2: System.Types.TStringDynArray; + List0, List1, List2: System.Types.TStringDynArray; I, J: Integer; begin Result := -1; if Cmd <> '' then begin - List1 := DecodeStr(Cmd, SPrecompSep1); + List0 := DecodeStr(Cmd, SPrecompSep4); + List1 := DecodeStr(List0[0], SPrecompSep1); for I := Low(List1) to High(List1) do begin List2 := DecodeStr(List1[I], SPrecompSep2); for J := Succ(Low(List2)) to High(List2) do + begin if FileExists(ExtractFilePath(Utils.GetModuleName) + List2[J]) then begin Result := PrecompAddResource (PChar(ExtractFilePath(Utils.GetModuleName) + List2[J])); break; end; + end; end; end; end; @@ -523,7 +505,7 @@ end; function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean) : TPrecompCmd; var - List1, List2: System.Types.TStringDynArray; + List0, List1, List2: System.Types.TStringDynArray; I: Integer; S: String; begin @@ -531,7 +513,8 @@ begin S := ''; if Cmd <> nil then begin - List1 := DecodeStr(Cmd, SPrecompSep1); + List0 := DecodeStr(Cmd, SPrecompSep4); + List1 := DecodeStr(List0[0], SPrecompSep1); if InRange(Index, Low(List1), High(List1)) then if WithParams then begin @@ -551,14 +534,15 @@ end; function PrecompGetParam(Cmd: PChar; Index: Integer; Param: PChar): TPrecompCmd; var - List1, List2: System.Types.TStringDynArray; + List0, List1, List2: System.Types.TStringDynArray; I: Integer; S: String; begin Result := ''; if Cmd <> '' then begin - List1 := DecodeStr(Cmd, SPrecompSep1); + List0 := DecodeStr(Cmd, SPrecompSep4); + List1 := DecodeStr(List0[0], SPrecompSep1); if InRange(Index, Low(List1), High(List1)) then begin List2 := DecodeStr(List1[Index], SPrecompSep2); @@ -589,6 +573,25 @@ begin StringToWideChar(S, @Result, Length(Result)); end; +function PrecompGetDepthCodec(Cmd: PChar): TPrecompCmd cdecl; +var + List: System.Types.TStringDynArray; + I: Integer; + S: String; +begin + Result := ''; + S := ''; + if Cmd <> nil then + begin + List := DecodeStr(Cmd, SPrecompSep4); + for I := Succ(Low(List)) to High(List) do + S := S + List[I] + SPrecompSep4; + if Length(S) > 0 then + S := S.Remove(Pred(Length(S))); + end; + StringToWideChar(S, @Result, Length(Result)); +end; + function PrecompCompress(Codec: PChar; InBuff: Pointer; InSize: Integer; OutBuff: Pointer; OutSize: Integer; DictBuff: Pointer; DictSize: Integer): Integer; @@ -721,14 +724,9 @@ function PrecompEncrypt(Codec: PChar; InBuff: Pointer; InSize: Integer; var AES: TAESECB; RC4: TRC4; - IVector: TBytes; - BlowFish: TCipher_BlowFish; - crypt: HCkCrypt2; - ivHex: PWideChar; - keyHex: PWideChar; begin Result := False; - case IndexText(Codec, ['xor', 'aes', 'rc4', 'blowfish']) of + case IndexText(Codec, ['xor', 'aes', 'rc4']) of 0: begin XorBuffer(InBuff, InSize, KeyBuff, KeySize); @@ -750,27 +748,6 @@ begin RC4.Encrypt(InBuff^, InBuff^, InSize); Result := True; end; - 3: - begin - { crypt := CkCrypt2_Create(); - CkCrypt2_putCryptAlgorithm(crypt, 'blowfish2'); - CkCrypt2_putCipherMode(crypt, 'cfb'); - CkCrypt2_putKeyLength(crypt, 128); - CkCrypt2_putPaddingScheme(crypt, 0); - CkCrypt2_putEncodingMode(crypt, 'hex'); - ivHex := '0000000000000000'; - CkCrypt2_SetEncodedIV(crypt, ivHex, 'hex'); - keyHex := '4372797074656442794D697469746569'; - CkCrypt2_SetEncodedKey(crypt, keyHex, 'hex'); - CkCrypt2_CkEncryptFile(crypt, 'xbf', 'xbf_encrypted2'); } - BlowFish := TCipher_BlowFish.Create; - BlowFish.Mode := cmECBx; - // SetLength(IVector, KeySize); - // FillChar(IVector[0], KeySize, 0); - BlowFish.Init(KeyBuff^, KeySize, IVector, 0); - BlowFish.Encode(InBuff^, InBuff^, 16); - Result := True; - end; end; end; @@ -779,11 +756,9 @@ function PrecompDecrypt(Codec: PChar; InBuff: Pointer; InSize: Integer; var AES: TAESECB; RC4: TRC4; - IVector: TBytes; - BlowFish: TCipher_BlowFish; begin Result := False; - case IndexText(Codec, ['xor', 'aes', 'rc4', 'blowfish']) of + case IndexText(Codec, ['xor', 'aes', 'rc4']) of 0: begin XorBuffer(InBuff, InSize, KeyBuff, KeySize); @@ -805,20 +780,6 @@ begin RC4.Encrypt(InBuff^, InBuff^, InSize); Result := True; end; - 3: - begin - BlowFish := TCipher_BlowFish.Create; - try - // SetLength(IVector, KeySize); - // FillChar(IVector[0], KeySize, 0); - BlowFish.Init(KeyBuff^, KeySize, IVector, 0); - BlowFish.Decode(InBuff^, InBuff^, InSize); - finally - SetLength(IVector, 0); - BlowFish.Free; - end; - Result := True; - end; end; end; @@ -938,12 +899,8 @@ begin Size^ := -1; exit; end; - if not Assigned(Data) then - begin - Size^ := Resources[Index].Size; - exit; - end; - Move(Resources[Index].Data^, Data^, Resources[Index].Size); + if Assigned(Data) then + Move(Resources[Index].Data^, Data^, Resources[Index].Size); Size^ := Resources[Index].Size; Result := True; end; @@ -1142,18 +1099,16 @@ begin end; end; -procedure ExecReadTask(Instance, Handle, Stream, Done: IntPtr); +procedure ExecReadTask(Instance, Handle, Stream: IntPtr); const BufferSize = 65536; var Buffer: array [0 .. BufferSize - 1] of Byte; BytesRead: DWORD; begin - PBoolean(Pointer(Done))^ := False; while ReadFile(Handle, Buffer[0], Length(Buffer), BytesRead, nil) and (BytesRead > 0) do PExecOutput(Pointer(Stream))^(Instance, @Buffer[0], BytesRead); - PBoolean(Pointer(Done))^ := BytesRead = 0; end; function PrecompExecStdioSync(Instance: Integer; @@ -1215,117 +1170,6 @@ begin end; end; -function PrecompExecStdioInit(Instance: Integer; - Executable, CommandLine, WorkDir: PChar): PExecCtx; -begin - New(Result); - with Result^ do - begin - FInstance := Instance; - FExecutable := Executable; - FCommandLine := CommandLine; - if WorkDir <> '' then - FWorkDir := WorkDir - else - FWorkDir := GetCurrentDir; - FTask := TTask.Create; - FTask.Perform(ExecReadTask); - FDone := False; - end; -end; - -procedure PrecompExecStdioFree(Ctx: PExecCtx); -begin - with Ctx^ do - FTask.Free; - Dispose(Ctx); -end; - -function PrecompExecStdioProcess(Ctx: PExecCtx; InBuff: Pointer; - InSize: Integer; Output: _ExecOutput; Continous: Boolean): Boolean; -const - PipeSecurityAttributes: TSecurityAttributes = - (nLength: SizeOf(PipeSecurityAttributes); bInheritHandle: True); -begin - with Ctx^ do - begin - if Continous and (WaitForSingleObject(ProcessInfo.hProcess, 0) - = WAIT_TIMEOUT) then - begin - if FDone then - begin - FTask.Update(FInstance, hstdoutr, NativeInt(@Output), - NativeInt(@FDone)); - FTask.Start; - end; - if Continous then - FileWriteBuffer(hstdinw, InSize, InSize); - FileWriteBuffer(hstdinw, InBuff^, InSize); - if Continous then - FTask.Wait; - Result := True; - end - else - begin - CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0); - CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0); - SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0); - SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0); - ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); - StartupInfo.cb := SizeOf(StartupInfo); - StartupInfo.dwFlags := STARTF_USESTDHANDLES; - StartupInfo.hStdInput := hstdinr; - StartupInfo.hStdOutput := hstdoutw; - StartupInfo.hStdError := 0; - ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo)); - if CreateProcess(nil, PChar('"' + FExecutable + '" ' + FCommandLine), nil, - nil, True, NORMAL_PRIORITY_CLASS, nil, PChar(FWorkDir), StartupInfo, - ProcessInfo) then - begin - if not Continous then - CloseHandle(ProcessInfo.hProcess); - CloseHandle(ProcessInfo.hThread); - CloseHandle(hstdinr); - CloseHandle(hstdoutw); - FTask.Update(FInstance, hstdoutr, NativeInt(@Output), - NativeInt(@FDone)); - FTask.Start; - FileWriteBuffer(hstdinw, InBuff^, InSize); - if not Continous then - CloseHandle(hstdinw); - FTask.Wait; - if not Continous then - CloseHandle(hstdoutr); - Result := True; - end - else - begin - CloseHandle(hstdinr); - CloseHandle(hstdinw); - CloseHandle(hstdoutr); - CloseHandle(hstdoutw); - RaiseLastOSError; - end; - end; - end; -end; - -const - ID_MEMORYLIB = 0; - ID_FILESTREAM = 1; - ID_MEMORYSTREAM = 2; - ID_RESOURCESTREAM = 3; - -function PrecompCreateObject(ObjectID: Integer): Integer; -begin - -end; - -procedure PrecompDestoryObject(ObjectID: Integer); -begin - -end; - initialization EncodeSICmp := TEncodeSIComparer.Create; diff --git a/precompressor/PrecompZLib.pas b/precompressor/PrecompZLib.pas index 1818c66..29dfe98 100644 --- a/precompressor/PrecompZLib.pas +++ b/precompressor/PrecompZLib.pas @@ -37,9 +37,11 @@ var ZStream1: array of array [1 .. 9, 1 .. 9, 1 .. 7] of z_stream; ZStream2: array of array [0 .. 7] of z_stream; ZWinBits: Integer = Z_WINBITS; - RefInst1, RefInst2: array of Pointer; + RefInst1, RefInst2: TArray; CodecAvailable, CodecEnabled: TArray; Storage: TArray; + Scan2Pos: TArray; + Scan2SI: TArray; function ZlibInit(Command: PChar; Count: Integer; Funcs: PPrecompFuncs) : Boolean; @@ -55,6 +57,8 @@ begin for Y := Low(SOList[X]) to High(SOList[X]) do SOList[X, Y] := TSOList.Create([], TSOMethod.MTF); SetLength(Storage, Count); + SetLength(Scan2Pos, Count); + SetLength(Scan2SI, Count); for X := Low(Storage) to High(Storage) do Storage[X] := TMemoryStream.Create; for X := Low(CodecAvailable) to High(CodecAvailable) do @@ -238,23 +242,29 @@ var Pos: NativeInt; Res: Integer; I: Integer; + X: Integer; ZStream: z_streamp; IsZlib: Boolean; Level: Integer; WinBits: Byte; ScanBytes: Integer; SI: _StrInfo1; - DI: TDepthInfo; + DI1, DI2: TDepthInfo; DS: TPrecompCmd; LastIn, LastOut: cardinal; begin - if BoolArray(CodecEnabled, False) then - exit; - DI := Funcs^.GetDepthInfo(Instance); - DS := Funcs^.GetCodec(DI.Codec, 0, False); + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); if DS <> '' then - if IndexTextW(@DS[0], ZlibCodecs) < 0 then + begin + X := IndexTextW(@DS[0], ZlibCodecs); + if (X < 0) or (DI1.OldSize <> SizeEx) then exit; + if not CodecAvailable[X] then + exit; + end + else if BoolArray(CodecEnabled, False) then + exit; Pos := 0; Buffer := Funcs^.Allocator(Instance, Z_WORKMEM); IsZlib := False; @@ -281,10 +291,10 @@ begin ZStream := @ZStream2[Instance, WinBits]; Level := (Input + Pos - 1)^ shr $6; IsZlib := True; - ScanBytes := Z_MINSIZE; end; - end; - IsZlib := False; + end + else + IsZlib := False; if IsZlib or ((Input + Pos)^ and 7 in [$4, $5]) then begin if not IsZlib then @@ -294,7 +304,9 @@ begin Level := -1; end; if WinBits = 7 then - ScanBytes := Z_SCANBYTES; + ScanBytes := Z_SCANBYTES + else + ScanBytes := Z_MINSIZE; IsZlib := False; LastIn := 0; LastOut := 0; @@ -309,7 +321,7 @@ begin Output(Instance, nil, 0); I := Z_WORKMEM - ZStream^.avail_out; Output(Instance, Buffer, I); - ZStream^.avail_in := (SizeEx - Pos) - Z_SCANBYTES; + ZStream^.avail_in := (SizeEx - Pos) - ScanBytes; while Res <> Z_STREAM_END do begin ZStream^.next_out := Buffer; @@ -326,7 +338,8 @@ begin I := Z_WORKMEM - ZStream^.avail_out; Output(Instance, Buffer, I); end; - if (Res = Z_STREAM_END) { and (ZStream^.total_out > ZStream^.total_in) } + if (Res = Z_STREAM_END) and (LastIn > ScanBytes) + { and (ZStream^.total_out > ZStream^.total_in) } then begin SI.Position := Pos; @@ -357,7 +370,21 @@ begin SetBits(SI.Option, I, 0, 5); if CodecEnabled[I] then begin - Add(Instance, @SI, nil, nil); + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI.NewSize; + DI2.NewSize := SI.NewSize; + if Assigned(Add) then + Add(Instance, @SI, DI1.Codec, @DI2) + else + begin + Scan2Pos[Instance] := SI.Position; + Scan2SI[Instance]^.OldSize := SI.OldSize; + Scan2SI[Instance]^.NewSize := SI.NewSize; + Scan2SI[Instance]^.Resource := SI.Resource; + Scan2SI[Instance]^.Status := SI.Status; + Scan2SI[Instance]^.Option := SI.Option; + exit; + end; break; end; end; @@ -373,28 +400,23 @@ begin end; function ZLibScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Buffer: PByte; Res: Integer; + I: Integer; ZStream: z_streamp; + LastIn, LastOut: cardinal; begin Result := False; - if StreamInfo^.NewSize <= 0 then - exit; - Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); - ZStream := @ZStream2[Instance, GetBits(StreamInfo^.Option, 12, 3)]; - ZStream^.next_in := Input; - ZStream^.avail_in := StreamInfo^.OldSize; - ZStream^.next_out := Buffer; - ZStream^.avail_out := StreamInfo^.NewSize; - inflateReset(ZStream^); - Res := inflate(ZStream^, Z_FULL_FLUSH); - if (Res = Z_STREAM_END) and (ZStream^.total_out = StreamInfo^.NewSize) then - begin - Output(Instance, Buffer, ZStream^.total_out); - Result := True; - end; + Scan2Pos[Instance] := 0; + Scan2SI[Instance] := StreamInfo; + Scan2SI[Instance]^.OldSize := 0; + ZlibScan1(Instance, Depth, Input, Size, Size, Output, nil, Funcs); + Result := Scan2SI[Instance]^.OldSize > 0; + if Result then + Offset^ := Scan2Pos[Instance]; end; function ZlibProcess(Instance, Depth: Integer; OldInput, NewInput: Pointer; diff --git a/precompressor/PrecompZSTD.pas b/precompressor/PrecompZSTD.pas index 8b8a3af..ff4c543 100644 --- a/precompressor/PrecompZSTD.pas +++ b/precompressor/PrecompZSTD.pas @@ -126,7 +126,45 @@ var Pos: NativeInt; X, Y, Z: Integer; SI: _StrInfo1; + DI1, DI2: TDepthInfo; + DS: TPrecompCmd; begin + DI1 := Funcs^.GetDepthInfo(Instance); + DS := Funcs^.GetCodec(DI1.Codec, 0, False); + if DS <> '' then + begin + X := IndexTextW(@DS[0], ZSTDCodecs); + if (X < 0) or (DI1.OldSize <> SizeEx) then + exit; + if not CodecAvailable[X] then + exit; + Y := ZSTD_findDecompressedSize(Input, SizeEx); + if Y <= 0 then + exit; + Buffer := Funcs^.Allocator(Instance, Y); + case X of + ZSTD_CODEC: + Y := ZSTD_decompressDCtx(dctx[Instance], Buffer, Y, Input, X); + end; + if (Y > DI1.OldSize) then + begin + Output(Instance, Buffer, Y); + SI.Position := 0; + SI.OldSize := DI1.OldSize; + SI.NewSize := Y; + 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; + DI2.Codec := Funcs^.GetDepthCodec(DI1.Codec); + DI2.OldSize := SI.NewSize; + DI2.NewSize := SI.NewSize; + Add(Instance, @SI, DI1.Codec, @DI2); + end; + exit; + end; if BoolArray(CodecEnabled, False) then exit; Pos := 0; @@ -165,21 +203,32 @@ begin end; function ZSTDScan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; - StreamInfo: PStrInfo2; Output: _PrecompOutput; Funcs: PPrecompFuncs): Boolean; + StreamInfo: PStrInfo2; Offset: PInteger; Output: _PrecompOutput; + Funcs: PPrecompFuncs): Boolean; var Buffer: PByte; + X: Integer; Res: Integer; begin Result := False; + X := GetBits(StreamInfo^.Option, 0, 5); + if StreamInfo^.OldSize <= 0 then + StreamInfo^.OldSize := ZSTD_findFrameCompressedSize(Input, Size); + if StreamInfo^.OldSize <= 0 then + exit; + if StreamInfo^.NewSize <= 0 then + StreamInfo^.NewSize := ZSTD_findDecompressedSize(Input, Size); if StreamInfo^.NewSize <= 0 then exit; Buffer := Funcs^.Allocator(Instance, StreamInfo^.NewSize); - Res := ZSTD_decompressDCtx(dctx[Instance], Buffer, StreamInfo^.NewSize, Input, - StreamInfo^.OldSize); - { Res := ZSTD_decompress_usingDDict(dctx[Instance], Buffer, StreamInfo^.NewSize, - Input, StreamInfo^.OldSize, ddict); } - if Res = StreamInfo^.NewSize then + case X of + ZSTD_CODEC: + Res := ZSTD_decompressDCtx(dctx[Instance], Buffer, StreamInfo^.NewSize, + Input, StreamInfo^.OldSize); + end; + if Res > StreamInfo^.OldSize then begin + StreamInfo^.NewSize := Res; Output(Instance, Buffer, Res); Result := True; end; diff --git a/xtool.dpr b/xtool.dpr index d6de072..faa0bd4 100644 --- a/xtool.dpr +++ b/xtool.dpr @@ -186,6 +186,15 @@ begin end; { changelog + ES_R24 (0.4.1) + - fixed issue of status not reporting when encoding + - added depth method support for search support + - fixed zlib encoding issues for different window bits + - fixed zlib memory leak issue + - updated all internal codecs to support information relayed by external codecs + - updated lz4f codec and removed temporarily removed support for universal scanning + - added option to change recompression level to be used by reflate + - updated external executable support ES_R23 (0.4.0) - project made open source @@ -363,143 +372,6 @@ end; changelog } -(* type - XMEMCODEC_TYPE = (XMEMCODEC_DEFAULT = 0, XMEMCODEC_LZX = 1); - - XMEMCODEC_PARAMETERS_LZX = record - public - Flags: Integer; - WindowSize: Integer; - CompressionPartitionSize: Integer; - end; - - PXMEMCODEC_PARAMETERS_LZX = ^XMEMCODEC_PARAMETERS_LZX; - - XMEMCOMPRESSION_CONTEXT = IntPtr; - XMEMDECOMPRESSION_CONTEXT = IntPtr; - - PIntPtr = ^IntPtr; - - function XMemCreateCompressionContext(CodecType: XMEMCODEC_TYPE; - pCodecParams: PXMEMCODEC_PARAMETERS_LZX; Flags: Integer; pContext: PIntPtr) - : Integer stdcall; external 'xcompress.dll'; - function XMemCompress(Context: IntPtr; pDestination: Pointer; - pDestSize: PInteger; pSource: Pointer; SrcSize: Integer): Integer stdcall; - external 'xcompress.dll'; - function XMemDestroyCompressionContext(pContext: IntPtr): Integer stdcall; - external 'xcompress.dll'; - function XMemCreateDecompressionContext(CodecType: XMEMCODEC_TYPE; - pCodecParams: PXMEMCODEC_PARAMETERS_LZX; Flags: Integer; pContext: PIntPtr) - : Integer stdcall; external 'xcompress.dll'; - function XMemDecompress(Context: IntPtr; pDestination: Pointer; - pDestSize: PInteger; pSource: Pointer; SrcSize: Integer): Integer stdcall; - external 'xcompress.dll'; - function XMemDestroyDecompressionContext(pContext: IntPtr): Integer stdcall; - external 'xcompress.dll'; - - type - xcompress_native_p = ^xcompress_native_t; - - xcompress_native_t = packed record - Identifier: UInt32; - Version: UInt16; - Reserved: UInt16; - ContextFlags: UInt32; - Flags: UInt32; - WindowSize: UInt32; - CompressionPartitionSize: UInt32; - UncompressedSize: UInt64; - CompressedSize: UInt64; - UncompressedBlockSize: UInt32; - CompressedBlockSize: UInt32; - procedure CorrectEndian(out data: xcompress_native_t); - { var - BigEndian: Boolean; - procedure CorrectEndian; } - end; - - procedure xcompress_native_t.CorrectEndian(out data: xcompress_native_t); - begin - if Identifier = $EE12F50F then - end; *) - -(* - //#define XCOMPRESS_FILE_IDENTIFIER_LZXTDECODE 0x0FF512ED - #pragma pack(2) - typedef struct { - u32 Identifier; - u16 Version; - u16 Reserved; - u32 CRC_Hash; - u32 Flags; - } xcompress_decode_t; - #pragma pack() - - //#define XCOMPRESS_FILE_IDENTIFIER_LZXNATIVE 0x0FF512EE - #pragma pack(2) - typedef struct { - u32 Identifier; - u16 Version; - u16 Reserved; - u32 ContextFlags; - u32 Flags; - u32 WindowSize; - u32 CompressionPartitionSize; - u32 UncompressedSizeHigh; - u32 UncompressedSizeLow; - u32 CompressedSizeHigh; - u32 CompressedSizeLow; - u32 UncompressedBlockSize; - u32 CompressedBlockSizeMax; - } xcompress_native_t; - #pragma pack() -*) - -(* function xmem_compress(inbuf: Pointer; insz: Integer; outbuf: Pointer; - outsz: Integer): Integer; - var - ctx: XMEMCOMPRESSION_CONTEXT; - param: XMEMCODEC_PARAMETERS_LZX; - ret: SIZE_T; - hr: HRESULT; - begin - Result := 0; - param.Flags := 0; - param.WindowSize := 32 * 1024; - param.CompressionPartitionSize := 32 * 1024; - { param.WindowSize := 128 * 1024; - param.CompressionPartitionSize := 256 * 1024; } - hr := XMemCreateCompressionContext(XMEMCODEC_DEFAULT, @param, 0, @ctx); - ret := outsz; - hr := XMemCompress(ctx, outbuf, @ret, inbuf, insz); - if hr = 0 then - Result := ret; - XMemDestroyCompressionContext(ctx); - end; - - function xmem_decompress(inbuf: Pointer; insz: Integer; outbuf: Pointer; - outsz: Integer): Integer; - var - ctx: XMEMDECOMPRESSION_CONTEXT; - param: XMEMCODEC_PARAMETERS_LZX; - ret: SIZE_T; - hr: HRESULT; - begin - Result := 0; - param.Flags := 0; - param.WindowSize := 32 * 1024; - param.CompressionPartitionSize := 32 * 1024; - hr := XMemCreateDecompressionContext(XMEMCODEC_DEFAULT, @param, 0, @ctx); - ret := outsz; - hr := XMemDecompress(ctx, outbuf, @ret, inbuf, insz); - if hr = 0 then - Result := ret; - XMemDestroyDecompressionContext(ctx); - end; *) - -{ function decode2(src: Pointer; src_size: Integer; dst: Pointer; - dst_size: Integer): Integer cdecl; external 'libdunia.dll'; } - const BufferSize = 1048576; @@ -511,20 +383,8 @@ var PrecompEnc: PrecompMain.TEncodeOptions; PrecompDec: PrecompMain.TDecodeOptions; GenerateEnc: DbgMain.TEncodeOptions; - // MS1, MS2, MS3: TMemoryStream; begin - { MS1 := TMemoryStream.Create; - MS2 := TMemoryStream.Create; - MS3 := TMemoryStream.Create; - MS1.LoadFromFile('Untitled3'); - MS2.Size := 32948; - decode2(MS1.Memory, MS1.Size, MS2.Memory, MS2.Size); - MS2.SaveToFile('Untitled3.out'); - MS3.Size := MS2.Size; - MS3.Size := LZ4_compress_HC(MS2.Memory, MS3.Memory, MS2.Size, MS3.Size, 3); - MS3.SaveToFile('Untitled3.res'); - exit; } FormatSettings := TFormatSettings.Invariant; ProgramInfo; try