diff --git a/changes.txt b/changes.txt index a340325..c1631d3 100644 --- a/changes.txt +++ b/changes.txt @@ -1,8 +1,28 @@ + ES_R41 (0.6.6) + - fixed issues with exporting precompression database + - fixed issues with deduplication feature consuming a lot of system memory + - fixed oodle codec from auto enabling selkie method + - fixed reflate related checksum issues due to false positives + + ES_R40 (0.6.5) + - updated oodle scanner + - remove xdelta support from oodle and lzo codecs (crc mismatch often generates large diff files) + + ES_R39 (0.6.4) + - fixed issues with lzo2a and lzo1c codecs + + ES_R38 (0.6.3) + - added universal lz4f scanner + - fixed issues with database feature + - fixed issues with executable plugin support + - updated lzo codecs + ES_R37 (0.6.2) - added feature to inject libraries to main executable ES_R36 (0.6.1) - added fast lzma2 compression for portable mode + - fixed issues with wav stream detection - fixed minor issue with stream deduplication feature ES_R35 (0.6.0) diff --git a/common/LibImport.pas b/common/LibImport.pas new file mode 100644 index 0000000..73684dd --- /dev/null +++ b/common/LibImport.pas @@ -0,0 +1,132 @@ +unit LibImport; + +interface + +uses + MemoryModule, + WinAPI.Windows, + System.SysUtils, System.Classes, System.Character; + +type + TLibImport = class + private + FIsMemoryLib: Boolean; + FDLLLoaded: Boolean; + FDLLStream: TResourceStream; + FDLLHandle: NativeUInt; + public + constructor Create(ALibrary: String); + destructor Destroy; override; + function GetProcAddr(AProcName: PAnsiChar): Pointer; + property Loaded: Boolean read FDLLLoaded; + end; + +procedure InjectLib(Source, Dest: String); + +implementation + +function ResourceExists(ResName: String): Boolean; +begin + Result := FindResourceEx(HInstance, RT_RCDATA, PWideChar(ResName), 0) <> 0; +end; + +function FileToResourceName(FileName: String): String; +var + I: Integer; +begin + Result := ChangeFileExt(ExtractFileName(FileName), '').ToUpper; + for I := 1 to Result.Length do + if not Result[I].IsLetterOrDigit then + Result[I] := '_'; +end; + +procedure UpdateFileResource(Source, Dest, ResName: string); +var + Stream: TFileStream; + hDestRes: THandle; + lpData: Pointer; + cbData: DWORD; +begin + Stream := TFileStream.Create(Source, fmOpenRead or fmShareDenyNone); + try + Stream.Seek(0, soFromBeginning); + cbData := Stream.Size; + if cbData > 0 then + begin + GetMem(lpData, cbData); + try + Stream.ReadBuffer(lpData^, cbData); + hDestRes := BeginUpdateResource(PChar(Dest), False); + if hDestRes <> 0 then + if UpdateResource(hDestRes, RT_RCDATA, PWideChar(ResName), 0, lpData, + cbData) then + begin + if not EndUpdateResource(hDestRes, False) then + RaiseLastOSError; + end + else + RaiseLastOSError + else + RaiseLastOSError; + finally + FreeMem(lpData); + end; + end; + finally + Stream.Free; + end; +end; + +constructor TLibImport.Create(ALibrary: String); +var + LResName: String; +begin + inherited Create; + FDLLLoaded := False; + LResName := FileToResourceName(ALibrary); + FIsMemoryLib := ResourceExists(LResName); + if FIsMemoryLib then + begin + FDLLStream := TResourceStream.Create(HInstance, LResName, RT_RCDATA); + FDLLHandle := NativeUInt(MemoryLoadLibary(FDLLStream.Memory)); + FDLLLoaded := Assigned(Pointer(FDLLHandle)); + end + else + begin + FDLLHandle := LoadLibrary(PWideChar(ALibrary)); + FDLLLoaded := FDLLHandle >= 32; + end; +end; + +destructor TLibImport.Destroy; +begin + if FIsMemoryLib then + begin + if FDLLLoaded then + MemoryFreeLibrary(Pointer(FDLLHandle)); + FDLLStream.Free; + end + else if FDLLLoaded then + FreeLibrary(FDLLHandle); + inherited Destroy; +end; + +function TLibImport.GetProcAddr(AProcName: PAnsiChar): Pointer; +begin + if not FDLLLoaded then + Result := nil + else if FIsMemoryLib then + Result := MemoryGetProcAddress(Pointer(FDLLHandle), AProcName) + else + Result := GetProcAddress(FDLLHandle, AProcName); +end; + +procedure InjectLib(Source, Dest: String); +var + LResName: String; +begin + LResName := FileToResourceName(Source); + UpdateFileResource(Source, Dest, LResName); +end; + +end. diff --git a/common/Threading.pas b/common/Threading.pas index 3bfe59e..ececf18 100644 --- a/common/Threading.pas +++ b/common/Threading.pas @@ -220,6 +220,7 @@ function WaitForAny(const Tasks: array of TTask): Integer; var I: Integer; begin + Result := -1; while True do begin for I := Low(Tasks) to High(Tasks) do diff --git a/common/Utils.pas b/common/Utils.pas index 09cfbdd..8169d5a 100644 --- a/common/Utils.pas +++ b/common/Utils.pas @@ -221,17 +221,20 @@ type FIncSize = 64 * 1024 * 1024; private FStream: TFileStream; + FLastPosition, FLastSize: NativeInt; FMapHandle: THandle; FMapName: String; FMapBuffer: Pointer; function CalcSize(ASize: NativeInt): NativeInt; procedure IncMemory(ANewSize: NativeInt = 0); + procedure Flush(AForceFlush: Boolean = False); public constructor Create(const AMapName: String; AFileName: string); overload; constructor Create(const AMapName: String; ASize: NativeInt); overload; destructor Destroy; override; procedure SetSize(const NewSize: Int64); override; function Write(const Buffer; Count: LongInt): LongInt; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; TDownloadStream = class(TStream) @@ -253,33 +256,41 @@ type TBufferedStream = class(TStream) private - FStream: TStream; FReadMode: Boolean; FMemory: PByte; FBufferSize: Integer; FBufPos, FBufSize: Integer; public + Instance: TStream; constructor Create(Stream: TStream; ReadMode: Boolean; BufferSize: Integer = 65536); destructor Destroy; override; function Read(var Buffer; Count: Integer): Integer; override; function Write(const Buffer; Count: Integer): Integer; override; + procedure Flush; end; - { TGPUMemoryStream = class(TStream) - private - FMemory: Pointer; - FSize, FPosition: NativeInt; - protected - procedure SetPointer(Ptr: Pointer; const Size: NativeInt); - public - function Read(var Buffer; Count: longint): longint; override; - function Read(Buffer: TBytes; Offset, Count: longint): longint; override; - function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override; - procedure SaveToStream(Stream: TStream); virtual; - procedure SaveToFile(const FileName: string); - property Memory: Pointer read FMemory; - end; } + TProcessStream = class(TStream) + private + FInput, FOutput: TStream; + FTask: TTask; + FProcessInfo: TProcessInformation; + FStdinr, FStdinw: THandle; + FStdoutr, FStdoutw: THandle; + FExecutable, FCommandLine, FWorkDir: String; + procedure ExecReadTask; + procedure ExecWriteTask; + public + constructor Create(AExecutable, ACommandLine, AWorkDir: String; + AInput: TStream = nil; AOutput: TStream = nil); + destructor Destroy; override; + function Read(var Buffer; Count: LongInt): LongInt; override; + function Write(const Buffer; Count: LongInt): LongInt; override; + function Execute: Boolean; + procedure Wait; + function Done: Boolean; + function Running: Boolean; + end; TDataStore = class(TObject) public @@ -311,7 +322,7 @@ type FDone, FFirstRead, FLastRead: Boolean; public constructor Create(AInput: TStream; ADynamic: Boolean; - ASlots, ASize: NativeInt; ATempFile: String = ''); + ASlots, ASize: NativeInt; ATempFile: String = 'datastore.tmp'); destructor Destroy; override; procedure ChangeInput(AInput: TStream); function Read(Index: Integer; Position: NativeInt; var Buffer; @@ -490,8 +501,6 @@ function GetCmdStr(CommandLine: String; Index: Integer; KeepQuotes: Boolean = False): string; function GetCmdCount(CommandLine: String): Integer; -procedure UpdateFileResource(Source, Dest, ResName: string); - implementation function GetBits(Data: Int64; Index: TInt64_BitIndex; @@ -1367,6 +1376,8 @@ var begin inherited Create(False); FStream := nil; + FLastPosition := FPosition; + FLastSize := 0; FMapHandle := 0; FMapBuffer := nil; LExists := FileExists(AFileName); @@ -1399,6 +1410,8 @@ var begin inherited Create(False); FStream := nil; + FLastPosition := FPosition; + FLastSize := 0; FMapHandle := 0; FMapBuffer := nil; FMapName := AMapName; @@ -1416,6 +1429,7 @@ end; destructor TSharedMemoryStream.Destroy; begin + Flush(True); UnMapViewOfFile(FMapBuffer); CloseHandle(FMapHandle); if Assigned(FStream) then @@ -1455,6 +1469,27 @@ begin [FMapName, SysErrorMessage(GetLastError)]); FMapBuffer := MapViewOfFile(FMapHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0); Update(FMapBuffer, LSize); + FLastPosition := FPosition; +end; + +procedure TSharedMemoryStream.Flush(AForceFlush: Boolean); +var + LAddr: Pointer; + LSize: NativeInt; +begin + if AForceFlush or (FLastSize >= FIncSize) or + (InRange(FPosition, FLastPosition, FLastPosition + FLastSize) = False) then + begin + if (FLastSize > 0) and Assigned(FMapBuffer) then + begin + LAddr := PByte(FMapBuffer) + FLastPosition; + LSize := Min(FLastSize, FSize - FLastPosition); + if LSize > 0 then + FlushViewOfFile(LAddr, FLastSize); + end; + FLastPosition := FPosition; + FLastSize := 0; + end; end; procedure TSharedMemoryStream.SetSize(const NewSize: Int64); @@ -1469,6 +1504,15 @@ begin if FPosition + Count > FMaxSize then IncMemory(FPosition + Count); Result := inherited Write(Buffer, Count); + Flush; + Inc(FLastSize, Result); +end; + +function TSharedMemoryStream.Seek(const Offset: Int64; + Origin: TSeekOrigin): Int64; +begin + Result := inherited Seek(Offset, Origin); + FLastPosition := FPosition; end; constructor TDownloadStream.Create(Url: string); @@ -1540,26 +1584,22 @@ constructor TBufferedStream.Create(Stream: TStream; ReadMode: Boolean; BufferSize: Integer); begin inherited Create; - FStream := Stream; + Instance := Stream; FReadMode := ReadMode; GetMem(FMemory, BufferSize); FBufferSize := BufferSize; FBufPos := 0; if FReadMode then - FBufSize := FStream.Read(FMemory^, FBufferSize) + FBufSize := Instance.Read(FMemory^, FBufferSize) else FBufSize := 0; end; destructor TBufferedStream.Destroy; begin - if FReadMode = False then - begin - FStream.WriteBuffer(FMemory^, FBufSize); - FBufSize := 0; - end; + Flush; FreeMem(FMemory); - FStream.Free; + Instance.Free; inherited Destroy; end; @@ -1599,7 +1639,7 @@ begin if FBufPos = FBufSize then begin FBufPos := 0; - FBufSize := FStream.Read(FMemory^, FBufferSize); + FBufSize := Instance.Read(FMemory^, FBufferSize); end; end; Result := Count - FCount; @@ -1622,12 +1662,12 @@ begin FDest := FMemory + FBufSize; if (FBufSize = 0) and (FCount >= FBufferSize) then begin - FStream.WriteBuffer(FSrc^, FBufferSize); + Instance.WriteBuffer(FSrc^, FBufferSize); Dec(FCount, FBufferSize); end else if (FBufSize = FBufferSize) then begin - FStream.WriteBuffer(FMemory^, FBufSize); + Instance.WriteBuffer(FMemory^, FBufSize); FBufSize := 0; end else @@ -1655,6 +1695,190 @@ begin Result := Count - FCount; end; +procedure TBufferedStream.Flush; +begin + if FReadMode = False then + begin + Instance.WriteBuffer(FMemory^, FBufSize); + FBufSize := 0; + end; +end; + +constructor TProcessStream.Create(AExecutable, ACommandLine, AWorkDir: String; + AInput: TStream; AOutput: TStream); +begin + inherited Create; + FInput := AInput; + FOutput := AOutput; + FExecutable := AExecutable; + FCommandLine := ACommandLine; + FWorkDir := AWorkDir; + FTask := TTask.Create; +end; + +destructor TProcessStream.Destroy; +begin + CloseHandleEx(FStdinr); + CloseHandleEx(FStdinw); + CloseHandleEx(FStdoutr); + CloseHandleEx(FStdoutw); + CloseHandleEx(FProcessInfo.hProcess); + FTask.Free; + inherited Destroy; +end; + +function TProcessStream.Read(var Buffer; Count: LongInt): LongInt; +var + BytesRead: DWORD; +begin + Result := 0; + if Assigned(FOutput) then + raise EReadError.CreateRes(@SReadError); + if ReadFile(FStdoutr, Buffer, Count, BytesRead, nil) then + Result := BytesRead; +end; + +function TProcessStream.Write(const Buffer; Count: LongInt): LongInt; +var + BytesWritten: DWORD; + Res: Boolean; +begin + Result := 0; + if Assigned(FInput) then + raise EWriteError.CreateRes(@SWriteError); + if WriteFile(FStdinw, Buffer, Count, BytesWritten, nil) then + Result := BytesWritten; +end; + +procedure TProcessStream.ExecReadTask; +const + BufferSize = 65536; +var + Buffer: array [0 .. BufferSize - 1] of Byte; + BytesRead: DWORD; +begin + while ReadFile(FStdoutr, Buffer[0], Length(Buffer), BytesRead, nil) and + (BytesRead > 0) do + FOutput.WriteBuffer(Buffer[0], BytesRead); + CloseHandleEx(FStdoutr); +end; + +procedure TProcessStream.ExecWriteTask; +const + BufferSize = 65536; +var + Buffer: array [0 .. BufferSize - 1] of Byte; + BytesWritten: DWORD; +begin + BytesWritten := FInput.Read(Buffer[0], BufferSize); + while WriteFile(FStdinw, Buffer[0], BytesWritten, BytesWritten, nil) and + (BytesWritten > 0) do + BytesWritten := FInput.Read(Buffer[0], BufferSize); + CloseHandleEx(FStdinw); +end; + +function TProcessStream.Execute: Boolean; +const + PipeSecurityAttributes: TSecurityAttributes = + (nLength: sizeof(PipeSecurityAttributes); bInheritHandle: True); +var + StartupInfo: TStartupInfo; + dwExitCode: DWORD; + LWorkDir: PChar; + LStream: THandleStream; +begin + Result := False; + CreatePipe(FStdinr, FStdinw, @PipeSecurityAttributes, 0); + CreatePipe(FStdoutr, FStdoutw, @PipeSecurityAttributes, 0); + SetHandleInformation(FStdinw, HANDLE_FLAG_INHERIT, 0); + SetHandleInformation(FStdoutr, 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 := FStdinr; + StartupInfo.hStdOutput := FStdoutw; + StartupInfo.hStdError := 0; + ZeroMemory(@FProcessInfo, sizeof(FProcessInfo)); + if FWorkDir <> '' then + LWorkDir := Pointer(FWorkDir) + else + LWorkDir := Pointer(GetCurrentDir); + if CreateProcess(nil, PChar('"' + FExecutable + '" ' + FCommandLine), nil, + nil, True, NORMAL_PRIORITY_CLASS, nil, LWorkDir, StartupInfo, FProcessInfo) + then + begin + CloseHandleEx(FProcessInfo.hThread); + CloseHandleEx(FStdinr); + CloseHandleEx(FStdoutw); + if Assigned(FOutput) and not Assigned(FInput) then + begin + FTask.Perform(ExecReadTask); + FTask.Start; + Result := True; + end + else if Assigned(FInput) and not Assigned(FOutput) then + begin + FTask.Perform(ExecWriteTask); + FTask.Start; + Result := True; + end + else if Assigned(FInput) and Assigned(FOutput) then + begin + FTask.Perform(ExecReadTask); + FTask.Start; + LStream := THandleStream.Create(FStdinw); + try + CopyStream(FInput, LStream); + finally + LStream.Free; + CloseHandleEx(FStdinw); + FTask.Wait; + end; + WaitForSingleObject(FProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(FProcessInfo.hProcess, dwExitCode); + CloseHandleEx(FProcessInfo.hProcess); + if FTask.Status <> TThreadStatus.tsErrored then + FTask.RaiseLastError; + Result := dwExitCode = 0; + end; + end + else + begin + CloseHandleEx(FStdinr); + CloseHandleEx(FStdinw); + CloseHandleEx(FStdoutr); + CloseHandleEx(FStdoutw); + RaiseLastOSError; + end; +end; + +procedure TProcessStream.Wait; +begin + WaitForSingleObject(FProcessInfo.hProcess, INFINITE); +end; + +function TProcessStream.Done: Boolean; +var + dwExitCode: DWORD; +begin + Result := False; + CloseHandleEx(FStdinw); + CloseHandleEx(FStdoutr); + FTask.Wait; + WaitForSingleObject(FProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(FProcessInfo.hProcess, dwExitCode); + CloseHandleEx(FProcessInfo.hProcess); + if FTask.Status <> TThreadStatus.tsErrored then + FTask.RaiseLastError; + Result := dwExitCode = 0; +end; + +function TProcessStream.Running: Boolean; +begin + Result := WaitForSingleObject(FProcessInfo.hProcess, 0) = WAIT_TIMEOUT; +end; + constructor TDataStore1.Create(AInput: TStream; ADynamic: Boolean; ASlots, ASize: NativeInt; ATempFile: String); var @@ -3069,6 +3293,8 @@ begin if AnsiContainsStr(S, 'p') or AnsiContainsStr(S, '%') then begin Result := Round((CPUCount * StrToInt(Copy(S, 1, Length(S) - 1))) / 100); + if Result < 1 then + Result := 1; exit; end; Result := StrToInt64(S); @@ -3344,10 +3570,10 @@ begin FileWriteBuffer(hstdinw, InBuff^, InSize); finally CloseHandleEx(hstdinw); - WaitForSingleObject(ProcessInfo.hProcess, INFINITE); - GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); - CloseHandleEx(ProcessInfo.hProcess); end; + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); + CloseHandleEx(ProcessInfo.hProcess); Result := dwExitCode = 0; end else @@ -3399,10 +3625,10 @@ begin Output(@Buffer[0], BytesRead); finally CloseHandleEx(hstdoutr); - WaitForSingleObject(ProcessInfo.hProcess, INFINITE); - GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); - CloseHandleEx(ProcessInfo.hProcess); end; + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); + CloseHandleEx(ProcessInfo.hProcess); Result := dwExitCode = 0; end else @@ -3429,7 +3655,7 @@ var dwExitCode: DWORD; LWorkDir: PChar; begin - Result := True; + Result := False; CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0); CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0); SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0); @@ -3461,10 +3687,10 @@ begin finally CloseHandleEx(hstdinw); CloseHandleEx(hstdoutr); - WaitForSingleObject(ProcessInfo.hProcess, INFINITE); - GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); - CloseHandleEx(ProcessInfo.hProcess); end; + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); + CloseHandleEx(ProcessInfo.hProcess); Result := dwExitCode = 0; end else @@ -3506,7 +3732,7 @@ var LTask: TTask; LDone: Boolean; begin - Result := True; + Result := False; CreatePipe(hstdinr, hstdinw, @PipeSecurityAttributes, 0); CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0); SetHandleInformation(hstdinw, HANDLE_FLAG_INHERIT, 0); @@ -3544,6 +3770,9 @@ begin end; CloseHandleEx(hstdoutr); end; + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode); + CloseHandleEx(ProcessInfo.hProcess); if Assigned(LTask) then if LTask.Status <> TThreadStatus.tsErrored then try @@ -3576,7 +3805,8 @@ begin while Idx <= Index do begin Quoted := False; - while (I <= CommandLine.Length) and (CommandLine[I] = ' ') do + while (I <= CommandLine.Length) and + ((CommandLine[I] = ' ') or (CommandLine[I] = #09)) do Inc(I); if I > CommandLine.Length then break; @@ -3617,41 +3847,4 @@ begin Inc(Result); end; -procedure UpdateFileResource(Source, Dest, ResName: string); -var - Stream: TFileStream; - hDestRes: THandle; - lpData: Pointer; - cbData: DWORD; -begin - Stream := TFileStream.Create(Source, fmOpenRead or fmShareDenyNone); - try - Stream.Seek(0, soFromBeginning); - cbData := Stream.Size; - if cbData > 0 then - begin - GetMem(lpData, cbData); - try - Stream.Read(lpData^, cbData); - hDestRes := BeginUpdateResource(PChar(Dest), False); - if hDestRes <> 0 then - if UpdateResource(hDestRes, RT_RCDATA, PWideChar(ResName), 0, lpData, - cbData) then - begin - if not EndUpdateResource(hDestRes, False) then - RaiseLastOSError - end - else - RaiseLastOSError - else - RaiseLastOSError; - finally - FreeMem(lpData); - end; - end; - finally - Stream.Free; - end; -end; - end. diff --git a/contrib/opencl/DelphiCL.pas b/contrib/opencl/DelphiCL.pas deleted file mode 100644 index 1552309..0000000 --- a/contrib/opencl/DelphiCL.pas +++ /dev/null @@ -1,1777 +0,0 @@ -(* ****************************************** *) -(* *) -(* DelphiCL *) -(* *) -(* created by : Maksym Tymkovych *) -(* (niello) *) -(* *) -(* headers versions: 0.07 *) -(* file name : DelphiCL.pas *) -(* last modify : 10.12.11 *) -(* license : BSD *) -(* *) -(* Site : www.niello.org.ua *) -(* e-mail : muxamed13@ukr.net *) -(* ICQ : 446-769-253 *) -(* *) -(* ********Copyright (c) niello 2008-2011**** *) - -unit DelphiCL; - -interface - -uses - OpenCL, - Windows, - SysUtils; - -type - - TDCLMemFlags = (mfReadWrite, mfWriteOnly, mfReadOnly, mfUseHostPtr, - mfAllocHostPtr, mfCopyHostPtr); - TDCLMemFlagsSet = set of TDCLMemFlags; - - TDCLBuffer = class - private - FMem: PCL_mem; - FStatus: CL_int; - FSize: Size_t; - protected - constructor Create(const Context: PCL_context; const Flags: TDCLMemFlagsSet; - const Size: Size_t; const Data: Pointer = nil); - public - procedure Free(); - property Size: Size_t read FSize; - property Status: CL_int read FStatus; - end; - - TDCLImage2D = class - private - FMem: PCL_mem; - FStatus: CL_int; - FFormat: CL_image_format; - FWidth: Size_t; - FHeight: Size_t; - FRowPitch: Size_t; - protected - constructor Create(const Context: PCL_context; const Flags: TDCLMemFlagsSet; - const Format: PCL_image_format; const Width, Height: Size_t; - const RowPitch: Size_t = 0; const Data: Pointer = nil); - public - procedure Free(); - property Width: Size_t read FWidth; - property Height: Size_t read FHeight; - property RowPitch: Size_t read FRowPitch; - property Status: CL_int read FStatus; - end; - - TDCLCommandQueueProperties = (cqpNone, cqpOutOfOrderExecModeEnable); - TDCLCommandQueuePropertiesSet = set of TDCLCommandQueueProperties; - - TDCLKernel = class - private - FKernel: PCL_kernel; - FStatus: CL_int; - protected - constructor Create(const Program_: PCL_program; const KernelName: PPChar); - function GetFunctionName(): AnsiString; - function GetNumArgs(): CL_uint; - public - property Status: CL_int read FStatus; - property FunctionName: AnsiString read GetFunctionName; - property NumArgs: CL_uint read GetNumArgs; - procedure SetArg(const Index: CL_uint; const Size: Size_t; - const Value: Pointer); overload; - procedure SetArg(const Index: CL_uint; const Value: TDCLBuffer); overload; - procedure SetArg(const Index: CL_uint; const Value: TDCLImage2D); overload; - procedure Free(); - end; - - TDCLCommandQueue = class - private - FCommandQueue: PCL_command_queue; - FStatus: CL_int; - FProperties: TDCLCommandQueuePropertiesSet; - constructor Create(const Device_Id: PCL_device_id; - const Context: PCL_context; - const Properties: TDCLCommandQueuePropertiesSet = [cqpNone]); - public - procedure ReadBuffer(const Buffer: TDCLBuffer; const Size: Size_t; - const Data: Pointer); - procedure WriteBuffer(const Buffer: TDCLBuffer; const Size: Size_t; - const Data: Pointer); - procedure ReadImage2D(const Image: TDCLImage2D; const Width, Height: Size_t; - const Data: Pointer); - procedure WriteImage2D(const Image: TDCLImage2D; - const Width, Height: Size_t; const Data: Pointer); - procedure Execute(const Kernel: TDCLKernel; const Size: Size_t); overload; - procedure Execute(const Kernel: TDCLKernel; // const Device: PCL_device_id; - const Size: array of Size_t); overload; - property Status: CL_int read FStatus; - property Properties: TDCLCommandQueuePropertiesSet read FProperties; - procedure Free(); - end; - - TArraySize_t = Array of Size_t; - - TDCLProgram = class - private - FProgram: PCL_program; - FStatus: CL_int; - FSource: PAnsiChar; - FBinarySizesCount: Size_t; - FBinarySizes: TArraySize_t; - // FBinaries: PByte; - protected - constructor Create(const Context: PCL_context; const Source: PPChar; - const Options: PPChar = nil); - function GetBinarySizes(const Index: Size_t): Size_t; - public - property BinarySizes[const Index: Size_t]: Size_t read GetBinarySizes; - property BinarySizesCount: Size_t read FBinarySizesCount; - property Source: PAnsiChar read FSource; - property Status: CL_int read FStatus; - function CreateKernel(const KernelName: PPChar): TDCLKernel; - procedure Free(); - end; - - TDCLContext = class - private - FContext: PCL_context; - FStatus: CL_int; - FNumDevices: CL_uint; - protected - // property Context: PCL_context read FContext; - public - constructor Create(Device_Id: PCL_device_id); - property Status: CL_int read FStatus; - property NumDevices: CL_uint read FNumDevices; - procedure Free(); - end; - - TDCLDevice = class - // private - FDevice_id: PCL_device_id; - private - FStatus: CL_int; - - FName: AnsiString; - FVendor: AnsiString; - FVersion: AnsiString; - FProfile: AnsiString; - - FIsCPU: Boolean; - FIsGPU: Boolean; - FIsAccelerator: Boolean; - FIsDefault: Boolean; - - FMaxWorkGroupSize: Size_t; - - FNativeVectorPreferredChar: CL_uint; - FNativeVectorPreferredShort: CL_uint; - FNativeVectorPreferredInt: CL_uint; - FNativeVectorPreferredLong: CL_uint; - FNativeVectorPreferredFloat: CL_uint; - FNativeVectorPreferredDouble: CL_uint; - FNativeVectorPreferredHalf: CL_uint; - FNativeVectorWidthChar: CL_uint; - FNativeVectorWidthShort: CL_uint; - FNativeVectorWidthInt: CL_uint; - FNativeVectorWidthLong: CL_uint; - FNativeVectorWidthFloat: CL_uint; - FNativeVectorWidthDouble: CL_uint; - FNativeVectorWidthHalf: CL_uint; - - FMaxClockFrequency: CL_uint; - FAddressBits: CL_uint; - FMaxMemAllocSize: CL_ulong; - - FIsImageSupport: Boolean; - - FMaxReadImageArgs: CL_uint; - FMaxWriteImageArgs: CL_uint; - FImage2DMaxWidth: Size_t; - FImage2DMaxHeight: Size_t; - FImage3DMaxWidth: Size_t; - FImage3DMaxHeight: Size_t; - FImage3DMaxDepth: Size_t; - FMaxSamplers: CL_uint; - FMaxParameterSize: Size_t; - FMemBaseAddrAlign: CL_uint; - FMinDataTypeAlignSize: CL_uint; - - FGlobalMemCacheLineSize: CL_uint; - FGlobalMemCacheSize: CL_ulong; - FGlobalMemSize: CL_ulong; - FMaxConstantBufferSize: CL_ulong; - FMaxConstantArgs: CL_uint; - - FLocalMemSize: CL_ulong; - FIsErrorCorrectionSupport: Boolean; - FIsHostUnifiedMemory: Boolean; - FProfilingTimerResolution: Size_t; - FIsEndianLittle: Boolean; - FIsAvailable: Boolean; - FIsCompilerAvailable: Boolean; - - FVendorId: CL_uint; - FMaxComputeUnits: CL_uint; - FMaxWorkItemDimensions: CL_uint; - FExtensionsString: AnsiString; - FOpenCLCVersion: AnsiString; - FDriverVersion: AnsiString; - - FExtensionsCount: Size_t; - FExtensions: Array of AnsiString; - - FContext: TDCLContext; - - function GetExtensions(const Index: Size_t): AnsiString; - function IsPresentExtension(const ExtensionName: AnsiString): Boolean; - protected - constructor Create(Device_Id: PCL_device_id); - property Device_Id: PCL_device_id read FDevice_id; - public - property Status: CL_int read FStatus; - - property Name: AnsiString read FName; - property Vendor: AnsiString read FVendor; - property Version: AnsiString read FVersion; - property Profile: AnsiString read FProfile; - - property IsCPU: Boolean read FIsCPU; - property IsGPU: Boolean read FIsGPU; - property IsAccelerator: Boolean read FIsAccelerator; - property IsDefault: Boolean read FIsDefault; - - property MaxWorkGroupSize: Size_t read FMaxWorkGroupSize; - - property NativeVectorPreferredChar: CL_uint read FNativeVectorPreferredChar; - property NativeVectorPreferredShort: CL_uint - read FNativeVectorPreferredShort; - property NativeVectorPreferredInt: CL_uint read FNativeVectorPreferredInt; - property NativeVectorPreferredLong: CL_uint read FNativeVectorPreferredLong; - property NativeVectorPreferredFloat: CL_uint - read FNativeVectorPreferredFloat; - property NativeVectorPreferredDouble: CL_uint - read FNativeVectorPreferredDouble; - property NativeVectorPreferredHalf: CL_uint read FNativeVectorPreferredHalf; - property NativeVectorWidthChar: CL_uint read FNativeVectorWidthChar; - property NativeVectorWidthShort: CL_uint read FNativeVectorWidthShort; - property NativeVectorWidthInt: CL_uint read FNativeVectorWidthInt; - property NativeVectorWidthLong: CL_uint read FNativeVectorWidthLong; - property NativeVectorWidthFloat: CL_uint read FNativeVectorWidthFloat; - property NativeVectorWidthDouble: CL_uint read FNativeVectorWidthDouble; - property NativeVectorWidthHalf: CL_uint read FNativeVectorWidthHalf; - - property MaxClockFrequency: CL_uint read FMaxClockFrequency; - property AddressBits: CL_uint read FAddressBits; - property MaxMemAllocSize: CL_ulong read FMaxMemAllocSize; - - property IsImageSupport: Boolean read FIsImageSupport; - - property MaxReadImageArgs: CL_uint read FMaxReadImageArgs; - property MaxWriteImageArgs: CL_uint read FMaxWriteImageArgs; - property Image2DMaxWidth: Size_t read FImage2DMaxWidth; - property Image2DMaxHeight: Size_t read FImage2DMaxHeight; - property Image3DMaxWidth: Size_t read FImage3DMaxWidth; - property Image3DMaxHeight: Size_t read FImage3DMaxHeight; - property Image3DMaxDepth: Size_t read FImage3DMaxDepth; - property MaxSamplers: CL_uint read FMaxSamplers; - property MaxParameterSize: Size_t read FMaxParameterSize; - property MemBaseAddrAlign: CL_uint read FMemBaseAddrAlign; - property MinDataTypeAlignSize: CL_uint read FMinDataTypeAlignSize; - - property GlobalMemCacheLineSize: CL_uint read FGlobalMemCacheLineSize; - property GlobalMemCacheSize: CL_ulong read FGlobalMemCacheSize; - property GlobalMemSize: CL_ulong read FGlobalMemSize; - property MaxConstantBufferSize: CL_ulong read FMaxConstantBufferSize; - property MaxConstantArgs: CL_uint read FMaxConstantArgs; - - property LocalMemSize: CL_ulong read FLocalMemSize; - property IsErrorCorrectionSupport: Boolean read FIsErrorCorrectionSupport; - property IsHostUnifiedMemory: Boolean read FIsHostUnifiedMemory; - property ProfilingTimerResolution: Size_t read FProfilingTimerResolution; - property IsEndianLittle: Boolean read FIsEndianLittle; - property IsAvailable: Boolean read FIsAvailable; - property IsCompilerAvailable: Boolean read FIsCompilerAvailable; - - property VendorId: CL_uint read FVendorId; - property MaxComputeUnits: CL_uint read FMaxComputeUnits; - property MaxWorkItemDimensions: CL_uint read FMaxWorkItemDimensions; - - property DriverVersion: AnsiString read FDriverVersion; - property OpenCLCVersion: AnsiString read FOpenCLCVersion; - property ExtensionsString: AnsiString read FExtensionsString; - - property Context: TDCLContext read FContext; - function CreateContext(): TDCLContext; - function CreateCommandQueue(const Properties - : TDCLCommandQueuePropertiesSet = [cqpNone]): TDCLCommandQueue; - function CreateBuffer(const Size: Size_t; const Data: Pointer = nil; - const Flags: TDCLMemFlagsSet = [mfReadWrite]): TDCLBuffer; - function CreateImage2D(const Format: PCL_image_format; - const Width, Height, RowPitch: Size_t; const Data: Pointer = nil; - const Flags: TDCLMemFlagsSet = [mfReadWrite]): TDCLImage2D; - function CreateProgram(const Source: PPChar; const Options: PPChar = nil) - : TDCLProgram; overload; - function CreateProgram(const FileName: String; const Options: PPChar = nil) - : TDCLProgram; overload; - - property ExtensionsCount: Size_t read FExtensionsCount; - property Extensions[const Index: Size_t]: AnsiString read GetExtensions; - property IsSupportedExtension[const Index: AnsiString]: Boolean - read IsPresentExtension; - procedure Free(); - end; - - TDCLPlatform = class - private - FPlatform_id: PCL_platform_id; - FProfile: AnsiString; - FVersion: AnsiString; - FName: AnsiString; - FVendor: AnsiString; - FExtensionsString: AnsiString; - FStatus: CL_int; - FDevices: Array of TDCLDevice; - FDeviceCount: CL_uint; - FExtensionsCount: Size_t; - FExtensions: Array of AnsiString; - function GetDevice(Index: CL_uint): TDCLDevice; - function GetExtensions(Index: Size_t): AnsiString; - function IsPresentExtension(const ExtensionName: AnsiString): Boolean; - - function GetDeviceWithMaxClockFrequency(): TDCLDevice; - function GetDeviceWithMaxComputeUnits(): TDCLDevice; - - function GetDeviceWithMaxGlobalMemCacheLineSize(): TDCLDevice; - function GetDeviceWithMaxGlobalMemCacheSize(): TDCLDevice; - function GetDeviceWithMaxGlobalMemSize(): TDCLDevice; - - function GetDeviceWithMaxImage2DWidth(): TDCLDevice; - function GetDeviceWithMaxImage2DHeight(): TDCLDevice; - function GetDeviceWithMaxImage3DWidth(): TDCLDevice; - function GetDeviceWithMaxImage3DHeight(): TDCLDevice; - function GetDeviceWithMaxImage3DDepth(): TDCLDevice; - - function GetDeviceWithMaxLocalMemSize(): TDCLDevice; - function GetDeviceWithMaxConstantArgs(): TDCLDevice; - function GetDeviceWithMaxConstantBufferSize(): TDCLDevice; - function GetDeviceWithMaxMemAllocSize(): TDCLDevice; - function GetDeviceWithMaxParameterSize(): TDCLDevice; - function GetDeviceWithMaxReadImageArgs(): TDCLDevice; - function GetDeviceWithMaxSamplers(): TDCLDevice; - function GetDeviceWithMaxWorkGroupSize(): TDCLDevice; - function GetDeviceWithMaxWorkItemDimensions(): TDCLDevice; - function GetDeviceWithMaxWriteImageArgs(): TDCLDevice; - public - constructor Create(Platform_id: PCL_platform_id); - property Profile: AnsiString read FProfile; - property Version: AnsiString read FVersion; - property Name: AnsiString read FName; - property Vendor: AnsiString read FVendor; - property ExtensionsString: AnsiString read FExtensionsString; - - property DeviceCount: CL_uint read FDeviceCount; - property Status: CL_int read FStatus; - property Devices[Index: CL_uint]: TDCLDevice read GetDevice; - property ExtensionsCount: Size_t read FExtensionsCount; - property Extensions[Index: Size_t]: AnsiString read GetExtensions; - property IsSupportedExtension[const Index: AnsiString]: Boolean - read IsPresentExtension; - - property DeviceWithMaxClockFrequency: TDCLDevice - read GetDeviceWithMaxClockFrequency; - property DeviceWithMaxComputeUnits: TDCLDevice - read GetDeviceWithMaxComputeUnits; - property DeviceWithMaxGlobalMemCacheLineSize: TDCLDevice - read GetDeviceWithMaxGlobalMemCacheLineSize; - property DeviceWithMaxGlobalMemCacheSize: TDCLDevice - read GetDeviceWithMaxGlobalMemCacheSize; - property DeviceWithMaxGlobalMemSize: TDCLDevice - read GetDeviceWithMaxGlobalMemSize; - property DeviceWithMaxImage2DWidth: TDCLDevice - read GetDeviceWithMaxImage2DWidth; - property DeviceWithMaxImage2DHeight: TDCLDevice - read GetDeviceWithMaxImage2DHeight; - property DeviceWithMaxImage3DWidth: TDCLDevice - read GetDeviceWithMaxImage3DWidth; - property DeviceWithMaxImage3DHeight: TDCLDevice - read GetDeviceWithMaxImage3DHeight; - property DeviceWithMaxImage3DDepth: TDCLDevice - read GetDeviceWithMaxImage3DDepth; - property DeviceWithMaxLocalMemSize: TDCLDevice - read GetDeviceWithMaxLocalMemSize; - property DeviceWithMaxConstantArgs: TDCLDevice - read GetDeviceWithMaxConstantArgs; - property DeviceWithMaxConstantBufferSize: TDCLDevice - read GetDeviceWithMaxConstantBufferSize; - property DeviceWithMaxMemAllocSize: TDCLDevice - read GetDeviceWithMaxMemAllocSize; - property DeviceWithMaxParameterSize: TDCLDevice - read GetDeviceWithMaxParameterSize; - property DeviceWithMaxReadImageArgs: TDCLDevice - read GetDeviceWithMaxReadImageArgs; - property DeviceWithMaxSamplers: TDCLDevice read GetDeviceWithMaxSamplers; - property DeviceWithMaxWorkGroupSize: TDCLDevice - read GetDeviceWithMaxWorkGroupSize; - property DeviceWithMaxWorkItemDimensions: TDCLDevice - read GetDeviceWithMaxWorkItemDimensions; - property DeviceWithMaxWriteImageArgs: TDCLDevice - read GetDeviceWithMaxWriteImageArgs; - procedure Free(); - end; - - TDCLPlatforms = class - private - FPlatforms: Array of TDCLPlatform; - FPlatformCount: CL_uint; - FStatus: CL_int; - function GetPlatform(Index: CL_uint): TDCLPlatform; - public - constructor Create(); - property PlatformCount: CL_uint read FPlatformCount; - property Status: CL_int read FStatus; - property Platforms[Index: CL_uint]: TDCLPlatform read GetPlatform; - procedure Free(); - end; - -implementation - -function UpperCase(const S: AnsiString): AnsiString; -var - Ch: AnsiChar; - L: Integer; - Source, Dest: PAnsiChar; -begin - L := Length(S); - SetLength(Result, L); - Source := Pointer(S); - Dest := Pointer(Result); - while L <> 0 do - begin - Ch := Source^; - if (Ch >= 'a') and (Ch <= 'z') then - Dec(Ch, 32); - Dest^ := Ch; - Inc(Source); - Inc(Dest); - Dec(L); - end; -end; - -function IntToStr(Value: Integer): AnsiString; -begin - Str(Value, Result); -end; - -{ TDCLPlatforms } - -constructor TDCLPlatforms.Create; -var - Platforms: Array of PCL_platform_id; - i: Integer; -begin - FStatus := clGetPlatformIDs(0, nil, @FPlatformCount); - if FStatus = CL_SUCCESS then - begin - if FPlatformCount > 0 then - begin - SetLength(Platforms, FPlatformCount); - SetLength(FPlatforms, FPlatformCount); - FStatus := clGetPlatformIDs(FPlatformCount, @Platforms[0], nil); - for i := 0 to FPlatformCount - 1 do - begin - FPlatforms[i] := TDCLPlatform.Create(Platforms[i]); - end; - SetLength(Platforms, 0); - end; - end; -end; - -procedure TDCLPlatforms.Free; -var - i: Integer; -begin - for i := 0 to FPlatformCount - 1 do - begin - FPlatforms[i].Free(); - end; - SetLength(FPlatforms, 0); - inherited Free(); -end; - -function TDCLPlatforms.GetPlatform(Index: CL_uint): TDCLPlatform; -begin - if (Index < FPlatformCount) then - Result := FPlatforms[Index] - else - Result := nil; -end; - -{ TDCLPlatform } - -constructor TDCLPlatform.Create(Platform_id: PCL_platform_id); -var - Size: Size_t; - Devices: Array of PCL_device_id; - i, current, previous: Integer; - -begin - inherited Create(); - FPlatform_id := Platform_id; - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_PROFILE, 0, nil, Size); - SetLength(FProfile, Size); - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_PROFILE, Size, - @FProfile[1], Size); - // FProfile := Buffer; - - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VERSION, 0, nil, Size); - SetLength(FVersion, Size); - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VERSION, Size, - @FVersion[1], Size); - SetLength(FName, Size); - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_NAME, Size, - @FName[1], Size); - SetLength(FVendor, Size); - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VENDOR, Size, - @FVendor[1], Size); - SetLength(FExtensionsString, Size); - FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_EXTENSIONS, Size, - @FExtensionsString[1], Size); - FExtensionsCount := 0; - i := 1; - while (i <= Length(FExtensionsString)) do - begin - if ((FExtensionsString[i] = ' ') or (FExtensionsString[i] = #0)) then - Inc(FExtensionsCount); - Inc(i); - end; - SetLength(FExtensions, FExtensionsCount); - previous := 1; - current := 1; - i := 0; - while (current <= Length(FExtensionsString)) do - begin - if ((FExtensionsString[current] = ' ') or (FExtensionsString[current] = #0)) - then - begin - FExtensions[i] := UpperCase(Copy(FExtensionsString, previous, - current - previous - 1)); - previous := current + 1; - Inc(i); - end; - Inc(current); - end; - - FStatus := clGetDeviceIDs(FPlatform_id, CL_DEVICE_TYPE_ALL, 0, nil, - @FDeviceCount); - if FDeviceCount > 0 then - begin - SetLength(Devices, FDeviceCount); - FStatus := clGetDeviceIDs(FPlatform_id, CL_DEVICE_TYPE_ALL, FDeviceCount, - @Devices[0], nil); - SetLength(FDevices, FDeviceCount); - for i := 0 to FDeviceCount - 1 do - begin - FDevices[i] := TDCLDevice.Create(Devices[i]); - end; - end; - -end; - -procedure TDCLPlatform.Free; -var - i: Integer; -begin - SetLength(FExtensions, 0); - FExtensionsString := ''; - for i := 0 to FDeviceCount - 1 do - begin - FDevices[i].Free(); - end; - SetLength(FDevices, 0); - inherited Free(); -end; - -function TDCLPlatform.GetDevice(Index: CL_uint): TDCLDevice; -begin - if (Index < FDeviceCount) then - Result := FDevices[Index] - else - Result := nil; -end; - -function TDCLPlatform.GetDeviceWithMaxClockFrequency: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxClockFrequency; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxComputeUnits: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxComputeUnits; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxConstantArgs: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxConstantArgs; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxConstantBufferSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_ulong; - begin - Result := Device.MaxConstantBufferSize; - end; - -var - i: Integer; - MaxValue: CL_ulong; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxGlobalMemCacheLineSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.GlobalMemCacheLineSize; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxGlobalMemCacheSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_ulong; - begin - Result := Device.GlobalMemCacheSize; - end; - -var - i: Integer; - MaxValue: CL_ulong; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxGlobalMemSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_ulong; - begin - Result := Device.GlobalMemSize; - end; - -var - i: Integer; - MaxValue: CL_ulong; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxImage2DHeight: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.Image2DMaxHeight; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxImage2DWidth: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.Image2DMaxWidth; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxImage3DDepth: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.Image3DMaxDepth; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxImage3DHeight: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.Image3DMaxHeight; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxImage3DWidth: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.Image3DMaxWidth; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxLocalMemSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_ulong; - begin - Result := Device.LocalMemSize; - end; - -var - i: Integer; - MaxValue: CL_ulong; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxMemAllocSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_ulong; - begin - Result := Device.MaxMemAllocSize; - end; - -var - i: Integer; - MaxValue: CL_ulong; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxParameterSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.MaxParameterSize; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxReadImageArgs: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxReadImageArgs; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxSamplers: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxSamplers; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxWorkGroupSize: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): Size_t; - begin - Result := Device.MaxWorkGroupSize; - end; - -var - i: Integer; - MaxValue: Size_t; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxWorkItemDimensions: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxWorkItemDimensions; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetDeviceWithMaxWriteImageArgs: TDCLDevice; - function GetParameterDevice(const Device: TDCLDevice): CL_uint; - begin - Result := Device.MaxWriteImageArgs; - end; - -var - i: Integer; - MaxValue: CL_uint; - MaxValuePos: CL_uint; -begin - if FDeviceCount = 0 then - begin - Result := nil; - Exit; - end; - MaxValue := GetParameterDevice(FDevices[0]); - MaxValuePos := 0; - for i := 1 to FDeviceCount - 1 do - begin - if GetParameterDevice(FDevices[i]) > MaxValue then - begin - MaxValue := GetParameterDevice(FDevices[i]); - MaxValuePos := i; - end; - end; - Result := FDevices[MaxValuePos]; -end; - -function TDCLPlatform.GetExtensions(Index: Size_t): AnsiString; -begin - if Index < FExtensionsCount then - Result := FExtensions[Index] - else - Result := ''; -end; - -function TDCLPlatform.IsPresentExtension(const ExtensionName - : AnsiString): Boolean; -var - i: Integer; - UppName: AnsiString; -begin - Result := False; - UppName := UpperCase(ExtensionName); - for i := 0 to High(FExtensions) do - begin - if FExtensions[i] = UppName then - begin - Result := True; - Break; - end; - end; -end; - -{ TDCLDevice } - -constructor TDCLDevice.Create(Device_Id: PCL_device_id); -(* - need to add - CL_DEVICE_TYPE - CL_DEVICE_MAX_WORK_ITEM_SIZES - CL_DEVICE_SINGLE_FP_CONFIG - CL_DEVICE_GLOBAL_MEM_CACHE_TYPE - CL_DEVICE_GLOBAL_MEM_CACHE_TYPE - CL_DEVICE_EXECUTION_CAPABILITIES - CL_DEVICE_QUEUE_PROPERTIES -*) - -var - Size: Size_t; - device_type: CL_device_type; - b_bool: CL_bool; - - i, current, previous: Integer; -begin - inherited Create(); - FDevice_id := Device_Id; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NAME, 0, nil, Size); - SetLength(FName, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NAME, Size, @FName[1], Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR, 0, nil, Size); - SetLength(FVendor, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR, Size, - @FVendor[1], Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VERSION, 0, nil, Size); - SetLength(FVersion, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VERSION, Size, - @FVersion[1], Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILE, 0, nil, Size); - SetLength(FProfile, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILE, Size, - @FProfile[1], Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_TYPE_INFO, - SizeOf(device_type), @device_type, Size); - if (device_type and CL_DEVICE_TYPE_CPU) <> 0 then - FIsCPU := True; - if (device_type and CL_DEVICE_TYPE_GPU) <> 0 then - FIsGPU := True; - if (device_type and CL_DEVICE_TYPE_ACCELERATOR) <> 0 then - FIsAccelerator := True; - if (device_type and CL_DEVICE_TYPE_DEFAULT) <> 0 then - FIsDefault := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR, - SizeOf(FMaxWorkGroupSize), @FMaxWorkGroupSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR, - SizeOf(FNativeVectorPreferredChar), @FNativeVectorPreferredChar, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT, - SizeOf(FNativeVectorPreferredShort), @FNativeVectorPreferredShort, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT, - SizeOf(FNativeVectorPreferredInt), @FNativeVectorPreferredInt, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG, - SizeOf(FNativeVectorPreferredLong), @FNativeVectorPreferredLong, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT, - SizeOf(FNativeVectorPreferredFloat), @FNativeVectorPreferredFloat, Size); - FStatus := clGetDeviceInfo(FDevice_id, - CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE, - SizeOf(FNativeVectorPreferredDouble), @FNativeVectorPreferredDouble, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF, - SizeOf(FNativeVectorPreferredHalf), @FNativeVectorPreferredHalf, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR, - SizeOf(FNativeVectorWidthChar), @FNativeVectorWidthChar, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT, - SizeOf(FNativeVectorWidthShort), @FNativeVectorWidthShort, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_INT, - SizeOf(FNativeVectorWidthInt), @FNativeVectorWidthInt, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG, - SizeOf(FNativeVectorWidthLong), @FNativeVectorWidthLong, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT, - SizeOf(FNativeVectorWidthFloat), @FNativeVectorWidthFloat, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE, - SizeOf(FNativeVectorWidthDouble), @FNativeVectorWidthDouble, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF, - SizeOf(FNativeVectorWidthHalf), @FNativeVectorWidthHalf, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CLOCK_FREQUENCY, - SizeOf(FMaxClockFrequency), @FMaxClockFrequency, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ADDRESS_BITS, - SizeOf(FAddressBits), @FAddressBits, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_MEM_ALLOC_SIZE, - SizeOf(FMaxMemAllocSize), @FMaxMemAllocSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE_SUPPORT, - SizeOf(b_bool), @b_bool, Size); - if b_bool <> 0 then - FIsImageSupport := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_READ_IMAGE_ARGS, - SizeOf(FMaxReadImageArgs), @FMaxReadImageArgs, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_WRITE_IMAGE_ARGS, - SizeOf(FMaxWriteImageArgs), @FMaxWriteImageArgs, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE2D_MAX_WIDTH, - SizeOf(FImage2DMaxWidth), @FImage2DMaxWidth, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE2D_MAX_HEIGHT, - SizeOf(FImage2DMaxHeight), @FImage2DMaxHeight, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_WIDTH, - SizeOf(FImage3DMaxWidth), @FImage3DMaxWidth, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_HEIGHT, - SizeOf(FImage3DMaxHeight), @FImage3DMaxHeight, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_DEPTH, - SizeOf(FImage3DMaxDepth), @FImage3DMaxDepth, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_SAMPLERS, - SizeOf(FMaxSamplers), @FMaxSamplers, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_PARAMETER_SIZE, - SizeOf(FMaxParameterSize), @FMaxParameterSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MEM_BASE_ADDR_ALIGN, - SizeOf(FMemBaseAddrAlign), @FMemBaseAddrAlign, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE, - SizeOf(FMinDataTypeAlignSize), @FMinDataTypeAlignSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE, - SizeOf(FGlobalMemCacheLineSize), @FGlobalMemCacheLineSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_CACHE_SIZE, - SizeOf(FGlobalMemCacheSize), @FGlobalMemCacheSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_SIZE, - SizeOf(FGlobalMemSize), @FGlobalMemSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE, - SizeOf(FMaxConstantBufferSize), @FMaxConstantBufferSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CONSTANT_ARGS, - SizeOf(FMaxConstantArgs), @FMaxConstantArgs, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_LOCAL_MEM_SIZE, - SizeOf(FLocalMemSize), @FLocalMemSize, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE, - SizeOf(b_bool), @b_bool, Size); - if b_bool <> 0 then - FIsErrorCorrectionSupport := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE, - SizeOf(b_bool), @b_bool, Size); - if b_bool <> 0 then - FIsHostUnifiedMemory := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILING_TIMER_RESOLUTION, - SizeOf(FProfilingTimerResolution), @FProfilingTimerResolution, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE, - SizeOf(b_bool), @b_bool, Size); - if b_bool <> 0 then - FIsEndianLittle := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_AVAILABLE, SizeOf(b_bool), - @b_bool, Size); - if b_bool <> 0 then - FIsAvailable := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_COMPILER_AVAILABLE, - SizeOf(b_bool), @b_bool, Size); - if b_bool <> 0 then - FIsCompilerAvailable := True; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR_ID, SizeOf(FVendorId), - @FVendorId, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_COMPUTE_UNITS, - SizeOf(FMaxComputeUnits), @FMaxComputeUnits, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS, - SizeOf(FMaxWorkItemDimensions), @FMaxWorkItemDimensions, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_EXTENSIONS, 0, nil, Size); - SetLength(FExtensionsString, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_EXTENSIONS, Size, - @FExtensionsString[1], Size); - FExtensionsCount := 0; - i := 1; - while (i <= Length(FExtensionsString)) do - begin - if ((FExtensionsString[i] = ' ') or (FExtensionsString[i] = #0)) then - begin - if (i > 1) then - begin - if ((FExtensionsString[i - 1] <> ' ') and - (FExtensionsString[i - 1] <> #0)) then - begin - Inc(FExtensionsCount); - end; - end - else - Inc(FExtensionsCount); - end; - Inc(i); - end; - SetLength(FExtensions, FExtensionsCount); - previous := 1; - current := 1; - i := 0; - while (current <= Length(FExtensionsString)) do - begin - if ((FExtensionsString[current] = AnsiString(' ')) or - (FExtensionsString[current] = #0)) then - begin - if (current > previous) then - FExtensions[i] := UpperCase(Copy(FExtensionsString, previous, - current - previous - 1)); - previous := current + 1; - Inc(i); - end; - Inc(current); - end; - - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_OPENCL_C_VERSION, 0, - nil, Size); - SetLength(FOpenCLCVersion, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_OPENCL_C_VERSION, Size, - @FOpenCLCVersion[1], Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DRIVER_VERSION, 0, nil, Size); - SetLength(FDriverVersion, Size); - FStatus := clGetDeviceInfo(FDevice_id, CL_DRIVER_VERSION, Size, - @FDriverVersion[1], Size); - FContext := TDCLContext.Create(FDevice_id); -end; - -function TDCLDevice.CreateBuffer(const Size: Size_t; const Data: Pointer; - const Flags: TDCLMemFlagsSet): TDCLBuffer; -begin - Result := TDCLBuffer.Create(Context.FContext, Flags, Size, Data); -end; - -function TDCLDevice.CreateCommandQueue(const Properties - : TDCLCommandQueuePropertiesSet): TDCLCommandQueue; -begin - Result := TDCLCommandQueue.Create(Device_Id, Context.FContext, Properties); -end; - -function TDCLDevice.CreateContext: TDCLContext; -begin - Result := TDCLContext.Create(FDevice_id); -end; - -function TDCLDevice.CreateProgram(const Source: PPChar; const Options: PPChar) - : TDCLProgram; -begin - Result := TDCLProgram.Create(FContext.FContext, Source, Options); -end; - -function TDCLDevice.CreateImage2D(const Format: PCL_image_format; - const Width, Height, RowPitch: Size_t; const Data: Pointer; - const Flags: TDCLMemFlagsSet): TDCLImage2D; -begin - Result := TDCLImage2D.Create(Context.FContext, Flags, Format, Width, Height, - RowPitch, Data); -end; - -function TDCLDevice.CreateProgram(const FileName: String; const Options: PPChar) - : TDCLProgram; -var - F: TextFile; - Source: String; - buf: String; -begin - AssignFile(F, FileName); - Reset(F); - Source := ''; - while not(EOF(F)) do - begin - Readln(F, buf); - Source := Source + buf + #10 + #13; - end; - CloseFile(F); - Result := CreateProgram(@PString(Source), Options); -end; - -procedure TDCLDevice.Free; -begin - FContext.Free(); - SetLength(FExtensions, 0); - FExtensionsString := ''; - inherited Free(); -end; - -function TDCLDevice.GetExtensions(const Index: Size_t): AnsiString; -begin - if Index < FExtensionsCount then - Result := FExtensions[Index] - else - Result := ''; -end; - -function TDCLDevice.IsPresentExtension(const ExtensionName: AnsiString) - : Boolean; -var - i: Integer; - UppName: AnsiString; -begin - Result := False; - UppName := UpperCase(ExtensionName); - for i := 0 to High(FExtensions) do - begin - if FExtensions[i] = UppName then - begin - Result := True; - Break; - end; - end; -end; - -{ TDCLContext } - -constructor TDCLContext.Create(Device_Id: PCL_device_id); -(* - CL_CONTEXT_REFERENCE_COUNT - CL_CONTEXT_DEVICES - CL_CONTEXT_PROPERTIES -*) -var - Size: Size_t; -begin - inherited Create(); - FContext := clCreateContext(nil, 1, @Device_Id, nil, nil, FStatus); - FStatus := clGetContextInfo(FContext, CL_CONTEXT_NUM_DEVICES, - SizeOf(FNumDevices), @FNumDevices, Size); -end; - -{ TDCLQueue } - -constructor TDCLCommandQueue.Create(const Device_Id: PCL_device_id; - const Context: PCL_context; const Properties: TDCLCommandQueuePropertiesSet); -var - props: CL_command_queue_properties; -begin - props := 0; - if cqpOutOfOrderExecModeEnable in Properties then - props := props or CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE; - FCommandQueue := clCreateCommandQueue(Context, Device_Id, props, FStatus); - FProperties := Properties; -end; - -procedure TDCLContext.Free; -begin - FStatus := clReleaseContext(FContext); - inherited Free(); -end; - -{ TDCLBuffer } - -constructor TDCLBuffer.Create(const Context: PCL_context; - const Flags: TDCLMemFlagsSet; const Size: Size_t; const Data: Pointer = nil); -var - fgs: CL_mem_flags; -begin - inherited Create(); - fgs := 0; - if mfReadWrite in Flags then - fgs := fgs or CL_MEM_READ_WRITE; - if mfWriteOnly in Flags then - fgs := fgs or CL_MEM_WRITE_ONLY; - if mfReadOnly in Flags then - fgs := fgs or CL_MEM_READ_ONLY; - if mfUseHostPtr in Flags then - fgs := fgs or CL_MEM_USE_HOST_PTR; - if mfAllocHostPtr in Flags then - fgs := fgs or CL_MEM_ALLOC_HOST_PTR; - if mfCopyHostPtr in Flags then - fgs := fgs or CL_MEM_COPY_HOST_PTR; - FMem := clCreateBuffer(Context, fgs, Size, Data, FStatus); - FSize := Size; -end; - -procedure TDCLBuffer.Free; -begin - FStatus := clReleaseMemObject(FMem); - inherited Free; -end; - -procedure TDCLCommandQueue.Execute(const Kernel: TDCLKernel; - const Size: Size_t); -begin - FStatus := clEnqueueNDRangeKernel(FCommandQueue, Kernel.FKernel, 1, nil, - @Size, nil, 0, nil, nil); - FStatus := clFinish(FCommandQueue); -end; - -procedure TDCLCommandQueue.Execute(const Kernel: TDCLKernel; - // const Device: PCL_device_id; - const Size: array of Size_t); -// var -// kernel2DWorkGroupSize: Size_t; -begin - // FStatus := clGetKernelWorkGroupInfo(Kernel.FKernel, Device, CL_KERNEL_WORK_GROUP_SIZE, SizeOf(Size_t), @kernel2DWorkGroupSize, nil); - FStatus := clEnqueueNDRangeKernel(FCommandQueue, Kernel.FKernel, Length(Size), - nil, @Size[0], nil, 0, nil, nil); - FStatus := clFinish(FCommandQueue); -end; - -procedure TDCLCommandQueue.Free; -begin - FStatus := clReleaseCommandQueue(FCommandQueue); - inherited Free(); -end; - -{ TDCLProgram } - -constructor TDCLProgram.Create(const Context: PCL_context; const Source: PPChar; - const Options: PPChar); -var - Size: Size_t; - // FBinaries: Array of Char; -begin - FProgram := clCreateProgramWithSource(Context, 1, Source, nil, FStatus); - FStatus := clBuildProgram(FProgram, 0, nil, Options^, nil, nil); - FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_SOURCE, 0, nil, Size); - FSource := GetMemory(Size); - FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_SOURCE, Size, FSource, Size); - FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_BINARY_SIZES, 0, nil, - FBinarySizesCount); - SetLength(FBinarySizes, FBinarySizesCount); - FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_BINARY_SIZES, - SizeOf(FBinarySizes), @FBinarySizes[0], FBinarySizesCount); - (* //Not yet - FStatus := clGetProgramInfo(FProgram,CL_PROGRAM_BINARIES,0,nil,@Size); - SetLength(FBinaries,Size); - FStatus := clGetProgramInfo(FProgram,CL_PROGRAM_BINARIES,Size,@FBinaries[0],nil); - Writeln(String(FBinaries)); - *) - -end; - -function TDCLProgram.CreateKernel(const KernelName: PPChar): TDCLKernel; -begin - Result := TDCLKernel.Create(FProgram, KernelName); -end; - -procedure TDCLProgram.Free; -begin - FStatus := clReleaseProgram(FProgram); - FSource := ''; - SetLength(FBinarySizes, 0); - inherited Free; -end; - -function TDCLProgram.GetBinarySizes(const Index: Size_t): Size_t; -begin - if (Index < FBinarySizesCount) then - Result := FBinarySizes[Index] - else - Result := 0; -end; - -{ TDCLKernel } - -constructor TDCLKernel.Create(const Program_: PCL_program; - const KernelName: PPChar); -begin - FKernel := clCreateKernel(Program_, KernelName^, FStatus); -end; - -procedure TDCLKernel.Free; -begin - FStatus := clReleaseKernel(FKernel); - inherited Free(); -end; - -function TDCLKernel.GetFunctionName: AnsiString; -var - Size: Size_t; - Buffer: Array of AnsiChar; -begin - FStatus := clGetKernelInfo(FKernel, CL_KERNEL_FUNCTION_NAME, 0, nil, Size); - SetLength(Buffer, Size); - FStatus := clGetKernelInfo(FKernel, CL_KERNEL_FUNCTION_NAME, Size, - @Buffer[0], Size); - Result := AnsiString(Buffer); - SetLength(Buffer, 0); -end; - -function TDCLKernel.GetNumArgs: CL_uint; -var - Size: Size_t; -begin - FStatus := clGetKernelInfo(FKernel, CL_KERNEL_NUM_ARGS, SizeOf(Result), - @Result, Size); -end; - -procedure TDCLKernel.SetArg(const Index: CL_uint; const Size: Size_t; - const Value: Pointer); -begin - FStatus := clSetKernelArg(FKernel, Index, Size, Value); -end; - -procedure TDCLKernel.SetArg(const Index: CL_uint; const Value: TDCLBuffer); -begin - SetArg(Index, SizeOf(@Value.FMem), @Value.FMem); -end; - -procedure TDCLKernel.SetArg(const Index: CL_uint; const Value: TDCLImage2D); -begin - SetArg(Index, SizeOf(@Value.FMem), @Value.FMem); -end; - -procedure TDCLCommandQueue.ReadBuffer(const Buffer: TDCLBuffer; - const Size: Size_t; const Data: Pointer); -begin - FStatus := clEnqueueReadBuffer(FCommandQueue, Buffer.FMem, CL_TRUE, 0, Size, - Data, 0, nil, nil); - clFinish(FCommandQueue); -end; - -procedure TDCLCommandQueue.ReadImage2D(const Image: TDCLImage2D; - const Width, Height: Size_t; const Data: Pointer); -var - origin, region: Array [0 .. 2] of Size_t; -begin - ZeroMemory(@origin, SizeOf(origin)); - region[0] := Width; - region[1] := Height; - region[2] := 1; // Image 2D - FStatus := clEnqueueReadImage(FCommandQueue, Image.FMem, CL_TRUE, @origin, - @region, 0, 0, Data, 0, nil, nil); - FStatus := clFinish(FCommandQueue); -end; - -procedure TDCLCommandQueue.WriteImage2D(const Image: TDCLImage2D; - const Width, Height: Size_t; const Data: Pointer); -var - origin, region: Array [0 .. 2] of Size_t; -begin - ZeroMemory(@origin, SizeOf(origin)); - region[0] := Width; - region[1] := Height; - region[2] := 1; // Image 2D - FStatus := clEnqueueWriteImage(FCommandQueue, Image.FMem, CL_TRUE, @origin, - @region, 0, 0, Data, 0, nil, nil); - FStatus := clFinish(FCommandQueue); -end; - -procedure TDCLCommandQueue.WriteBuffer(const Buffer: TDCLBuffer; - const Size: Size_t; const Data: Pointer); -begin - FStatus := clEnqueueWriteBuffer(FCommandQueue, Buffer.FMem, CL_TRUE, 0, Size, - Data, 0, nil, nil); -end; - -{ TDCLImage2D } - -constructor TDCLImage2D.Create(const Context: PCL_context; - const Flags: TDCLMemFlagsSet; const Format: PCL_image_format; - const Width, Height, RowPitch: Size_t; const Data: Pointer); -var - fgs: CL_mem_flags; -begin - inherited Create(); - fgs := 0; - if mfReadWrite in Flags then - fgs := fgs or CL_MEM_READ_WRITE; - if mfWriteOnly in Flags then - fgs := fgs or CL_MEM_WRITE_ONLY; - if mfReadOnly in Flags then - fgs := fgs or CL_MEM_READ_ONLY; - if mfUseHostPtr in Flags then - fgs := fgs or CL_MEM_USE_HOST_PTR; - if mfAllocHostPtr in Flags then - fgs := fgs or CL_MEM_ALLOC_HOST_PTR; - if mfCopyHostPtr in Flags then - fgs := fgs or CL_MEM_COPY_HOST_PTR; - FFormat := Format^; - FMem := clCreateImage2D(Context, fgs, @FFormat, Width, Height, RowPitch, - Data, FStatus); -end; - -procedure TDCLImage2D.Free; -begin - FStatus := clReleaseMemObject(FMem); - inherited Free(); -end; - -end. diff --git a/contrib/opencl/OpenCL.pas b/contrib/opencl/OpenCL.pas deleted file mode 100644 index e1413fb..0000000 --- a/contrib/opencl/OpenCL.pas +++ /dev/null @@ -1,1032 +0,0 @@ -(* ****************************************************************************** - * Copyright (c) 2008-2009 The Khronos Group Inc. - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and/or associated documentation files (the - * "Materials"), to deal in the Materials without restriction, including - * without limitation the rights to use, copy, modify, merge, publish, - * distribute, sublicense, and/or sell copies of the Materials, and to - * permit persons to whom the Materials are furnished to do so, subject to - * the following conditions: - * - * The above copyright notice and this permission notice shall be included - * in all copies or substantial portions of the Materials. - * - * THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, - * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF - * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. - * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY - * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, - * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE - * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS. - ***************************************************************************** *) - -// ported to FPC by Dmitry 'skalogryz' Boyarintsev: 28th apr 2009 -// due to name conflict with type names, some constants have been renamed - -// Original C name Ported_name -// CL_DEVICE_TYPE CL_DEVICE_TYPE_INFO -// CL_DEVICE_LOCAL_MEM_TYPE CL_DEVICE_LOCAL_MEM_TYPE_INFO -// CL_CONTEXT_PROPERTIES CL_CONTEXT_PROPERTIES_INFO -// CL_CONTEXT_PLATFORM CL_CONTEXT_PLATFORM_INFO -// CL_FLOAT CL_FLOAT_TYPE -// CL_MEM_FLAGS CL_MEM_FLAGS_INFO -// CL_IMAGE_FORMAT CL_IMAGE_FORMAT_INFO - -unit OpenCL; - -interface - -uses - Windows; - -const - OpenCLlib = 'OpenCL.dll'; - - { cl_platform.h } - -const - CL_PLATFORM_NVIDIA = $3001; // NVidia specific platform value - - { * scalar types * } - -type - cl_char = int8; - cl_uchar = uint8; - cl_short = int16; - cl_ushort = uint16; - cl_int = int32; - cl_uint = uint32; - cl_long = int64; - cl_ulong = uint64; - - cl_half = uint16; - cl_float = single; - cl_double = double; - - Pcl_char = ^cl_char; - Pcl_uchar = ^cl_uchar; - Pcl_short = ^cl_short; - Pcl_ushort = ^cl_ushort; - Pcl_int = ^cl_int; - Pcl_uint = ^cl_uint; - Pcl_long = ^cl_long; - Pcl_ulong = ^cl_ulong; - - Pcl_half = ^cl_half; - Pcl_float = ^cl_float; - Pcl_double = ^cl_double; - -const - CL_CHAR_BIT = 8; - CL_SCHAR_MAX = 127; - CL_SCHAR_MIN = (-127 - 1); - CL_CHAR_MAX = CL_SCHAR_MAX; - CL_CHAR_MIN = CL_SCHAR_MIN; - CL_UCHAR_MAX = 255; - CL_SHRT_MAX = 32767; - CL_SHRT_MIN = (-32767 - 1); - CL_USHRT_MAX = 65535; - CL_INT_MAX = 2147483647; - CL_INT_MIN = (-2147483647 - 1); - CL_UINT_MAX = $FFFFFFFF; - CL_LONG_MAX = $7FFFFFFFFFFFFFFF; - CL_LONG_MIN = -$7FFFFFFFFFFFFFFF - 1; - CL_ULONG_MAX = $FFFFFFFFFFFFFFFF; - - CL_FLT_DIG = 6; - CL_FLT_MANT_DIG = 24; - CL_FLT_MAX_10_EXP = +38; - CL_FLT_MAX_EXP = +128; - CL_FLT_MIN_10_EXP = -37; - CL_FLT_MIN_EXP = -125; - CL_FLT_RADIX = 2; - // CL_FLT_MAX = 0x1.fffffep127f; - // CL_FLT_MIN = 0x1.0p-126f; - // CL_FLT_EPSILON = 0x1.0p-23f; - - CL_DBL_DIG = 15; - CL_DBL_MANT_DIG = 53; - CL_DBL_MAX_10_EXP = +308; - CL_DBL_MAX_EXP = +1024; - CL_DBL_MIN_10_EXP = -307; - CL_DBL_MIN_EXP = -1021; - CL_DBL_RADIX = 2; - // CL_DBL_MAX 0x1.fffffffffffffp1023 - // CL_DBL_MIN 0x1.0p-1022 - // CL_DBL_EPSILON 0x1.0p-52 - - { * - * Vector types - * - * Note: OpenCL requires that all types be naturally aligned. - * This means that vector types must be naturally aligned. - * For example, a vector of four floats must be aligned to - * a 16 byte boundary (calculated as 4 * the natural 4-byte - * alignment of the float). The alignment qualifiers here - * will only function properly if your compiler supports them - * and if you don't actively work to defeat them. For example, - * in order for a cl_float4 to be 16 byte aligned in a struct, - * the start of the struct must itself be 16-byte aligned. - * - * Maintaining proper alignment is the user's responsibility. - * } -type - cl_char2 = array [0 .. 1] of int8; - cl_char4 = array [0 .. 3] of int8; - cl_char8 = array [0 .. 7] of int8; - cl_char16 = array [0 .. 15] of int8; - - cl_uchar2 = array [0 .. 1] of uint8; - cl_uchar4 = array [0 .. 3] of uint8; - cl_uchar8 = array [0 .. 7] of uint8; - cl_uchar16 = array [0 .. 15] of uint8; - - cl_short2 = array [0 .. 1] of int16; - cl_short4 = array [0 .. 3] of int16; - cl_short8 = array [0 .. 7] of int16; - cl_short16 = array [0 .. 15] of int16; - - cl_ushort2 = array [0 .. 1] of uint16; - cl_ushort4 = array [0 .. 3] of uint16; - cl_ushort8 = array [0 .. 7] of uint16; - cl_ushort16 = array [0 .. 15] of uint16; - - cl_int2 = array [0 .. 1] of int32; - cl_int4 = array [0 .. 3] of int32; - cl_int8 = array [0 .. 7] of int32; - cl_int16 = array [0 .. 15] of int32; - - cl_uint2 = array [0 .. 1] of uint32; - cl_uint4 = array [0 .. 3] of uint32; - cl_uint8 = array [0 .. 7] of uint32; - cl_uint16 = array [0 .. 15] of uint32; - - cl_long2 = array [0 .. 1] of int64; - cl_long4 = array [0 .. 3] of int64; - cl_long8 = array [0 .. 7] of int64; - cl_long16 = array [0 .. 15] of int64; - - cl_ulong2 = array [0 .. 1] of uint64; - cl_ulong4 = array [0 .. 3] of uint64; - cl_ulong8 = array [0 .. 7] of uint64; - cl_ulong16 = array [0 .. 15] of uint64; - - cl_float2 = array [0 .. 1] of single; - cl_float4 = array [0 .. 3] of single; - cl_float8 = array [0 .. 7] of single; - cl_float16 = array [0 .. 15] of single; - - cl_double2 = array [0 .. 1] of double; - cl_double4 = array [0 .. 3] of double; - cl_double8 = array [0 .. 7] of double; - cl_double16 = array [0 .. 15] of double; - - { * There are no vector types for half * } - - // **************************************************************************** - - { cl.h } - -type - _cl_platform_id = record - end; - - _cl_device_id = record - end; - - _cl_context = record - end; - - _cl_command_queue = record - end; - - _cl_mem = record - end; - - _cl_program = record - end; - - _cl_kernel = record - end; - - _cl_event = record - end; - - _cl_sampler = record - end; - - cl_platform_id = ^_cl_platform_id; - cl_device_id = ^_cl_device_id; - cl_context = ^_cl_context; - cl_command_queue = ^_cl_command_queue; - cl_mem = ^_cl_mem; - cl_program = ^_cl_program; - cl_kernel = ^_cl_kernel; - cl_event = ^_cl_event; - cl_sampler = ^_cl_sampler; - - Pcl_platform_id = cl_platform_id; - Pcl_device_id = cl_device_id; - Pcl_context = cl_context; - Pcl_command_queue = cl_command_queue; - Pcl_mem = cl_mem; - Pcl_program = cl_program; - Pcl_kernel = cl_kernel; - Pcl_event = cl_event; - Pcl_sampler = cl_sampler; - - cl_bool = cl_uint; - // WARNING! Unlike cl_ types in cl_platform.h, cl_bool is not guaranteed to be the same size as the bool in kernels. - cl_bitfield = cl_ulong; - cl_device_type = cl_bitfield; - cl_platform_info = cl_uint; - cl_device_info = cl_uint; - cl_device_address_info = cl_bitfield; - cl_device_fp_config = cl_bitfield; - cl_device_mem_cache_type = cl_uint; - cl_device_local_mem_type = cl_uint; - cl_device_exec_capabilities = cl_bitfield; - cl_command_queue_properties = cl_bitfield; - - cl_context_properties = intptr; - cl_context_info = cl_uint; - cl_command_queue_info = cl_uint; - cl_channel_order = cl_uint; - cl_channel_type = cl_uint; - cl_mem_flags = cl_bitfield; - cl_mem_object_type = cl_uint; - cl_mem_info = cl_uint; - cl_image_info = cl_uint; - cl_addressing_mode = cl_uint; - cl_filter_mode = cl_uint; - cl_sampler_info = cl_uint; - cl_map_flags = cl_bitfield; - cl_program_info = cl_uint; - cl_program_build_info = cl_uint; - cl_build_status = cl_int; - cl_kernel_info = cl_uint; - cl_kernel_work_group_info = cl_uint; - cl_event_info = cl_uint; - cl_command_type = cl_uint; - cl_profiling_info = cl_uint; - - _cl_image_format = packed record - image_channel_order: cl_channel_order; - image_channel_data_type: cl_channel_type; - end; - - cl_image_format = _cl_image_format; - - Pcl_context_properties = ^cl_context_properties; - Pcl_image_format = ^cl_image_format; - -const - // Error Codes - CL_SUCCESS = 0; - CL_DEVICE_NOT_FOUND = -1; - CL_DEVICE_NOT_AVAILABLE = -2; - CL_DEVICE_COMPILER_NOT_AVAILABLE = -3; - CL_MEM_OBJECT_ALLOCATION_FAILURE = -4; - CL_OUT_OF_RESOURCES = -5; - CL_OUT_OF_HOST_MEMORY = -6; - CL_PROFILING_INFO_NOT_AVAILABLE = -7; - CL_MEM_COPY_OVERLAP = -8; - CL_IMAGE_FORMAT_MISMATCH = -9; - CL_IMAGE_FORMAT_NOT_SUPPORTED = -10; - CL_BUILD_PROGRAM_FAILURE = -11; - CL_MAP_FAILURE = -12; - - CL_INVALID_VALUE = -30; - CL_INVALID_DEVICE_TYPE = -31; - CL_INVALID_PLATFORM = -32; - CL_INVALID_DEVICE = -33; - CL_INVALID_CONTEXT = -34; - CL_INVALID_QUEUE_PROPERTIES = -35; - CL_INVALID_COMMAND_QUEUE = -36; - CL_INVALID_HOST_PTR = -37; - CL_INVALID_MEM_OBJECT = -38; - CL_INVALID_IMAGE_FORMAT_DESCRIPTOR = -39; - CL_INVALID_IMAGE_SIZE = -40; - CL_INVALID_SAMPLER = -41; - CL_INVALID_BINARY = -42; - CL_INVALID_BUILD_OPTIONS = -43; - CL_INVALID_PROGRAM = -44; - CL_INVALID_PROGRAM_EXECUTABLE = -45; - CL_INVALID_KERNEL_NAME = -46; - CL_INVALID_KERNEL_DEFINITION = -47; - CL_INVALID_KERNEL = -48; - CL_INVALID_ARG_INDEX = -49; - CL_INVALID_ARG_VALUE = -50; - CL_INVALID_ARG_SIZE = -51; - CL_INVALID_KERNEL_ARGS = -52; - CL_INVALID_WORK_DIMENSION = -53; - CL_INVALID_WORK_GROUP_SIZE = -54; - CL_INVALID_WORK_ITEM_SIZE = -55; - CL_INVALID_GLOBAL_OFFSET = -56; - CL_INVALID_EVENT_WAIT_LIST = -57; - CL_INVALID_EVENT = -58; - CL_INVALID_OPERATION = -59; - CL_INVALID_GL_OBJECT = -60; - CL_INVALID_BUFFER_SIZE = -61; - CL_INVALID_MIP_LEVEL = -62; - - // OpenCL Version - CL_VERSION_1_0 = 1; - - // cl_bool - CL_FALSE = 0; - CL_TRUE = 1; - - // cl_platform_info - CL_PLATFORM_PROFILE = $0900; - CL_PLATFORM_VERSION = $0901; - CL_PLATFORM_NAME = $0902; - CL_PLATFORM_VENDOR = $0903; - CL_PLATFORM_EXTENSIONS = $0904; - - // cl_device_type - bitfield - CL_DEVICE_TYPE_DEFAULT = (1 shl 0); - CL_DEVICE_TYPE_CPU = (1 shl 1); - CL_DEVICE_TYPE_GPU = (1 shl 2); - CL_DEVICE_TYPE_ACCELERATOR = (1 shl 3); - CL_DEVICE_TYPE_ALL = $FFFFFFFF; - - // cl_device_info - CL_DEVICE_TYPE_INFO = $1000; // CL_DEVICE_TYPE - CL_DEVICE_VENDOR_ID = $1001; - CL_DEVICE_MAX_COMPUTE_UNITS = $1002; - CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS = $1003; - CL_DEVICE_MAX_WORK_GROUP_SIZE = $1004; - CL_DEVICE_MAX_WORK_ITEM_SIZES = $1005; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR = $1006; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT = $1007; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT = $1008; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG = $1009; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT = $100A; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE = $100B; - CL_DEVICE_MAX_CLOCK_FREQUENCY = $100C; - CL_DEVICE_ADDRESS_BITS = $100D; - CL_DEVICE_MAX_READ_IMAGE_ARGS = $100E; - CL_DEVICE_MAX_WRITE_IMAGE_ARGS = $100F; - CL_DEVICE_MAX_MEM_ALLOC_SIZE = $1010; - CL_DEVICE_IMAGE2D_MAX_WIDTH = $1011; - CL_DEVICE_IMAGE2D_MAX_HEIGHT = $1012; - CL_DEVICE_IMAGE3D_MAX_WIDTH = $1013; - CL_DEVICE_IMAGE3D_MAX_HEIGHT = $1014; - CL_DEVICE_IMAGE3D_MAX_DEPTH = $1015; - CL_DEVICE_IMAGE_SUPPORT = $1016; - CL_DEVICE_MAX_PARAMETER_SIZE = $1017; - CL_DEVICE_MAX_SAMPLERS = $1018; - CL_DEVICE_MEM_BASE_ADDR_ALIGN = $1019; - CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE = $101A; - CL_DEVICE_SINGLE_FP_CONFIG = $101B; - CL_DEVICE_DOUBLE_FP_CONFIG = $1032; - CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF = $1034; - CL_DEVICE_HOST_UNIFIED_MEMORY = $1035; - CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR = $1036; - CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT = $1037; - CL_DEVICE_NATIVE_VECTOR_WIDTH_INT = $1038; - CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG = $1039; - CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT = $103A; - CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE = $103B; - CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF = $103C; - CL_DEVICE_OPENCL_C_VERSION = $103D; - CL_DEVICE_LINKER_AVAILABLE = $103E; - CL_DEVICE_BUILT_IN_KERNELS = $103F; - CL_DEVICE_IMAGE_MAX_BUFFER_SIZE = $1040; - CL_DEVICE_IMAGE_MAX_ARRAY_SIZE = $1041; - CL_DEVICE_PARENT_DEVICE = $1042; - CL_DEVICE_PARTITION_MAX_SUB_DEVICES = $1043; - CL_DEVICE_PARTITION_PROPERTIES = $1044; - CL_DEVICE_PARTITION_AFFINITY_DOMAIN = $1045; - CL_DEVICE_PARTITION_TYPE = $1046; - CL_DEVICE_REFERENCE_COUNT = $1047; - CL_DEVICE_PREFERRED_INTEROP_USER_SYNC = $1048; - CL_DEVICE_PRINTF_BUFFER_SIZE = $1049; - CL_DEVICE_GLOBAL_MEM_CACHE_TYPE = $101C; - CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE = $101D; - CL_DEVICE_GLOBAL_MEM_CACHE_SIZE = $101E; - CL_DEVICE_GLOBAL_MEM_SIZE = $101F; - CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE = $1020; - CL_DEVICE_MAX_CONSTANT_ARGS = $1021; - CL_DEVICE_LOCAL_MEM_TYPE_INFO = $1022; // CL_DEVICE_LOCAL_MEM_TYPE - CL_DEVICE_LOCAL_MEM_SIZE = $1023; - CL_DEVICE_ERROR_CORRECTION_SUPPORT = $1024; - CL_DEVICE_PROFILING_TIMER_RESOLUTION = $1025; - CL_DEVICE_ENDIAN_LITTLE = $1026; - CL_DEVICE_AVAILABLE = $1027; - CL_DEVICE_COMPILER_AVAILABLE = $1028; - CL_DEVICE_EXECUTION_CAPABILITIES = $1029; - CL_DEVICE_QUEUE_PROPERTIES = $102A; - CL_DEVICE_NAME = $102B; - CL_DEVICE_VENDOR = $102C; - CL_DRIVER_VERSION = $102D; - CL_DEVICE_PROFILE = $102E; - CL_DEVICE_VERSION = $102F; - CL_DEVICE_EXTENSIONS = $1030; - CL_DEVICE_PLATFORM = $1031; - - // cl_device_address_info - bitfield - CL_DEVICE_ADDRESS_32_BITS = (1 shl 0); - CL_DEVICE_ADDRESS_64_BITS = (1 shl 1); - - // cl_device_fp_config - bitfield - CL_FP_DENORM = (1 shl 0); - CL_FP_INF_NAN = (1 shl 1); - CL_FP_ROUND_TO_NEAREST = (1 shl 2); - CL_FP_ROUND_TO_ZERO = (1 shl 3); - CL_FP_ROUND_TO_INF = (1 shl 4); - CL_FP_FMA = (1 shl 5); - - // cl_device_mem_cache_type - CL_NONE = $0; - CL_READ_ONLY_CACHE = $1; - CL_READ_WRITE_CACHE = $2; - - // cl_device_local_mem_type - CL_LOCAL = $1; - CL_GLOBAL = $2; - - // cl_device_exec_capabilities - bitfield - CL_EXEC_KERNEL = (1 shl 0); - CL_EXEC_NATIVE_KERNEL = (1 shl 1); - - // cl_command_queue_properties - bitfield - CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE = (1 shl 0); - CL_QUEUE_PROFILING_ENABLE = (1 shl 1); - - // cl_context_info - CL_CONTEXT_REFERENCE_COUNT = $1080; - CL_CONTEXT_DEVICES = $1081; - CL_CONTEXT_PROPERTIES_INFO = $1082; // CL_CONTEXT_PROPERTIES - CL_CONTEXT_NUM_DEVICES = $1083; - CL_CONTEXT_PLATFORM_INFO = $1084; // CL_CONTEXT_PLATFORM - - // cl_command_queue_info - CL_QUEUE_CONTEXT = $1090; - CL_QUEUE_DEVICE = $1091; - CL_QUEUE_REFERENCE_COUNT = $1092; - CL_QUEUE_PROPERTIES = $1093; - - // cl_mem_flags - bitfield - CL_MEM_READ_WRITE = (1 shl 0); - CL_MEM_WRITE_ONLY = (1 shl 1); - CL_MEM_READ_ONLY = (1 shl 2); - CL_MEM_USE_HOST_PTR = (1 shl 3); - CL_MEM_ALLOC_HOST_PTR = (1 shl 4); - CL_MEM_COPY_HOST_PTR = (1 shl 5); - - // cl_channel_order - CL_R = $10B0; - CL_A = $10B1; - CL_RG = $10B2; - CL_RA = $10B3; - CL_RGB = $10B4; - CL_RGBA = $10B5; - CL_BGRA = $10B6; - CL_ARGB = $10B7; - CL_INTENSITY = $10B8; - CL_LUMINANCE = $10B9; - - // cl_channel_type - CL_SNORM_INT8 = $10D0; - CL_SNORM_INT16 = $10D1; - CL_UNORM_INT8 = $10D2; - CL_UNORM_INT16 = $10D3; - CL_UNORM_SHORT_565 = $10D4; - CL_UNORM_SHORT_555 = $10D5; - CL_UNORM_INT_101010 = $10D6; - CL_SIGNED_INT8 = $10D7; - CL_SIGNED_INT16 = $10D8; - CL_SIGNED_INT32 = $10D9; - CL_UNSIGNED_INT8 = $10DA; - CL_UNSIGNED_INT16 = $10DB; - CL_UNSIGNED_INT32 = $10DC; - CL_HALF_FLOAT = $10DD; - CL_FLOAT_TYPE = $10DE; // CL_FLOAT - - // cl_mem_object_type - CL_MEM_OBJECT_BUFFER = $10F0; - CL_MEM_OBJECT_IMAGE2D = $10F1; - CL_MEM_OBJECT_IMAGE3D = $10F2; - - // cl_mem_info - CL_MEM_TYPE = $1100; - CL_MEM_FLAGS_INFO = $1101; // CL_MEM_FLAGS - CL_MEM_SIZE = $1102; - CL_MEM_HOST_PTR = $1103; - CL_MEM_MAP_COUNT = $1104; - CL_MEM_REFERENCE_COUNT = $1105; - CL_MEM_CONTEXT = $1106; - - // cl_image_info - CL_IMAGE_FORMAT_INFO = $1110; // CL_IMAGE_FORMAT - CL_IMAGE_ELEMENT_SIZE = $1111; - CL_IMAGE_ROW_PITCH = $1112; - CL_IMAGE_SLICE_PITCH = $1113; - CL_IMAGE_WIDTH = $1114; - CL_IMAGE_HEIGHT = $1115; - CL_IMAGE_DEPTH = $1116; - - // cl_addressing_mode - CL_ADDRESS_NONE = $1130; - CL_ADDRESS_CLAMP_TO_EDGE = $1131; - CL_ADDRESS_CLAMP = $1132; - CL_ADDRESS_REPEAT = $1133; - - // cl_filter_mode - CL_FILTER_NEAREST = $1140; - CL_FILTER_LINEAR = $1141; - - // cl_sampler_info - CL_SAMPLER_REFERENCE_COUNT = $1150; - CL_SAMPLER_CONTEXT = $1151; - CL_SAMPLER_NORMALIZED_COORDS = $1152; - CL_SAMPLER_ADDRESSING_MODE = $1153; - CL_SAMPLER_FILTER_MODE = $1154; - - // cl_map_flags - bitfield - CL_MAP_READ = (1 shl 0); - CL_MAP_WRITE = (1 shl 1); - - // cl_program_info - CL_PROGRAM_REFERENCE_COUNT = $1160; - CL_PROGRAM_CONTEXT = $1161; - CL_PROGRAM_NUM_DEVICES = $1162; - CL_PROGRAM_DEVICES = $1163; - CL_PROGRAM_SOURCE = $1164; - CL_PROGRAM_BINARY_SIZES = $1165; - CL_PROGRAM_BINARIES = $1166; - - // cl_program_build_info - CL_PROGRAM_BUILD_STATUS = $1181; - CL_PROGRAM_BUILD_OPTIONS = $1182; - CL_PROGRAM_BUILD_LOG = $1183; - - // cl_build_status - CL_BUILD_SUCCESS = 0; - CL_BUILD_NONE = -1; - CL_BUILD_ERROR = -2; - CL_BUILD_IN_PROGRESS = -3; - - // cl_kernel_info - CL_KERNEL_FUNCTION_NAME = $1190; - CL_KERNEL_NUM_ARGS = $1191; - CL_KERNEL_REFERENCE_COUNT = $1192; - CL_KERNEL_CONTEXT = $1193; - CL_KERNEL_PROGRAM = $1194; - - // cl_kernel_work_group_info - CL_KERNEL_WORK_GROUP_SIZE = $11B0; - CL_KERNEL_COMPILE_WORK_GROUP_SIZE = $11B1; - CL_KERNEL_LOCAL_MEM_SIZE = $11B2; - - // cl_event_info - CL_EVENT_COMMAND_QUEUE = $11D0; - CL_EVENT_COMMAND_TYPE = $11D1; - CL_EVENT_REFERENCE_COUNT = $11D2; - CL_EVENT_COMMAND_EXECUTION_STATUS = $11D3; - - // cl_command_type - CL_COMMAND_NDRANGE_KERNEL = $11F0; - CL_COMMAND_TASK = $11F1; - CL_COMMAND_NATIVE_KERNEL = $11F2; - CL_COMMAND_READ_BUFFER = $11F3; - CL_COMMAND_WRITE_BUFFER = $11F4; - CL_COMMAND_COPY_BUFFER = $11F5; - CL_COMMAND_READ_IMAGE = $11F6; - CL_COMMAND_WRITE_IMAGE = $11F7; - CL_COMMAND_COPY_IMAGE = $11F8; - CL_COMMAND_COPY_IMAGE_TO_BUFFER = $11F9; - CL_COMMAND_COPY_BUFFER_TO_IMAGE = $11FA; - CL_COMMAND_MAP_BUFFER = $11FB; - CL_COMMAND_MAP_IMAGE = $11FC; - CL_COMMAND_UNMAP_MEM_OBJECT = $11FD; - CL_COMMAND_MARKER = $11FE; - CL_COMMAND_WAIT_FOR_EVENTS = $11FF; - CL_COMMAND_BARRIER = $1200; - CL_COMMAND_ACQUIRE_GL_OBJECTS = $1201; - CL_COMMAND_RELEASE_GL_OBJECTS = $1202; - - // command execution status - CL_COMPLETE = $0; - CL_RUNNING = $1; - CL_SUBMITTED = $2; - CL_QUEUED = $3; - - // cl_profiling_info - CL_PROFILING_COMMAND_QUEUED = $1280; - CL_PROFILING_COMMAND_SUBMIT = $1281; - CL_PROFILING_COMMAND_START = $1282; - CL_PROFILING_COMMAND_END = $1283; - - // **************************************************************************** - - // Platform APIs -function clGetPlatformIDs(num_entries: cl_uint; platforms: Pcl_platform_id; - num_platforms: Pcl_uint): cl_int; stdcall; - external OpenCLlib name 'clGetPlatformIDs'; - -function clGetPlatformInfo(_platform: cl_platform_id; - param_name: cl_platform_info; value_size: size_t; value: Pointer; - var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetPlatformInfo'; - -// Device APIs -function clGetDeviceIDs(_platform: cl_platform_id; device_type: cl_device_type; - num_entries: cl_uint; devices: Pcl_device_id; num_devices: Pcl_uint): cl_int; - stdcall; external OpenCLlib name 'clGetDeviceIDs'; - -function clGetDeviceInfo(device: cl_device_id; param_name: cl_device_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetDeviceInfo'; - -// Context APIs -type - TContextNotify = procedure(name: Pchar; data: Pointer; size: size_t; - data2: Pointer); stdcall; - -function clCreateContext(properties: Pcl_context_properties; - num_devices: cl_uint; devices: Pcl_device_id; notify: TContextNotify; - user_data: Pointer; var errcode_ret: cl_int): cl_context; stdcall; - external OpenCLlib name 'clCreateContext'; - -function clCreateContextFromType(properties: Pcl_context_properties; - device_type: cl_device_type; notify: TContextNotify; user_data: Pointer; - var errcode_ret: cl_int): cl_context; stdcall; - external OpenCLlib name 'clCreateContextFromType'; - -function clRetainContext(context: cl_context): cl_int; stdcall; - external OpenCLlib name 'clRetainContext'; - -function clReleaseContext(context: cl_context): cl_int; stdcall; - external OpenCLlib name 'clReleaseContext'; - -function clGetContextInfo(context: cl_context; param_name: cl_context_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetContextInfo'; - -// Command Queue APIs -function clCreateCommandQueue(context: cl_context; device: cl_device_id; - properties: cl_command_queue_properties; errcode_ret: cl_int) - : cl_command_queue; stdcall; external OpenCLlib name 'clCreateCommandQueue'; - -function clRetainCommandQueue(command_queue: cl_command_queue): cl_int; stdcall; - external OpenCLlib name 'clRetainCommandQueue'; - -function clReleaseCommandQueue(command_queue: cl_command_queue): cl_int; - stdcall; external OpenCLlib name 'clReleaseCommandQueue'; - -function clGetCommandQueueInfo(command_queue: cl_command_queue; - param_name: cl_command_queue_info; value_size: size_t; value: Pointer; - var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetCommandQueueInfo'; - -function clSetCommandQueueProperty(command_queue: cl_command_queue; - properties: cl_command_queue_properties; enable: cl_bool; - var old_properties: cl_command_queue_properties): cl_int; stdcall; - external OpenCLlib name 'clSetCommandQueueProperty'; - -// Memory Object APIs -function clCreateBuffer(context: cl_context; flags: cl_mem_flags; size: size_t; - host_ptr: Pointer; var errcode_ret: cl_int): cl_mem; stdcall; - external OpenCLlib name 'clCreateBuffer'; - -function clCreateImage2D(context: cl_context; flags: cl_mem_flags; - image_format: Pcl_image_format; image_width: size_t; image_height: size_t; - image_row_pitch: size_t; host_ptr: Pointer; var errcode_ret: cl_int): cl_mem; - stdcall; external OpenCLlib name 'clCreateImage2D'; - -function clCreateImage3D(context: cl_context; flags: cl_mem_flags; - image_format: Pcl_image_format; image_width: size_t; image_height: size_t; - image_depth: size_t; image_row_pitch: size_t; image_slice_pitch: size_t; - host_ptr: Pointer; var errcode_ret: cl_int): cl_mem; stdcall; - external OpenCLlib name 'clCreateImage3D'; - -function clRetainMemObject(memobj: cl_mem): cl_int; stdcall; - external OpenCLlib name 'clRetainMemObject'; - -function clReleaseMemObject(memobj: cl_mem): cl_int; stdcall; - external OpenCLlib name 'clReleaseMemObject'; - -function clGetSupportedImageFormats(context: cl_context; flags: cl_mem_flags; - image_type: cl_mem_object_type; num_entries: cl_uint; - image_formats: Pcl_image_format; var num_formats: cl_uint): cl_int; stdcall; - external OpenCLlib name 'clGetSupportedImageFormats'; - -function clGetMemObjectInfo(memobj: cl_mem; param_name: cl_mem_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetMemObjectInfo'; - -function clGetImageInfo(image: cl_mem; param_name: cl_image_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetImageInfo'; - -// Sampler APIs -function clCreateSampler(context: cl_context; is_norm_coords: cl_bool; - addr_mode: cl_addressing_mode; filter_mode: cl_filter_mode; - var errcode_ret: cl_int): cl_sampler; stdcall; - external OpenCLlib name 'clCreateSampler'; - -function clRetainSampler(sampler: cl_sampler): cl_int; stdcall; - external OpenCLlib name 'clRetainSampler'; - -function clReleaseSampler(sampler: cl_sampler): cl_int; stdcall; - external OpenCLlib name 'clReleaseSampler'; - -function clGetSamplerInfo(sampler: cl_sampler; param_name: cl_sampler_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetSamplerInfo'; - -// Program Object APIs -function clCreateProgramWithSource(context: cl_context; count: cl_uint; - strings: PPChar; lengths: PSIZE_T; var errcode_ret: cl_int): cl_program; - stdcall; external OpenCLlib name 'clCreateProgramWithSource'; - -type - PPByte = ^PByte; - -function clCreateProgramWithBinary(context: cl_context; num_devices: cl_uint; - device_list: Pcl_device_id; lengths: PSIZE_T; binaries: PPByte; - var binary_status: cl_int; var errcode_ret: cl_int): cl_program; stdcall; - external OpenCLlib name 'clCreateProgramWithBinary'; - -function clRetainProgram(_program: cl_program): cl_int; stdcall; - external OpenCLlib name 'clRetainProgram'; - -function clReleaseProgram(_program: cl_program): cl_int; stdcall; - external OpenCLlib name 'clReleaseProgram'; - -type - TProgramNotify = procedure(_program: cl_program; user_data: Pointer); stdcall; - - // extern cl_int - -function clBuildProgram(_program: cl_program; num_devices: cl_uint; - device_list: Pcl_device_id; options: Pchar; notify: TProgramNotify; - user_data: Pointer): cl_int; stdcall; - external OpenCLlib name 'clBuildProgram'; - -function clUnloadCompiler: cl_int; stdcall; - external OpenCLlib name 'clUnloadCompiler'; - -function clGetProgramInfo(_program: cl_program; param_name: cl_program_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetProgramInfo'; - -function clGetProgramBuildInfo(_program: cl_program; device: cl_device_id; - param_name: cl_program_build_info; value_size: size_t; value: Pointer; - var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetProgramBuildInfo'; - -// Kernel Object APIs -function clCreateKernel(_program: cl_program; kernel_name: Pchar; - var errcode_ret: cl_int): cl_kernel; stdcall; - external OpenCLlib name 'clCreateKernel'; - -function clCreateKernelsInProgram(_program: cl_program; num_kernels: cl_uint; - kernels: Pcl_kernel; var num_ret: cl_uint): cl_int; stdcall; - external OpenCLlib name 'clCreateKernelsInProgram'; - -function clRetainKernel(kernel: cl_kernel): cl_int; stdcall; - external OpenCLlib name 'clRetainKernel'; - -function clReleaseKernel(kernel: cl_kernel): cl_int; stdcall; - external OpenCLlib name 'clReleaseKernel'; - -function clSetKernelArg(kernel: cl_kernel; arg_index: cl_uint; arg_size: size_t; - arg_value: Pointer): cl_int; stdcall; - external OpenCLlib name 'clSetKernelArg'; - -function clGetKernelInfo(kernel: cl_kernel; param_name: cl_kernel_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetKernelInfo'; - -function clGetKernelWorkGroupInfo(kernel: cl_kernel; device: cl_device_id; - param_name: cl_kernel_work_group_info; value_size: size_t; value: Pointer; - size_ret: PSIZE_T): cl_int; stdcall; - external OpenCLlib name 'clGetKernelWorkGroupInfo'; - -// Event Object APIs -function clWaitForEvents(num_events: cl_uint; event_list: cl_event): cl_int; - stdcall; external OpenCLlib name 'clWaitForEvents'; - -function clGetEventInfo(event: cl_event; param_name: cl_event_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetEventInfo'; - -function clRetainEvent(event: cl_event): cl_int; stdcall; - external OpenCLlib name 'clRetainEvent'; - -function clReleaseEvent(event: cl_event): cl_int; stdcall; - external OpenCLlib name 'clReleaseEvent'; - -// Profiling APIs -function clGetEventProfilingInfo(event: cl_event; param_name: cl_profiling_info; - value_size: size_t; value: Pointer; var size_ret: size_t): cl_int; stdcall; - external OpenCLlib name 'clGetEventProfilingInfo'; - -// Flush and Finish APIs -function clFlush(command_queue: cl_command_queue): cl_int; stdcall; - external OpenCLlib name 'clFlush'; - -function clFinish(command_queue: cl_command_queue): cl_int; stdcall; - external OpenCLlib name 'clFinish'; - -// Enqueued Commands APIs -function clEnqueueReadBuffer(command_queue: cl_command_queue; buffer: cl_mem; - blocking_read: cl_bool; offset: size_t; cb: size_t; ptr: Pointer; - num_events: cl_uint; events_list: Pcl_event; event: Pcl_event): cl_int; - stdcall; external OpenCLlib name 'clEnqueueReadBuffer'; - -function clEnqueueWriteBuffer(command_queue: cl_command_queue; buffer: cl_mem; - blocking_write: cl_bool; offset: size_t; cb: size_t; ptr: Pointer; - num_events: cl_uint; events_list: Pcl_event; event: Pcl_event): cl_int; - stdcall; external OpenCLlib name 'clEnqueueWriteBuffer'; - -function clEnqueueCopyBuffer(command_queue: cl_command_queue; - src_buffer: cl_mem; dst_buffer: cl_mem; src_offset: size_t; - dst_offset: size_t; cb: size_t; num_events: cl_uint; events_list: Pcl_event; - event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueCopyBuffer'; - -function clEnqueueReadImage(command_queue: cl_command_queue; image: cl_mem; - blocking_read: cl_bool; origin: PSIZE_T; region: PSIZE_T; row_pitch: size_t; - slice_pitch: size_t; ptr: Pointer; num_events: cl_uint; - events_list: Pcl_event; event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueReadImage'; - -function clEnqueueWriteImage(command_queue: cl_command_queue; image: cl_mem; - blocking_write: cl_bool; origin: PSIZE_T; region: PSIZE_T; row_pitch: size_t; - slice_pitch: size_t; ptr: Pointer; num_events: cl_uint; - events_list: Pcl_event; event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueWriteImage'; - -function clEnqueueCopyImage(command_queue: cl_command_queue; src_image: cl_mem; - dst_image: cl_mem; src_origin: PSIZE_T; dst_origin: PSIZE_T; region: PSIZE_T; - num_events: cl_uint; events_list: Pcl_event; event: Pcl_event): cl_int; - stdcall; external OpenCLlib name 'clEnqueueCopyImage'; - -function clEnqueueCopyImageToBuffer(command_queue: cl_command_queue; - src_image: cl_mem; dst_buffre: cl_mem; src_origin: PSIZE_T; region: PSIZE_T; - dst_offset: size_t; num_events: cl_uint; events_list: Pcl_event; - event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueCopyImageToBuffer'; - -function clEnqueueCopyBufferToImage(command_queue: cl_command_queue; - src_buffer: cl_mem; dst_image: cl_mem; src_offset: size_t; - dst_origin: PSIZE_T; region: PSIZE_T; num_events: cl_uint; - events_list: Pcl_event; event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueCopyBufferToImage'; - -function clEnqueueMapBuffer(command_queue: cl_command_queue; buffer: cl_mem; - blocking_map: cl_bool; map_flags: cl_map_flags; offset: size_t; cb: size_t; - num_events: cl_uint; events_list: Pcl_event; event: Pcl_event; - var errcode_ret: cl_int): Pointer; stdcall; - external OpenCLlib name 'clEnqueueMapBuffer'; - -function clEnqueueMapImage(command_queue: cl_command_queue; image: cl_mem; - blocking_map: cl_bool; map_flags: cl_map_flags; origin: PSIZE_T; - region: PSIZE_T; row_pitch: size_t; slice_pitch: size_t; num_events: cl_uint; - events_list: Pcl_event; event: Pcl_event; var errcode_ret: cl_int): Pointer; - stdcall; external OpenCLlib name 'clEnqueueMapImage'; - -function clEnqueueUnmapMemObject(command_queue: cl_command_queue; - memobj: cl_mem; mapped_ptr: Pointer; num_events: cl_uint; - events_list: Pcl_event; event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueUnmapMemObject'; - -function clEnqueueNDRangeKernel(command_queue: cl_command_queue; - kernel: cl_kernel; work_dim: cl_uint; global_offset, global_size, - local_size: PSIZE_T; num_events: cl_uint; events_list: Pcl_event; - event: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueNDRangeKernel'; - -function clEnqueueTask(command_queue: cl_command_queue; kernel: cl_kernel; - num_events: cl_uint; events_list: Pcl_event; event: Pcl_event): cl_int; - stdcall; external OpenCLlib name 'clEnqueueTask'; - -type - TEnqueueUserProc = procedure(userdata: Pointer); stdcall; - -function clEnqueueNativeKernel(command_queue: cl_command_queue; - user_func: TEnqueueUserProc; args: Pointer; cb_args: size_t; - num_mem_objects: cl_uint; mem_list: Pcl_mem; args_mem_loc: PPointer; - num_events: cl_uint; event_wait_list: Pcl_event; event: Pcl_event): cl_int; - stdcall; external OpenCLlib name 'clEnqueueNativeKernel'; - -function clEnqueueMarker(command_queue: cl_command_queue; event: Pcl_event) - : cl_int; stdcall; external OpenCLlib name 'clEnqueueMarker'; - -function clEnqueueWaitForEvents(command_queue: cl_command_queue; - num_events: cl_uint; event_list: Pcl_event): cl_int; stdcall; - external OpenCLlib name 'clEnqueueWaitForEvents'; - -function clEnqueueBarrier(command_queue: cl_command_queue): cl_int; stdcall; - external OpenCLlib name 'clEnqueueBarrier'; - -function clErrorText(err: cl_int): string; - -implementation - -function clErrorText(err: cl_int): string; -begin - case err of - CL_DEVICE_NOT_FOUND: - clErrorText := 'CL_DEVICE_NOT_FOUND'; - CL_DEVICE_NOT_AVAILABLE: - clErrorText := 'CL_DEVICE_NOT_AVAILABLE'; - CL_DEVICE_COMPILER_NOT_AVAILABLE: - clErrorText := 'CL_DEVICE_COMPILER_NOT_AVAILABLE'; - CL_MEM_OBJECT_ALLOCATION_FAILURE: - clErrorText := 'CL_MEM_OBJECT_ALLOCATION_FAILURE'; - CL_OUT_OF_RESOURCES: - clErrorText := 'CL_OUT_OF_RESOURCES'; - CL_OUT_OF_HOST_MEMORY: - clErrorText := 'CL_OUT_OF_HOST_MEMORY'; - CL_PROFILING_INFO_NOT_AVAILABLE: - clErrorText := 'CL_PROFILING_INFO_NOT_AVAILABLE'; - CL_MEM_COPY_OVERLAP: - clErrorText := 'CL_MEM_COPY_OVERLAP'; - CL_IMAGE_FORMAT_MISMATCH: - clErrorText := 'CL_IMAGE_FORMAT_MISMATCH'; - CL_IMAGE_FORMAT_NOT_SUPPORTED: - clErrorText := 'CL_IMAGE_FORMAT_NOT_SUPPORTED'; - CL_BUILD_PROGRAM_FAILURE: - clErrorText := 'CL_BUILD_PROGRAM_FAILURE'; - CL_MAP_FAILURE: - clErrorText := 'CL_MAP_FAILURE'; - - CL_INVALID_VALUE: - clErrorText := 'CL_INVALID_VALUE'; - CL_INVALID_DEVICE_TYPE: - clErrorText := 'CL_INVALID_DEVICE_TYPE'; - CL_INVALID_PLATFORM: - clErrorText := 'CL_INVALID_PLATFORM'; - CL_INVALID_DEVICE: - clErrorText := 'CL_INVALID_DEVICE'; - CL_INVALID_CONTEXT: - clErrorText := 'CL_INVALID_CONTEXT'; - CL_INVALID_QUEUE_PROPERTIES: - clErrorText := 'CL_INVALID_QUEUE_PROPERTIES'; - CL_INVALID_COMMAND_QUEUE: - clErrorText := 'CL_INVALID_COMMAND_QUEUE'; - CL_INVALID_HOST_PTR: - clErrorText := 'CL_INVALID_HOST_PTR'; - CL_INVALID_MEM_OBJECT: - clErrorText := 'CL_INVALID_MEM_OBJECT'; - CL_INVALID_IMAGE_FORMAT_DESCRIPTOR: - clErrorText := 'CL_INVALID_IMAGE_FORMAT_DESCRIPTOR'; - CL_INVALID_IMAGE_SIZE: - clErrorText := 'CL_INVALID_IMAGE_SIZE'; - CL_INVALID_SAMPLER: - clErrorText := 'CL_INVALID_SAMPLER'; - CL_INVALID_BINARY: - clErrorText := 'CL_INVALID_BINARY'; - CL_INVALID_BUILD_OPTIONS: - clErrorText := 'CL_INVALID_BUILD_OPTIONS'; - CL_INVALID_PROGRAM: - clErrorText := 'CL_INVALID_PROGRAM'; - CL_INVALID_PROGRAM_EXECUTABLE: - clErrorText := 'CL_INVALID_PROGRAM_EXECUTABLE'; - CL_INVALID_KERNEL_NAME: - clErrorText := 'CL_INVALID_KERNEL_NAME'; - CL_INVALID_KERNEL_DEFINITION: - clErrorText := 'CL_INVALID_KERNEL_DEFINITION'; - CL_INVALID_KERNEL: - clErrorText := 'CL_INVALID_KERNEL'; - CL_INVALID_ARG_INDEX: - clErrorText := 'CL_INVALID_ARG_INDEX'; - CL_INVALID_ARG_VALUE: - clErrorText := 'CL_INVALID_ARG_VALUE'; - CL_INVALID_ARG_SIZE: - clErrorText := 'CL_INVALID_ARG_SIZE'; - CL_INVALID_KERNEL_ARGS: - clErrorText := 'CL_INVALID_KERNEL_ARGS'; - CL_INVALID_WORK_DIMENSION: - clErrorText := 'CL_INVALID_WORK_DIMENSION'; - CL_INVALID_WORK_GROUP_SIZE: - clErrorText := 'CL_INVALID_WORK_GROUP_SIZE'; - CL_INVALID_WORK_ITEM_SIZE: - clErrorText := 'CL_INVALID_WORK_ITEM_SIZE'; - CL_INVALID_GLOBAL_OFFSET: - clErrorText := 'CL_INVALID_GLOBAL_OFFSET'; - CL_INVALID_EVENT_WAIT_LIST: - clErrorText := 'CL_INVALID_EVENT_WAIT_LIST'; - CL_INVALID_EVENT: - clErrorText := 'CL_INVALID_EVENT'; - CL_INVALID_OPERATION: - clErrorText := 'CL_INVALID_OPERATION'; - CL_INVALID_GL_OBJECT: - clErrorText := 'CL_INVALID_GL_OBJECT'; - CL_INVALID_BUFFER_SIZE: - clErrorText := 'CL_INVALID_BUFFER_SIZE'; - CL_INVALID_MIP_LEVEL: - clErrorText := 'CL_INVALID_MIP_LEVEL'; - else - clErrorText := 'Unknown OpenCL error'; - end; -end; - -end. diff --git a/dbgenerator/DbgMain.pas b/dbgenerator/DbgMain.pas index 9d3ac86..3ccc2c8 100644 --- a/dbgenerator/DbgMain.pas +++ b/dbgenerator/DbgMain.pas @@ -16,7 +16,7 @@ type TEncodeOptions = record ChunkSize, Threads: Integer; Method: String; - Format: String; + BlockSize: Integer; end; procedure PrintHelp; @@ -104,6 +104,14 @@ begin S := ReplaceText(S, 'p', '%'); S := ReplaceText(S, '%', '%*' + CPUCount.ToString); Options.Threads := Max(1, Round(ExpParse.Evaluate(S))); + S := ArgParse.AsString('-c', 0, '1792mb'); + S := ReplaceText(S, 'KB', '* 1024^1'); + S := ReplaceText(S, 'MB', '* 1024^2'); + S := ReplaceText(S, 'GB', '* 1024^3'); + S := ReplaceText(S, 'K', '* 1024^1'); + S := ReplaceText(S, 'M', '* 1024^2'); + S := ReplaceText(S, 'G', '* 1024^3'); + Options.BlockSize := Round(ExpParse.Evaluate(S)); finally ArgParse.Free; ExpParse.Free; @@ -161,7 +169,7 @@ var CountPos: NativeInt; BaseDir: String; LList: TArray; - LSInfo: PScanInfo; + LSInfo: TScanInfo; LEntry: TEntryStruct; LBytes: TBytes; Hash: Cardinal; @@ -171,6 +179,7 @@ var OStream, MStream: TMemoryStream; DataStore: TDataStore1; Tasks: TArray; + NStream: TArray; InfoStore: TArray>; begin SetLength(SearchInfo, $10000); @@ -189,6 +198,13 @@ begin else BaseDir := ExtractFilePath(TPath.GetFullPath(Input1)); LList := GetFileList([Input1], True); + SetLength(Tasks, Options.Threads); + SetLength(Tasks, Options.Threads); + for I := Low(Tasks) to High(Tasks) do + begin + Tasks[I] := TTask.Create(I); + NStream[I] := TMemoryStream.Create; + end; for I := Low(LList) to High(LList) do begin if InRange(FileSize(LList[I]), MinSize1, Integer.MaxValue) then @@ -201,23 +217,22 @@ begin WordRec(A).Bytes[1] := Buffer[1]; B := Buffer[MinSize1 - 1]; J := MinSize1; - New(LSInfo); - LSInfo^.CRCSize := J; - LSInfo^.ActualSize := FileSize(LList[I]); - LSInfo^.CRC1 := Utils.Hash32(0, @Buffer[0], J); - LSInfo^.CRC2 := LSInfo^.CRC1; - while (J > 0) and (LSInfo^.CRCSize < Options.ChunkSize) do + LSInfo.CRCSize := J; + LSInfo.ActualSize := FileSize(LList[I]); + LSInfo.CRC1 := Utils.Hash32(0, @Buffer[0], J); + LSInfo.CRC2 := LSInfo.CRC1; + while (J > 0) and (LSInfo.CRCSize < Options.ChunkSize) do begin - J := Read(Buffer[0], Min(Options.ChunkSize - LSInfo^.CRCSize, + J := Read(Buffer[0], Min(Options.ChunkSize - LSInfo.CRCSize, BufferSize)); - Inc(LSInfo^.CRCSize, J); - LSInfo^.CRC2 := Utils.Hash32(LSInfo^.CRC2, @Buffer[0], J); + Inc(LSInfo.CRCSize, J); + LSInfo.CRC2 := Utils.Hash32(LSInfo.CRC2, @Buffer[0], J); end; + Insert(LSInfo, SearchInfo[A, B], Length(SearchInfo[A, B])); + Inc(SearchCount[A, B]); finally Free; end; - Insert(LSInfo^, SearchInfo[A, B], Length(SearchInfo[A, B])); - Inc(SearchCount[A, B]); end else if FileSize(LList[I]) < MinSize1 then WriteLn(ErrOutput, Format('Skipped %s (Smaller than %d)', @@ -226,9 +241,10 @@ begin WriteLn(ErrOutput, Format('Skipped %s (Larger than %d)', [ReplaceText(LList[I], BaseDir, ''), Integer.MaxValue])); end; + for I := Low(Tasks) to High(Tasks) do + NStream[I].Free; DataStore := TDataStore1.Create(nil, True, Options.Threads, Options.ChunkSize); - SetLength(Tasks, Options.Threads); SetLength(InfoStore, Options.Threads); OStream := TMemoryStream.Create; MStream := TMemoryStream.Create; @@ -242,10 +258,9 @@ begin OStream.Position := OStream.Size; Found1 := False; try - for I := Low(Tasks) to High(Tasks) do + for I := Low(InfoStore) to High(InfoStore) do begin InfoStore[I] := TListEx.Create(EntryStructCmp); - Tasks[I] := TTask.Create(I); Tasks[I].Perform( procedure(X: IntPtr) var @@ -378,15 +393,18 @@ begin if Found1 then OStream.SaveToFile(Output); finally - for I := Low(Tasks) to High(Tasks) do + for I := Low(InfoStore) to High(InfoStore) do begin InfoStore[I].Free; Tasks[I].Free; + NStream[I].Free; end; DataStore.Free; OStream.Free; MStream.Free; end; + for I := Low(InfoStore) to High(InfoStore) do + Tasks[I].Free; end; end. diff --git a/dbgenerator/DbgUtils.pas b/dbgenerator/DbgUtils.pas index 44f1774..03e60d6 100644 --- a/dbgenerator/DbgUtils.pas +++ b/dbgenerator/DbgUtils.pas @@ -10,6 +10,11 @@ resourcestring SPrecompSep1 = '+'; SPrecompSep2 = ':'; SPrecompSep3 = ','; + SPrecompSep4 = '/'; + SPrecompSep5 = '/'; + XTOOL_MAPSUF1 = '-tmp'; + XTOOL_MAPSUF2 = '_mapped.io'; + XTOOL_MAPSUF3 = '.tmp'; const XTOOL_DB = $31445458; diff --git a/imports/BrunsliDLL.pas b/imports/BrunsliDLL.pas index 13bb944..3bcda33 100644 --- a/imports/BrunsliDLL.pas +++ b/imports/BrunsliDLL.pas @@ -3,6 +3,7 @@ unit BrunsliDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -39,41 +40,31 @@ var implementation var - DLLHandle: THandle; - S: String; + Lib: TLibImport; procedure Init; begin - S := 'brunsli.dll'; - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + S)); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'brunsli.dll'); + if Lib.Loaded then begin - @brunsli_alloc_JPEGData := GetProcAddress(DLLHandle, - 'brunsli_alloc_JPEGData'); - @brunsli_free_JPEGData := GetProcAddress(DLLHandle, - 'brunsli_free_JPEGData'); - @brunsli_GetMaximumEncodedSize := GetProcAddress(DLLHandle, - 'brunsli_GetMaximumEncodedSize'); - @brunsli_ReadJpeg := GetProcAddress(DLLHandle, 'brunsli_ReadJpeg'); - @brunsli_EncodeJpeg := GetProcAddress(DLLHandle, 'brunsli_EncodeJpeg'); - @brunsli_DecodeJpeg := GetProcAddress(DLLHandle, 'brunsli_DecodeJpeg'); - @brunsli_alloc_JPEGOutput := GetProcAddress(DLLHandle, - 'brunsli_alloc_JPEGOutput'); - @brunsli_free_JPEGOutput := GetProcAddress(DLLHandle, - 'brunsli_free_JPEGOutput'); - @brunsli_WriteJpeg := GetProcAddress(DLLHandle, 'brunsli_WriteJpeg'); + @brunsli_alloc_JPEGData := Lib.GetProcAddr('brunsli_alloc_JPEGData'); + @brunsli_free_JPEGData := Lib.GetProcAddr('brunsli_free_JPEGData'); + @brunsli_GetMaximumEncodedSize := + Lib.GetProcAddr('brunsli_GetMaximumEncodedSize'); + @brunsli_ReadJpeg := Lib.GetProcAddr('brunsli_ReadJpeg'); + @brunsli_EncodeJpeg := Lib.GetProcAddr('brunsli_EncodeJpeg'); + @brunsli_DecodeJpeg := Lib.GetProcAddr('brunsli_DecodeJpeg'); + @brunsli_alloc_JPEGOutput := Lib.GetProcAddr('brunsli_alloc_JPEGOutput'); + @brunsli_free_JPEGOutput := Lib.GetProcAddr('brunsli_free_JPEGOutput'); + @brunsli_WriteJpeg := Lib.GetProcAddr('brunsli_WriteJpeg'); DLLLoaded := Assigned(brunsli_alloc_JPEGData) and Assigned(brunsli_alloc_JPEGOutput); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/FLACDLL.pas b/imports/FLACDLL.pas index 4c14445..60e44b6 100644 --- a/imports/FLACDLL.pas +++ b/imports/FLACDLL.pas @@ -3,6 +3,7 @@ unit FLACDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -121,68 +122,60 @@ var implementation var - DLLHandle: THandle; + Lib: TLibImport; procedure Init; begin - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'libFLAC_dynamic.dll')); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + + 'libFLAC_dynamic.dll'); + if Lib.Loaded then begin - @FLAC__stream_encoder_new := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_new'); - @FLAC__stream_encoder_set_verify := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_set_verify'); - @FLAC__stream_encoder_set_channels := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_set_channels'); + @FLAC__stream_encoder_new := Lib.GetProcAddr('FLAC__stream_encoder_new'); + @FLAC__stream_encoder_set_verify := + Lib.GetProcAddr('FLAC__stream_encoder_set_verify'); + @FLAC__stream_encoder_set_channels := + Lib.GetProcAddr('FLAC__stream_encoder_set_channels'); @FLAC__stream_encoder_set_compression_level := - GetProcAddress(DLLHandle, 'FLAC__stream_encoder_set_compression_level'); + Lib.GetProcAddr('FLAC__stream_encoder_set_compression_level'); @FLAC__stream_encoder_set_bits_per_sample := - GetProcAddress(DLLHandle, 'FLAC__stream_encoder_set_bits_per_sample'); + Lib.GetProcAddr('FLAC__stream_encoder_set_bits_per_sample'); @FLAC__stream_encoder_set_sample_rate := - GetProcAddress(DLLHandle, 'FLAC__stream_encoder_set_sample_rate'); + Lib.GetProcAddr('FLAC__stream_encoder_set_sample_rate'); @FLAC__stream_encoder_set_total_samples_estimate := - GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_set_total_samples_estimate'); - @FLAC__stream_encoder_init_stream := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_init_stream'); - @FLAC__stream_encoder_init_file := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_init_file'); + Lib.GetProcAddr('FLAC__stream_encoder_set_total_samples_estimate'); + @FLAC__stream_encoder_init_stream := + Lib.GetProcAddr('FLAC__stream_encoder_init_stream'); + @FLAC__stream_encoder_init_file := + Lib.GetProcAddr('FLAC__stream_encoder_init_file'); @FLAC__stream_encoder_process_interleaved := - GetProcAddress(DLLHandle, 'FLAC__stream_encoder_process_interleaved'); - @FLAC__stream_encoder_finish := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_finish'); - @FLAC__stream_encoder_delete := GetProcAddress(DLLHandle, - 'FLAC__stream_encoder_delete'); - @FLAC__stream_decoder_new := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_new'); - @FLAC__stream_decoder_init_stream := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_init_stream'); - @FLAC__stream_decoder_init_file := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_init_file'); - @FLAC__stream_decoder_get_channels := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_get_channels'); + Lib.GetProcAddr('FLAC__stream_encoder_process_interleaved'); + @FLAC__stream_encoder_finish := + Lib.GetProcAddr('FLAC__stream_encoder_finish'); + @FLAC__stream_encoder_delete := + Lib.GetProcAddr('FLAC__stream_encoder_delete'); + @FLAC__stream_decoder_new := Lib.GetProcAddr('FLAC__stream_decoder_new'); + @FLAC__stream_decoder_init_stream := + Lib.GetProcAddr('FLAC__stream_decoder_init_stream'); + @FLAC__stream_decoder_init_file := + Lib.GetProcAddr('FLAC__stream_decoder_init_file'); + @FLAC__stream_decoder_get_channels := + Lib.GetProcAddr('FLAC__stream_decoder_get_channels'); @FLAC__stream_decoder_get_bits_per_sample := - GetProcAddress(DLLHandle, 'FLAC__stream_decoder_get_bits_per_sample'); + Lib.GetProcAddr('FLAC__stream_decoder_get_bits_per_sample'); @FLAC__stream_decoder_process_until_end_of_stream := - GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_process_until_end_of_stream'); - @FLAC__stream_decoder_finish := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_finish'); - @FLAC__stream_decoder_delete := GetProcAddress(DLLHandle, - 'FLAC__stream_decoder_delete'); + Lib.GetProcAddr('FLAC__stream_decoder_process_until_end_of_stream'); + @FLAC__stream_decoder_finish := + Lib.GetProcAddr('FLAC__stream_decoder_finish'); + @FLAC__stream_decoder_delete := + Lib.GetProcAddr('FLAC__stream_decoder_delete'); DLLLoaded := Assigned(FLAC__stream_encoder_new) and Assigned(FLAC__stream_decoder_new); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/FLZMA2DLL.pas b/imports/FLZMA2DLL.pas index 23ba52b..e89a7ca 100644 --- a/imports/FLZMA2DLL.pas +++ b/imports/FLZMA2DLL.pas @@ -3,7 +3,7 @@ unit FLZMA2DLL; interface uses - MemoryModule, + LibImport, WinAPI.Windows, System.SysUtils, System.Classes, System.Types; @@ -24,6 +24,82 @@ type pos: size_t; end; +type + FL2_cParameter = ( + (* compression parameters *) + FL2_p_compressionLevel, + (* Update all compression parameters according to pre-defined cLevel table + * Default level is FL2_CLEVEL_DEFAULT==6. + * Setting FL2_p_highCompression to 1 switches to an alternate cLevel table. *) + FL2_p_highCompression, + (* Maximize compression ratio for a given dictionary size. + * Levels 1..10 = dictionaryLog 20..29 (1 Mb..512 Mb). + * Typically provides a poor speed/ratio tradeoff. *) + FL2_p_dictionaryLog, + (* Maximum allowed back-reference distance, expressed as power of 2. + * Must be clamped between FL2_DICTLOG_MIN and FL2_DICTLOG_MAX. + * Default = 24 *) + FL2_p_dictionarySize, (* Same as above but expressed as an absolute value. + * Must be clamped between FL2_DICTSIZE_MIN and FL2_DICTSIZE_MAX. + * Default = 16 Mb *) + FL2_p_overlapFraction, + (* The radix match finder is block-based, so some overlap is retained from + * each block to improve compression of the next. This value is expressed + * as n / 16 of the block size (dictionary size). Larger values are slower. + * Values above 2 mostly yield only a small improvement in compression. + * A large value for a small dictionary may worsen multithreaded compression. + * Default = 2 *) + FL2_p_resetInterval, + (* For multithreaded decompression. A dictionary reset will occur + * after each dictionarySize * resetInterval bytes of input. + * Default = 4 *) + FL2_p_bufferResize, + (* Buffering speeds up the matchfinder. Buffer resize determines the percentage of + * the normal buffer size used, which depends on dictionary size. + * 0=50, 1=75, 2=100, 3=150, 4=200. Higher number = slower, better + * compression, higher memory usage. A CPU with a large memory cache + * may make effective use of a larger buffer. + * Default = 2 *) + FL2_p_hybridChainLog, + (* Size of the hybrid mode HC3 hash chain, as a power of 2. + * Resulting table size is (1 << (chainLog+2)) bytes. + * Larger tables result in better and slower compression. + * This parameter is only used by the hybrid "ultra" strategy. + * Default = 9 *) + FL2_p_hybridCycles, + (* Number of search attempts made by the HC3 match finder. + * Used only by the hybrid "ultra" strategy. + * More attempts result in slightly better and slower compression. + * Default = 1 *) + FL2_p_searchDepth, + (* Match finder will resolve string matches up to this length. If a longer + * match exists further back in the input, it will not be found. + * Default = 42 *) + FL2_p_fastLength, (* Only useful for strategies >= opt. + * Length of match considered "good enough" to stop search. + * Larger values make compression stronger and slower. + * Default = 48 *) + FL2_p_divideAndConquer, + (* Split long chains of 2-byte matches into shorter chains with a small overlap + * for further processing. Allows buffering of all chains at length 2. + * Faster, less compression. Generally a good tradeoff. + * Default = enabled *) + FL2_p_strategy, (* 1 = fast; 2 = optimized, 3 = ultra (hybrid mode). + * The higher the value of the selected strategy, the more complex it is, + * resulting in stronger and slower compression. + * Default = ultra *) + FL2_p_literalCtxBits, (* lc value for LZMA2 encoder + * Default = 3 *) + FL2_p_literalPosBits, (* lp value for LZMA2 encoder + * Default = 0 *) + FL2_p_posBits, (* pb value for LZMA2 encoder + * Default = 2 *) + FL2_p_omitProperties, + (* Omit the property byte at the start of the stream. For use within 7-zip *) + (* or other containers which store the property byte elsewhere. *) + (* A stream compressed under this setting cannot be decoded by this library. *) + FL2_cParameter_Force32 = $40000000); + var FL2_compress: function(dst: Pointer; dstCapacity: size_t; const src: Pointer; srcSize: size_t; compressionLevel: Integer): size_t cdecl; @@ -63,13 +139,20 @@ var input: PFL2_inBuffer): size_t cdecl; FL2_endStream: function(fcs: Pointer; output: PFL2_outBuffer): size_t cdecl; + FL2_isError: function(code: size_t): Cardinal cdecl; + FL2_CStream_setParameter: function(fcs: Pointer; param: FL2_cParameter; + value: size_t): size_t cdecl; + FL2_CStream_getParameter: function(fcs: Pointer; param: FL2_cParameter) + : size_t cdecl; + FL2_setDStreamMemoryLimitMt: procedure(fds: Pointer; limit: size_t)cdecl; DLLLoaded: boolean = False; type TLZMACRec = record Threads: Integer; Level: Integer; + HighCompress: boolean; procedure Parse(S: String); end; @@ -86,8 +169,9 @@ type FProp: TLZMACRec; FOutput: TStream; FBuffer: array [0 .. FBufferSize - 1] of Byte; + FInitialized: boolean; public - constructor Create(AOutput: TStream; AConfig: String = 't50p'); + constructor Create(AOutput: TStream; AConfig: String); destructor Destroy; override; function Write(const Buffer; Count: LongInt): LongInt; override; end; @@ -113,8 +197,7 @@ uses Utils; var - DLLStream: TResourceStream; - DLLHandle: TMemoryModule; + Lib: TLibImport; procedure TLZMACRec.Parse(S: string); var @@ -122,7 +205,8 @@ var I, J: Integer; begin Threads := 1; - Level := 5; + Level := 6; + HighCompress := False; List := DecodeStr(S, ':'); for I := Low(List) to High(List) do begin @@ -130,6 +214,8 @@ begin Threads := ConvertToThreads(List[I].Substring(1)); if List[I].StartsWith('l', True) then Level := List[I].Substring(1).ToInteger; + if List[I].StartsWith('hi', True) then + HighCompress := List[I].Substring(2).ToBoolean; end; end; @@ -148,15 +234,22 @@ begin end; constructor TLZMACompressStream.Create(AOutput: TStream; AConfig: String); +var + LConfig: String; begin inherited Create; - FProp.Parse(AConfig); + LConfig := AConfig; + if LConfig = '' then + LConfig := 't50p'; + FProp.Parse(LConfig); FOutput := AOutput; if FProp.Threads > 1 then FCtx := FL2_createCStreamMt(FProp.Threads, 0) else FCtx := FL2_createCStream; - FL2_initCStream(FCtx, FProp.Level); + FL2_CStream_setParameter(FCtx, FL2_cParameter.FL2_p_highCompression, + Integer(FProp.HighCompress)); + FInitialized := False; end; destructor TLZMACompressStream.Destroy; @@ -164,14 +257,17 @@ var Oup: FL2_outBuffer; Res: size_t; begin - Oup.dst := @FBuffer[0]; - Oup.size := FBufferSize; - Oup.pos := 0; - repeat - Res := FL2_endStream(FCtx, @Oup); - FOutput.WriteBuffer(FBuffer[0], Oup.pos); + if FInitialized then + begin + Oup.dst := @FBuffer[0]; + Oup.size := FBufferSize; Oup.pos := 0; - until Res = 0; + repeat + Res := FL2_endStream(FCtx, @Oup); + FOutput.WriteBuffer(FBuffer[0], Oup.pos); + Oup.pos := 0; + until Res = 0; + end; FL2_freeCCtx(FCtx); inherited Destroy; end; @@ -182,6 +278,11 @@ var Oup: FL2_outBuffer; begin Result := 0; + if not FInitialized then + begin + FL2_initCStream(FCtx, FProp.Level); + FInitialized := True; + end; Inp.src := PByte(@Buffer); Inp.size := Count; Inp.pos := 0; @@ -200,12 +301,23 @@ begin end; constructor TLZMADecompressStream.Create(AInput: TStream; AConfig: String); +var + LConfig: String; + LSize: Int64; begin inherited Create; - FProp.Parse(AConfig); + LConfig := AConfig; + if LConfig = '' then + LConfig := 't50p'; + FProp.Parse(LConfig); FInput := AInput; + LSize := 0; + LSize := LSize.MaxValue; if FProp.Threads > 1 then - FCtx := FL2_createDStreamMt(FProp.Threads) + begin + FCtx := FL2_createDStreamMt(FProp.Threads); + FL2_setDStreamMemoryLimitMt(FCtx, LSize); + end else FCtx := FL2_createDStream; FL2_initDStream(FCtx); @@ -255,50 +367,44 @@ end; procedure Init; begin - DLLStream := TResourceStream.Create(HInstance, 'fast_lzma2', RT_RCDATA); - DLLHandle := MemoryLoadLibary(DLLStream.Memory); - if Assigned(DLLHandle) then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'fast-lzma2.dll'); + if Lib.Loaded then begin - @FL2_compress := MemoryGetProcAddress(DLLHandle, 'FL2_compress'); - @FL2_compressMt := MemoryGetProcAddress(DLLHandle, 'FL2_compressMt'); - @FL2_decompress := MemoryGetProcAddress(DLLHandle, 'FL2_decompress'); - @FL2_decompressMt := MemoryGetProcAddress(DLLHandle, 'FL2_decompressMt'); - @FL2_createCCtx := MemoryGetProcAddress(DLLHandle, 'FL2_createCCtx'); - @FL2_createCCtxMt := MemoryGetProcAddress(DLLHandle, 'FL2_createCCtxMt'); - @FL2_freeCCtx := MemoryGetProcAddress(DLLHandle, 'FL2_freeCCtx'); - @FL2_compressCCtx := MemoryGetProcAddress(DLLHandle, 'FL2_compressCCtx'); - @FL2_createDCtx := MemoryGetProcAddress(DLLHandle, 'FL2_createDCtx'); - @FL2_createDCtxMt := MemoryGetProcAddress(DLLHandle, 'FL2_createDCtxMt'); - @FL2_freeDCtx := MemoryGetProcAddress(DLLHandle, 'FL2_freeDCtx'); - @FL2_decompressDCtx := MemoryGetProcAddress(DLLHandle, - 'FL2_decompressDCtx'); - @FL2_createCStream := MemoryGetProcAddress(DLLHandle, 'FL2_createCStream'); - @FL2_createCStreamMt := MemoryGetProcAddress(DLLHandle, - 'FL2_createCStreamMt'); - @FL2_freeCStream := MemoryGetProcAddress(DLLHandle, 'FL2_freeCStream'); - @FL2_initCStream := MemoryGetProcAddress(DLLHandle, 'FL2_initCStream'); - @FL2_compressStream := MemoryGetProcAddress(DLLHandle, - 'FL2_compressStream'); - @FL2_createDStream := MemoryGetProcAddress(DLLHandle, 'FL2_createDStream'); - @FL2_createDStreamMt := MemoryGetProcAddress(DLLHandle, - 'FL2_createDStreamMt'); - @FL2_freeDStream := MemoryGetProcAddress(DLLHandle, 'FL2_freeDStream'); - @FL2_initDStream := MemoryGetProcAddress(DLLHandle, 'FL2_initDStream'); - @FL2_decompressStream := MemoryGetProcAddress(DLLHandle, - 'FL2_decompressStream'); - @FL2_endStream := MemoryGetProcAddress(DLLHandle, 'FL2_endStream'); - @FL2_isError := MemoryGetProcAddress(DLLHandle, 'FL2_isError'); + @FL2_compress := Lib.GetProcAddr('FL2_compress'); + @FL2_compressMt := Lib.GetProcAddr('FL2_compressMt'); + @FL2_decompress := Lib.GetProcAddr('FL2_decompress'); + @FL2_decompressMt := Lib.GetProcAddr('FL2_decompressMt'); + @FL2_createCCtx := Lib.GetProcAddr('FL2_createCCtx'); + @FL2_createCCtxMt := Lib.GetProcAddr('FL2_createCCtxMt'); + @FL2_freeCCtx := Lib.GetProcAddr('FL2_freeCCtx'); + @FL2_compressCCtx := Lib.GetProcAddr('FL2_compressCCtx'); + @FL2_createDCtx := Lib.GetProcAddr('FL2_createDCtx'); + @FL2_createDCtxMt := Lib.GetProcAddr('FL2_createDCtxMt'); + @FL2_freeDCtx := Lib.GetProcAddr('FL2_freeDCtx'); + @FL2_decompressDCtx := Lib.GetProcAddr('FL2_decompressDCtx'); + @FL2_createCStream := Lib.GetProcAddr('FL2_createCStream'); + @FL2_createCStreamMt := Lib.GetProcAddr('FL2_createCStreamMt'); + @FL2_freeCStream := Lib.GetProcAddr('FL2_freeCStream'); + @FL2_initCStream := Lib.GetProcAddr('FL2_initCStream'); + @FL2_compressStream := Lib.GetProcAddr('FL2_compressStream'); + @FL2_createDStream := Lib.GetProcAddr('FL2_createDStream'); + @FL2_createDStreamMt := Lib.GetProcAddr('FL2_createDStreamMt'); + @FL2_freeDStream := Lib.GetProcAddr('FL2_freeDStream'); + @FL2_initDStream := Lib.GetProcAddr('FL2_initDStream'); + @FL2_decompressStream := Lib.GetProcAddr('FL2_decompressStream'); + @FL2_endStream := Lib.GetProcAddr('FL2_endStream'); + @FL2_isError := Lib.GetProcAddr('FL2_isError'); + @FL2_CStream_setParameter := Lib.GetProcAddr('FL2_CStream_setParameter'); + @FL2_CStream_getParameter := Lib.GetProcAddr('FL2_CStream_getParameter'); + @FL2_setDStreamMemoryLimitMt := + Lib.GetProcAddr('FL2_setDStreamMemoryLimitMt'); DLLLoaded := Assigned(FL2_compress) and Assigned(FL2_decompress); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - MemoryFreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/GrittibanzliDLL.pas b/imports/GrittibanzliDLL.pas new file mode 100644 index 0000000..ed0a6ec --- /dev/null +++ b/imports/GrittibanzliDLL.pas @@ -0,0 +1,52 @@ +unit GrittibanzliDLL; + +interface + +uses + WinAPI.Windows, + System.SysUtils, System.Classes; + +var + Grittibanzli: function(const src: Pointer; srcSize: Cardinal; dst1: Pointer; + dst1Capacity: PCardinal; dst2: Pointer; dst2Capacity: PCardinal) + : boolean cdecl; + Ungrittibanzli: function(const src1: Pointer; src1Size: Cardinal; + const src2: Pointer; src2Size: Cardinal; dst: Pointer; + dstCapacity: PCardinal): boolean cdecl; + DLLLoaded: boolean = False; + +implementation + +var + DLLHandle: THandle; + +procedure Init; +begin + DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + + 'grittibanzli_dll.dll')); + if DLLHandle >= 32 then + begin + @Grittibanzli := GetProcAddress(DLLHandle, '__Grittibanzli'); + @Ungrittibanzli := GetProcAddress(DLLHandle, '__Ungrittibanzli'); + DLLLoaded := Assigned(Grittibanzli) and Assigned(Ungrittibanzli); + end + else + DLLLoaded := False; +end; + +procedure Deinit; +begin + if not DLLLoaded then + exit; + FreeLibrary(DLLHandle); +end; + +initialization + +Init; + +finalization + +Deinit; + +end. diff --git a/imports/JoJpegDLL.pas b/imports/JoJpegDLL.pas index e2c7741..94e7e54 100644 --- a/imports/JoJpegDLL.pas +++ b/imports/JoJpegDLL.pas @@ -3,6 +3,7 @@ unit JoJpegDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -32,30 +33,25 @@ var implementation var - DLLHandle: THandle; + Lib: TLibImport; procedure Init; begin - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'jojpeg_dll.dll')); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'jojpeg_dll.dll'); + if Lib.Loaded then begin - @jojpeg_Init := GetProcAddress(DLLHandle, 'jojpeg_Init'); - @jojpeg_Quit := GetProcAddress(DLLHandle, 'jojpeg_Quit'); - @jojpeg_Loop := GetProcAddress(DLLHandle, 'jojpeg_Loop'); - @jojpeg_Getvalue := GetProcAddress(DLLHandle, 'jojpeg_Getvalue'); - @jojpeg_Addbuf := GetProcAddress(DLLHandle, 'jojpeg_Addbuf'); + @jojpeg_Init := Lib.GetProcAddr('jojpeg_Init'); + @jojpeg_Quit := Lib.GetProcAddr('jojpeg_Quit'); + @jojpeg_Loop := Lib.GetProcAddr('jojpeg_Loop'); + @jojpeg_Getvalue := Lib.GetProcAddr('jojpeg_Getvalue'); + @jojpeg_Addbuf := Lib.GetProcAddr('jojpeg_Addbuf'); DLLLoaded := Assigned(jojpeg_Init); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/LZ4DLL.pas b/imports/LZ4DLL.pas index 1eccf75..d874fa6 100644 --- a/imports/LZ4DLL.pas +++ b/imports/LZ4DLL.pas @@ -3,13 +3,23 @@ unit LZ4DLL; interface uses + LibImport, WinAPI.Windows, - System.SysUtils; + System.SysUtils, System.Math; const LZ4F_VERSION = 100; type + PLZ4_streamDecode_t = ^LZ4_streamDecode_t; + LZ4_streamDecode_t = array [0 .. 1 shl 9 - 1] of byte; + + PLZ4_stream_t = ^LZ4_stream_t; + LZ4_stream_t = array [0 .. 1 shl 9 - 1] of byte; + + PLZ4_streamHC_t = ^LZ4_streamHC_t; + LZ4_streamHC_t = array [0 .. 1 shl 9 - 1] of byte; + LZ4F_errorCode_t = type size_t; LZ4F_blockSizeID_t = (LZ4F_default = 0, LZ4F_max64KB = 4, LZ4F_max256KB = 5, @@ -83,67 +93,65 @@ var LZ4F_getFrameInfo: function(dctx: LZ4F_dctx; out frameInfoPtr: LZ4F_frameInfo_t; srcBuffer: Pointer; out srcSizePtr: size_t): size_t cdecl; + LZ4_createStreamDecode: function: PLZ4_streamDecode_t cdecl; + LZ4_freeStreamDecode: function(LZ4_stream: PLZ4_streamDecode_t) + : Integer cdecl; + LZ4_decompress_safe_continue: function(LZ4_stream: PLZ4_streamDecode_t; + const src: Pointer; dst: Pointer; srcSize: Integer; dstCapacity: Integer) + : Integer cdecl; + LZ4_createStream: function: PLZ4_stream_t cdecl; + LZ4_freeStream: function(streamPtr: PLZ4_stream_t): Integer cdecl; + LZ4_resetStream: procedure(streamHCPtr: PLZ4_stream_t)cdecl; + LZ4_compress_fast_continue: function(streamPtr: PLZ4_stream_t; + const src: Pointer; dst: Pointer; srcSize: Integer; maxDstSize: Integer; + acceleration: Integer): Integer cdecl; + LZ4_createStreamHC: function: PLZ4_streamHC_t cdecl; + LZ4_freeStreamHC: function(streamHCPtr: PLZ4_streamHC_t): Integer cdecl; + LZ4_resetStreamHC: procedure(streamHCPtr: PLZ4_streamHC_t; + compressionLevel: Integer)cdecl; + LZ4_compress_HC_continue: function(streamHCPtr: PLZ4_streamHC_t; + const src: Pointer; dst: Pointer; srcSize: Integer; maxDstSize: Integer) + : Integer cdecl; DLLLoaded: Boolean = False; function LZ4F_decompress_safe(source: Pointer; dest: Pointer; - compressedSize: Integer; maxDecompressedSize: Integer): Integer; + sourceSize: Integer; destSize: Integer; compressedSize: PInteger = nil; + blockSize: PInteger = nil): Integer; +function LZ4_compress_block(src, dst: Pointer; + srcSize, dstCapacity: Integer): Integer; implementation -var - DLLHandle: THandle; - -procedure Init(Filename: String); -begin - if DLLLoaded then - Exit; - DLLHandle := 0; - DLLHandle := LoadLibrary(PWideChar(ExtractFilePath(ParamStr(0)) + Filename)); - if DLLHandle >= 32 then - begin - @LZ4_decompress_safe := GetProcAddress(DLLHandle, 'LZ4_decompress_safe'); - @LZ4_decompress_fast := GetProcAddress(DLLHandle, 'LZ4_decompress_fast'); - @LZ4_compress_default := GetProcAddress(DLLHandle, 'LZ4_compress_default'); - @LZ4_compress_fast := GetProcAddress(DLLHandle, 'LZ4_compress_fast'); - @LZ4_compress_HC := GetProcAddress(DLLHandle, 'LZ4_compress_HC'); - @LZ4_compressHC2 := GetProcAddress(DLLHandle, 'LZ4_compressHC2'); - @LZ4F_compressFrame := GetProcAddress(DLLHandle, 'LZ4F_compressFrame'); - @LZ4F_compressFrameBound := GetProcAddress(DLLHandle, - 'LZ4F_compressFrameBound'); - @LZ4F_createDecompressionContext := GetProcAddress(DLLHandle, - 'LZ4F_createDecompressionContext'); - @LZ4F_freeDecompressionContext := GetProcAddress(DLLHandle, - 'LZ4F_freeDecompressionContext'); - @LZ4F_decompress := GetProcAddress(DLLHandle, 'LZ4F_decompress'); - @LZ4F_getFrameInfo := GetProcAddress(DLLHandle, 'LZ4F_getFrameInfo'); - DLLLoaded := Assigned(LZ4_decompress_safe); - end - else - DLLLoaded := False; -end; - -procedure Deinit; -begin - if not DLLLoaded then - Exit; - FreeLibrary(DLLHandle); -end; - function LZ4F_decompress_safe(source: Pointer; dest: Pointer; - compressedSize: Integer; maxDecompressedSize: Integer): Integer; + sourceSize: Integer; destSize: Integer; compressedSize: PInteger; + blockSize: PInteger): Integer; var ctx: LZ4F_dctx; - srcSizePtr, dstSizePtr: size_t; + fi: LZ4F_frameInfo_t; + srcSizePtr, dstSizePtr, srcSizePtr2: size_t; begin Result := 0; + if Assigned(compressedSize) then + compressedSize^ := 0; + if Assigned(blockSize) then + blockSize^ := 4; if NativeUInt(LZ4F_createDecompressionContext(ctx)) = 0 then try - srcSizePtr := compressedSize; - dstSizePtr := maxDecompressedSize; + srcSizePtr := sourceSize; + dstSizePtr := destSize; try + FillChar(fi, SizeOf(LZ4F_frameInfo_t), 0); + srcSizePtr2 := sourceSize; if LZ4F_decompress(ctx, dest, dstSizePtr, source, srcSizePtr, nil) = 0 then + begin + LZ4F_getFrameInfo(ctx, fi, source, srcSizePtr2); + if Assigned(compressedSize) then + compressedSize^ := srcSizePtr; + if Assigned(blockSize) then + blockSize^ := Max(4, Integer(fi.blockSizeID)); Result := dstSizePtr; + end; finally LZ4F_freeDecompressionContext(ctx); end; @@ -151,6 +159,157 @@ begin end; end; +function LZ4_compress_block(src, dst: Pointer; + srcSize, dstCapacity: Integer): Integer; +const + blockSize = 64 * 1024; +const + BuffSize = 256 * 1024; +var + Buff: array [0 .. BuffSize - 1] of byte; + ctx: PLZ4_stream_t; + Pos1, Pos2, Res: Integer; + X, Y: Integer; +begin + Result := 0; + ctx := LZ4_createStream; + LZ4_resetStream(ctx); + Pos1 := 0; + Pos2 := 0; + try + while (Pos1 < srcSize) and (Pos2 < dstCapacity) do + begin + X := Min(srcSize - Pos1, blockSize); + Y := dstCapacity - Pos2; + Res := LZ4_compress_fast_continue(ctx, PByte(src) + Pos1, @Buff[0], X, + BuffSize, 1); + if Res <= 0 then + begin + LZ4_freeStream(ctx); + exit(-Pos2); + end; + Move(Buff[0], (PByte(dst) + Pos2)^, Res); + Inc(Pos1, X); + Inc(Pos2, Res); + end; + finally + LZ4_freeStream(ctx); + end; + Result := Pos2; +end; + +function UnravelEncode(InBuff: Pointer; InSize: Integer; OutBuff: Pointer; + OutSize: Integer): Integer; +const + blockSize = 65536; +var + ctx: PLZ4_streamHC_t; + Pos1, Pos2, Res: Integer; + X, Y: Integer; +begin + Result := 0; + ctx := LZ4_createStreamHC; + LZ4_resetStreamHC(ctx, 9); + Pos1 := 0; + Pos2 := 0; + try + while (Pos1 < InSize) do + begin + X := Min(InSize - Pos1, blockSize); + Y := OutSize - (Pos2 + Integer.Size); + Res := LZ4_compress_HC_continue(ctx, PByte(InBuff) + Pos1, + PByte(OutBuff) + Pos2 + Integer.Size, X, Y); + if Res <= 0 then + begin + LZ4_freeStreamHC(ctx); + exit(-Pos2); + end; + PInteger(PByte(OutBuff) + Pos2)^ := Res; + Inc(Pos1, X); + Inc(Pos2, Res + Integer.Size); + end; + finally + LZ4_freeStreamHC(ctx); + end; + Result := Pos2; +end; + +function UnravelDecode(InBuff: Pointer; InSize: Integer; OutBuff: Pointer; + OutSize: Integer): Integer; +const + blockSize = 65536; +var + ctx: PLZ4_streamDecode_t; + Pos1, Pos2, Res: Integer; +begin + Result := 0; + ctx := LZ4_createStreamDecode; + Pos1 := 0; + Pos2 := 0; + try + while (Pos1 < InSize) and (Pos2 < OutSize) do + begin + Res := LZ4_decompress_safe_continue(ctx, PByte(InBuff) + Pos1 + + Integer.Size, PByte(OutBuff) + Pos2, PInteger(PByte(InBuff) + Pos1)^, + Min(OutSize - Pos2, blockSize)); + if Res <= 0 then + begin + LZ4_freeStreamDecode(ctx); + exit(-Pos2); + end; + Inc(Pos1, PInteger(PByte(InBuff) + Pos1)^ + Integer.Size); + Inc(Pos2, Res); + end; + finally + LZ4_freeStreamDecode(ctx); + end; + Result := Pos2; +end; + +var + Lib: TLibImport; + +procedure Init(Filename: String); +begin + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + Filename); + if Lib.Loaded then + begin + @LZ4_decompress_safe := Lib.GetProcAddr('LZ4_decompress_safe'); + @LZ4_decompress_fast := Lib.GetProcAddr('LZ4_decompress_fast'); + @LZ4_compress_default := Lib.GetProcAddr('LZ4_compress_default'); + @LZ4_compress_fast := Lib.GetProcAddr('LZ4_compress_fast'); + @LZ4_compress_HC := Lib.GetProcAddr('LZ4_compress_HC'); + @LZ4_compressHC2 := Lib.GetProcAddr('LZ4_compressHC2'); + @LZ4F_compressFrame := Lib.GetProcAddr('LZ4F_compressFrame'); + @LZ4F_compressFrameBound := Lib.GetProcAddr('LZ4F_compressFrameBound'); + @LZ4F_createDecompressionContext := + Lib.GetProcAddr('LZ4F_createDecompressionContext'); + @LZ4F_freeDecompressionContext := + Lib.GetProcAddr('LZ4F_freeDecompressionContext'); + @LZ4F_decompress := Lib.GetProcAddr('LZ4F_decompress'); + @LZ4F_getFrameInfo := Lib.GetProcAddr('LZ4F_getFrameInfo'); + @LZ4_createStreamDecode := Lib.GetProcAddr('LZ4_createStreamDecode'); + @LZ4_freeStreamDecode := Lib.GetProcAddr('LZ4_freeStreamDecode'); + @LZ4_decompress_safe_continue := + Lib.GetProcAddr('LZ4_decompress_safe_continue'); + @LZ4_createStream := Lib.GetProcAddr('LZ4_createStream'); + @LZ4_freeStream := Lib.GetProcAddr('LZ4_freeStream'); + @LZ4_resetStream := Lib.GetProcAddr('LZ4_resetStream'); + @LZ4_compress_fast_continue := + Lib.GetProcAddr('LZ4_compress_fast_continue'); + @LZ4_createStreamHC := Lib.GetProcAddr('LZ4_createStreamHC'); + @LZ4_freeStreamHC := Lib.GetProcAddr('LZ4_freeStreamHC'); + @LZ4_resetStreamHC := Lib.GetProcAddr('LZ4_resetStreamHC'); + @LZ4_compress_HC_continue := Lib.GetProcAddr('LZ4_compress_HC_continue'); + DLLLoaded := Assigned(LZ4_decompress_safe); + end; +end; + +procedure Deinit; +begin + Lib.Free; +end; + const DLLParam = '--lz4='; diff --git a/imports/LZODLL.pas b/imports/LZODLL.pas index 15d2667..7c82711 100644 --- a/imports/LZODLL.pas +++ b/imports/LZODLL.pas @@ -3,6 +3,7 @@ unit LZODLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils; @@ -60,83 +61,36 @@ var dst: Pointer; dst_len: PNativeUInt; wrkmem: Pointer): integer; cdecl; lzo2a_decompress_safe: function(const src: Pointer; src_len: NativeUInt; dst: Pointer; dst_len: PNativeUInt): integer cdecl; - lzopro_lzo1x_w03_15_compress: function(const src: Pointer; - src_len: NativeUInt; dst: Pointer; dst_len: PNativeUInt; wrkmem: Pointer) - : integer; cdecl; - lzopro_lzo1x_99_compress: function(const src; src_len: integer; var dst; - var dst_len; var cb; compression_level: integer): integer; cdecl; DLLLoaded: Boolean = False; -function lzo1x_99_compress(const src: Pointer; src_len: NativeUInt; - dst: Pointer; dst_len: PNativeUInt; compression_level: integer): integer; - implementation var - DLLHandle: THandle; - -procedure nfree(self: Pointer; ptr: Pointer); cdecl; -begin - FreeMem(ptr); -end; - -function nalloc(self: Pointer; items, size: LongWord): Pointer; cdecl; -var - p: Pointer; -begin - GetMem(p, size * items); - Result := p; -end; - -procedure nprogress(self: Pointer; a, b: LongWord; c: integer); cdecl; -begin -end; - -function lzo1x_99_compress(const src: Pointer; src_len: NativeUInt; - dst: Pointer; dst_len: PNativeUInt; compression_level: integer): integer; -var - mycb: lzo_callback_t; -begin - mycb.nalloc := nalloc; - mycb.nfree := nfree; - mycb.nprogress := nprogress; - Result := lzopro_lzo1x_99_compress(src^, src_len, dst^, dst_len^, mycb, - compression_level); -end; + Lib: TLibImport; procedure Init(Filename: String); begin - if DLLLoaded then - Exit; - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename)); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + Filename); + if Lib.Loaded then begin - @lzo1x_1_compress := GetProcAddress(DLLHandle, 'lzo1x_1_compress'); - @lzo1x_1_11_compress := GetProcAddress(DLLHandle, 'lzo1x_1_11_compress'); - @lzo1x_1_12_compress := GetProcAddress(DLLHandle, 'lzo1x_1_12_compress'); - @lzo1x_1_15_compress := GetProcAddress(DLLHandle, 'lzo1x_1_15_compress'); - @lzo1x_999_compress := GetProcAddress(DLLHandle, 'lzo1x_999_compress'); - @lzo1x_999_compress_level := GetProcAddress(DLLHandle, - 'lzo1x_999_compress_level'); - @lzo1x_decompress_safe := GetProcAddress(DLLHandle, - 'lzo1x_decompress_safe'); - @lzo1c_999_compress := GetProcAddress(DLLHandle, 'lzo1c_999_compress'); - @lzo1c_decompress_safe := GetProcAddress(DLLHandle, - 'lzo1c_decompress_safe'); - @lzo2a_999_compress := GetProcAddress(DLLHandle, 'lzo2a_999_compress'); - @lzo2a_decompress_safe := GetProcAddress(DLLHandle, - 'lzo2a_decompress_safe'); + @lzo1x_1_compress := Lib.GetProcAddr('lzo1x_1_compress'); + @lzo1x_1_11_compress := Lib.GetProcAddr('lzo1x_1_11_compress'); + @lzo1x_1_12_compress := Lib.GetProcAddr('lzo1x_1_12_compress'); + @lzo1x_1_15_compress := Lib.GetProcAddr('lzo1x_1_15_compress'); + @lzo1x_999_compress := Lib.GetProcAddr('lzo1x_999_compress'); + @lzo1x_999_compress_level := Lib.GetProcAddr('lzo1x_999_compress_level'); + @lzo1x_decompress_safe := Lib.GetProcAddr('lzo1x_decompress_safe'); + @lzo1c_999_compress := Lib.GetProcAddr('lzo1c_999_compress'); + @lzo1c_decompress_safe := Lib.GetProcAddr('lzo1c_decompress_safe'); + @lzo2a_999_compress := Lib.GetProcAddr('lzo2a_999_compress'); + @lzo2a_decompress_safe := Lib.GetProcAddr('lzo2a_decompress_safe'); DLLLoaded := Assigned(lzo1x_decompress_safe); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - Exit; - FreeLibrary(DLLHandle); + Lib.Free; end; const diff --git a/imports/OodleDLL.pas b/imports/OodleDLL.pas index 865c545..eb0c18a 100644 --- a/imports/OodleDLL.pas +++ b/imports/OodleDLL.pas @@ -3,6 +3,7 @@ unit OodleDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Types, System.IOUtils; @@ -72,57 +73,42 @@ function OodleLZ_GetCompressedBufferSizeNeeded(compressor: Byte; implementation var - DLLHandle: THandle; + Lib: TLibImport; OldCompress, OldCompressOptions_GetDefault, OldGetCompressedBufferSizeNeeded: Boolean; - DLLs: TStringDynArray; procedure Init(Filename: String); var I: Integer; C: Cardinal; begin - if DLLLoaded then - Exit; - DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'oo2core*.dll', - TSearchOption.soTopDirectoryOnly); - Insert(ExtractFilePath(ParamStr(0)) + Filename, DLLs, 0); - for I := Low(DLLs) to High(DLLs) do - begin - DLLHandle := LoadLibrary(PChar(DLLs[I])); - if DLLHandle >= 32 then - break; - end; - if DLLHandle < 32 then - begin - DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'oo2ext*.dll', - TSearchOption.soTopDirectoryOnly); - for I := Low(DLLs) to High(DLLs) do + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + Filename); + if not Lib.Loaded then + for I := 3 to 9 do begin - DLLHandle := LoadLibrary(PChar(DLLs[I])); - if DLLHandle >= 32 then + Lib.Free; + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'oo2core_' + + I.ToString + '_win64.dll'); + if Lib.Loaded then break; end; - end; - if DLLHandle < 32 then - begin - DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'oodle2*.dll', - TSearchOption.soTopDirectoryOnly); - for I := Low(DLLs) to High(DLLs) do + if not Lib.Loaded then + for I := 3 to 9 do begin - DLLHandle := LoadLibrary(PChar(DLLs[I])); - if DLLHandle >= 32 then + Lib.Free; + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'oo2ext_' + + I.ToString + '_win64.dll'); + if Lib.Loaded then break; end; - end; - if DLLHandle >= 32 then + if Lib.Loaded then begin - Oodle_CheckVersion := GetProcAddress(DLLHandle, 'Oodle_CheckVersion'); + Oodle_CheckVersion := Lib.GetProcAddr('Oodle_CheckVersion'); if not Assigned(Oodle_CheckVersion) then for I := 0 to 32 do begin - @Oodle_CheckVersion := GetProcAddress(DLLHandle, - PChar('_Oodle_CheckVersion@' + (I * 2).ToString)); + @Oodle_CheckVersion := + Lib.GetProcAddr(PAnsiChar('_Oodle_CheckVersion@' + (I * 2).ToString)); if Assigned(Oodle_CheckVersion) then break; end; @@ -131,61 +117,57 @@ begin OldCompress := LongRec(C).Hi < $2E06; OldGetCompressedBufferSizeNeeded := LongRec(C).Hi < $2E08; OldCompressOptions_GetDefault := LongRec(C).Hi < $2E08; - @OodleLZ_Compress_1 := GetProcAddress(DLLHandle, 'OodleLZ_Compress'); + @OodleLZ_Compress_1 := Lib.GetProcAddr('OodleLZ_Compress'); if not Assigned(OodleLZ_Compress_1) then for I := 0 to 32 do begin - @OodleLZ_Compress_1 := GetProcAddress(DLLHandle, - PChar('_OodleLZ_Compress@' + (I * 2).ToString)); + @OodleLZ_Compress_1 := + Lib.GetProcAddr(PAnsiChar('_OodleLZ_Compress@' + (I * 2).ToString)); if Assigned(OodleLZ_Compress_1) then break; end; @OodleLZ_Compress_2 := @OodleLZ_Compress_1; - OodleLZ_Decompress := GetProcAddress(DLLHandle, 'OodleLZ_Decompress'); + OodleLZ_Decompress := Lib.GetProcAddr('OodleLZ_Decompress'); if not Assigned(OodleLZ_Decompress) then for I := 0 to 32 do begin - @OodleLZ_Decompress := GetProcAddress(DLLHandle, - PChar('_OodleLZ_Decompress@' + (I * 2).ToString)); + @OodleLZ_Decompress := + Lib.GetProcAddr(PAnsiChar('_OodleLZ_Decompress@' + (I * 2).ToString)); if Assigned(OodleLZ_Decompress) then break; end; - OodleLZ_CompressOptions_GetDefault_1 := GetProcAddress(DLLHandle, - 'OodleLZ_CompressOptions_GetDefault'); + OodleLZ_CompressOptions_GetDefault_1 := + Lib.GetProcAddr('OodleLZ_CompressOptions_GetDefault'); if not Assigned(OodleLZ_CompressOptions_GetDefault_1) then for I := 0 to 32 do begin @OodleLZ_CompressOptions_GetDefault_1 := - GetProcAddress(DLLHandle, PChar('_OodleLZ_CompressOptions_GetDefault@' - + (I * 2).ToString)); + Lib.GetProcAddr(PAnsiChar('_OodleLZ_CompressOptions_GetDefault@' + + (I * 2).ToString)); if Assigned(OodleLZ_CompressOptions_GetDefault_1) then break; end; @OodleLZ_CompressOptions_GetDefault_2 := @OodleLZ_CompressOptions_GetDefault_1; OodleLZ_GetCompressedBufferSizeNeeded_1 := - GetProcAddress(DLLHandle, 'OodleLZ_GetCompressedBufferSizeNeeded'); + Lib.GetProcAddr('OodleLZ_GetCompressedBufferSizeNeeded'); if not Assigned(OodleLZ_GetCompressedBufferSizeNeeded_1) then for I := 0 to 32 do begin @OodleLZ_GetCompressedBufferSizeNeeded_1 := - GetProcAddress(DLLHandle, - PChar('_OodleLZ_GetCompressedBufferSizeNeeded@' + (I * 2).ToString)); + Lib.GetProcAddr(PAnsiChar('_OodleLZ_GetCompressedBufferSizeNeeded@' + + (I * 2).ToString)); if Assigned(OodleLZ_GetCompressedBufferSizeNeeded_1) then break; end; @OodleLZ_GetCompressedBufferSizeNeeded_2 := @OodleLZ_GetCompressedBufferSizeNeeded_1; - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - Exit; - FreeLibrary(DLLHandle); + Lib.Free; end; function OodleLZ_Compress(compressor: Integer; rawBuf: Pointer; @@ -228,7 +210,7 @@ var initialization -DLLFile := 'oodle.dll'; +DLLFile := 'oo2core_9_win64.dll'; for I := 1 to ParamCount do if ParamStr(I).StartsWith(DLLParam) then begin diff --git a/imports/PackJPGDLL.pas b/imports/PackJPGDLL.pas index b1dbe99..bf63698 100644 --- a/imports/PackJPGDLL.pas +++ b/imports/PackJPGDLL.pas @@ -3,6 +3,7 @@ unit PackJPGDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -25,35 +26,28 @@ var implementation var - DLLHandle: THandle; + Lib: TLibImport; procedure Init; begin - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'packjpg_dll.dll')); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'packjpg_dll.dll'); + if Lib.Loaded then begin - @pjglib_convert_stream2stream := GetProcAddress(DLLHandle, - 'pjglib_convert_stream2stream'); - @pjglib_convert_file2file := GetProcAddress(DLLHandle, - 'pjglib_convert_file2file'); - @pjglib_convert_stream2mem := GetProcAddress(DLLHandle, - 'pjglib_convert_stream2mem'); - @pjglib_init_streams := GetProcAddress(DLLHandle, 'pjglib_init_streams'); - @pjglib_version_info := GetProcAddress(DLLHandle, 'pjglib_version_info'); - @pjglib_short_name := GetProcAddress(DLLHandle, 'pjglib_short_name'); + @pjglib_convert_stream2stream := + Lib.GetProcAddr('pjglib_convert_stream2stream'); + @pjglib_convert_file2file := Lib.GetProcAddr('pjglib_convert_file2file'); + @pjglib_convert_stream2mem := Lib.GetProcAddr('pjglib_convert_stream2mem'); + @pjglib_init_streams := Lib.GetProcAddr('pjglib_init_streams'); + @pjglib_version_info := Lib.GetProcAddr('pjglib_version_info'); + @pjglib_short_name := Lib.GetProcAddr('pjglib_short_name'); DLLLoaded := Assigned(pjglib_init_streams) and Assigned(pjglib_convert_stream2stream); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/PreflateDLL.pas b/imports/PreflateDLL.pas index 7f2d949..3bd6702 100644 --- a/imports/PreflateDLL.pas +++ b/imports/PreflateDLL.pas @@ -3,6 +3,7 @@ unit PreflateDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -18,27 +19,22 @@ var implementation var - DLLHandle: THandle; + Lib: TLibImport; procedure Init; begin - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'preflate_dll.dll')); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'preflate_dll.dll'); + if Lib.Loaded then begin - @preflate_decode := GetProcAddress(DLLHandle, 'decode'); - @preflate_reencode := GetProcAddress(DLLHandle, 'reencode'); + @preflate_decode := Lib.GetProcAddr('decode'); + @preflate_reencode := Lib.GetProcAddr('reencode'); DLLLoaded := Assigned(preflate_decode) and Assigned(preflate_reencode); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/ReflateDLL.pas b/imports/ReflateDLL.pas index 72efb9c..7b050fa 100644 --- a/imports/ReflateDLL.pas +++ b/imports/ReflateDLL.pas @@ -3,6 +3,7 @@ unit ReflateDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -25,41 +26,35 @@ var implementation var - DLLHandle1, DLLHandle2: THandle; + Lib1, Lib2: TLibImport; procedure Init; begin - DLLHandle1 := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'RAW2HIF_DLL.DLL')); - DLLHandle2 := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + - 'HIF2RAW_DLL.DLL')); - if (DLLHandle1 >= 32) and (DLLHandle2 >= 32) then + Lib1 := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'RAW2HIF_DLL.DLL'); + Lib2 := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'HIF2RAW_DLL.DLL'); + if Lib1.Loaded and Lib2.Loaded then begin - @raw2hif_Alloc := GetProcAddress(DLLHandle1, 'raw2hif_Alloc'); - @raw2hif_Free := GetProcAddress(DLLHandle1, 'raw2hif_Free'); - @raw2hif_Init := GetProcAddress(DLLHandle1, 'raw2hif_Init'); - @raw2hif_Loop := GetProcAddress(DLLHandle1, 'raw2hif_Loop'); - @raw2hif_getoutlen := GetProcAddress(DLLHandle1, 'raw2hif_getoutlen'); - @raw2hif_getou2len := GetProcAddress(DLLHandle1, 'raw2hif_getou2len'); - @raw2hif_addbuf := GetProcAddress(DLLHandle1, 'raw2hif_addbuf'); - @hif2raw_Alloc := GetProcAddress(DLLHandle2, 'hif2raw_Alloc'); - @hif2raw_Free := GetProcAddress(DLLHandle2, 'hif2raw_Free'); - @hif2raw_Init := GetProcAddress(DLLHandle2, 'hif2raw_Init'); - @hif2raw_Loop := GetProcAddress(DLLHandle2, 'hif2raw_Loop'); - @hif2raw_getoutlen := GetProcAddress(DLLHandle2, 'hif2raw_getoutlen'); - @hif2raw_addbuf := GetProcAddress(DLLHandle2, 'hif2raw_addbuf'); + @raw2hif_Alloc := Lib1.GetProcAddr('raw2hif_Alloc'); + @raw2hif_Free := Lib1.GetProcAddr('raw2hif_Free'); + @raw2hif_Init := Lib1.GetProcAddr('raw2hif_Init'); + @raw2hif_Loop := Lib1.GetProcAddr('raw2hif_Loop'); + @raw2hif_getoutlen := Lib1.GetProcAddr('raw2hif_getoutlen'); + @raw2hif_getou2len := Lib1.GetProcAddr('raw2hif_getou2len'); + @raw2hif_addbuf := Lib1.GetProcAddr('raw2hif_addbuf'); + @hif2raw_Alloc := Lib2.GetProcAddr('hif2raw_Alloc'); + @hif2raw_Free := Lib2.GetProcAddr('hif2raw_Free'); + @hif2raw_Init := Lib2.GetProcAddr('hif2raw_Init'); + @hif2raw_Loop := Lib2.GetProcAddr('hif2raw_Loop'); + @hif2raw_getoutlen := Lib2.GetProcAddr('hif2raw_getoutlen'); + @hif2raw_addbuf := Lib2.GetProcAddr('hif2raw_addbuf'); DLLLoaded := Assigned(raw2hif_Alloc) and Assigned(hif2raw_Alloc); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - FreeLibrary(DLLHandle1); - FreeLibrary(DLLHandle2); + Lib1.Free; + Lib2.Free; end; initialization diff --git a/imports/XDeltaDLL.pas b/imports/XDeltaDLL.pas index c7ff24e..41fbe39 100644 --- a/imports/XDeltaDLL.pas +++ b/imports/XDeltaDLL.pas @@ -3,7 +3,7 @@ unit XDeltaDLL; interface uses - MemoryModule, + LibImport, WinAPI.Windows, System.SysUtils, System.Classes; @@ -37,34 +37,25 @@ var implementation -uses - Utils; - var - DLLStream: TResourceStream; - DLLHandle: TMemoryModule; + Lib: TLibImport; procedure Init; begin - DLLStream := TResourceStream.Create(HInstance, 'xdelta3_dll', RT_RCDATA); - DLLHandle := MemoryLoadLibary(DLLStream.Memory); - if Assigned(DLLHandle) then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'xdelta3_dll.dll'); + if Lib.Loaded then begin DLLLoaded := True; - @xd3_encode := MemoryGetProcAddress(DLLHandle, 'xd3_encode'); + @xd3_encode := Lib.GetProcAddr('xd3_encode'); Assert(@xd3_encode <> nil); - @xd3_decode := MemoryGetProcAddress(DLLHandle, 'xd3_decode'); + @xd3_decode := Lib.GetProcAddr('xd3_decode'); Assert(@xd3_decode <> nil); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - exit; - MemoryFreeLibrary(DLLHandle); + Lib.Free; end; initialization diff --git a/imports/ZLibDLL.pas b/imports/ZLibDLL.pas index e7387fb..68fd4ff 100644 --- a/imports/ZLibDLL.pas +++ b/imports/ZLibDLL.pas @@ -3,6 +3,7 @@ unit ZLibDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils, System.Types, System.IOUtils, System.ZLib; @@ -86,55 +87,8 @@ function inflateReset(var strm: z_stream): integer; implementation var - DLLHandle: THandle; + Lib: TLibImport; WinAPIDLL: boolean; - DLLs: TStringDynArray; - -procedure Init(Filename: String); -var - I: integer; -begin - if DLLLoaded then - Exit; - DLLs := TDirectory.GetFiles(ExtractFilePath(ParamStr(0)), 'zlib*.dll', - TSearchOption.soTopDirectoryOnly); - Insert(ExtractFilePath(ParamStr(0)) + 'zlib.dll', DLLs, Length(DLLs)); - Insert(ExtractFilePath(ParamStr(0)) + Filename, DLLs, 0); - for I := Low(DLLs) to High(DLLs) do - begin - DLLHandle := LoadLibrary(PChar(DLLs[I])); - if (DLLHandle >= 32) and Assigned(GetProcAddress(DLLHandle, 'zlibVersion')) - then - break; - end; - if DLLHandle >= 32 then - begin - DLLLoaded := True; - @_zlibVersion := GetProcAddress(DLLHandle, 'zlibVersion'); - @_zlibCompileFlags := GetProcAddress(DLLHandle, 'zlibCompileFlags'); - DLLLoaded := Assigned(_zlibVersion) and Assigned(_zlibCompileFlags); - if DLLLoaded then - begin - WinAPIDLL := _zlibCompileFlags and $400 = $400; - if WinAPIDLL then - begin - @s_deflateInit2_ := GetProcAddress(DLLHandle, 'deflateInit2_'); - @s_deflate := GetProcAddress(DLLHandle, 'deflate'); - @s_deflateEnd := GetProcAddress(DLLHandle, 'deflateEnd'); - @s_deflateReset := GetProcAddress(DLLHandle, 'deflateReset'); - end - else - begin - @c_deflateInit2_ := GetProcAddress(DLLHandle, 'deflateInit2_'); - @c_deflate := GetProcAddress(DLLHandle, 'deflate'); - @c_deflateEnd := GetProcAddress(DLLHandle, 'deflateEnd'); - @c_deflateReset := GetProcAddress(DLLHandle, 'deflateReset'); - end; - end; - end - else - DLLLoaded := False; -end; function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, strategy: integer): integer; @@ -192,11 +146,49 @@ begin Result := System.ZLib.inflateReset(strm); end; +procedure Init(Filename: String); +begin + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + Filename); + if not(Lib.Loaded and Assigned(Lib.GetProcAddr('zlibVersion'))) then + begin + Lib.Free; + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'zlibwapi.dll'); + end; + if not(Lib.Loaded and Assigned(Lib.GetProcAddr('zlibVersion'))) then + begin + Lib.Free; + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + 'zlib1.dll'); + end; + if Lib.Loaded and Assigned(Lib.GetProcAddr('zlibVersion')) then + begin + DLLLoaded := True; + @_zlibVersion := Lib.GetProcAddr('zlibVersion'); + @_zlibCompileFlags := Lib.GetProcAddr('zlibCompileFlags'); + DLLLoaded := Assigned(_zlibVersion) and Assigned(_zlibCompileFlags); + if DLLLoaded then + begin + WinAPIDLL := _zlibCompileFlags and $400 = $400; + if WinAPIDLL then + begin + @s_deflateInit2_ := Lib.GetProcAddr('deflateInit2_'); + @s_deflate := Lib.GetProcAddr('deflate'); + @s_deflateEnd := Lib.GetProcAddr('deflateEnd'); + @s_deflateReset := Lib.GetProcAddr('deflateReset'); + end + else + begin + @c_deflateInit2_ := Lib.GetProcAddr('deflateInit2_'); + @c_deflate := Lib.GetProcAddr('deflate'); + @c_deflateEnd := Lib.GetProcAddr('deflateEnd'); + @c_deflateReset := Lib.GetProcAddr('deflateReset'); + end; + end; + end; +end; + procedure Deinit; begin - if not DLLLoaded then - Exit; - FreeLibrary(DLLHandle); + Lib.Free; end; const diff --git a/imports/ZSTDDLL.pas b/imports/ZSTDDLL.pas index 480e454..522324b 100644 --- a/imports/ZSTDDLL.pas +++ b/imports/ZSTDDLL.pas @@ -3,6 +3,7 @@ unit ZSTDDLL; interface uses + LibImport, WinAPI.Windows, System.SysUtils; @@ -142,54 +143,45 @@ begin end; var - DLLHandle: THandle; + Lib: TLibImport; procedure Init(Filename: String); begin - if DLLLoaded then - Exit; - DLLHandle := LoadLibrary(PChar(ExtractFilePath(ParamStr(0)) + Filename)); - if DLLHandle >= 32 then + Lib := TLibImport.Create(ExtractFilePath(ParamStr(0)) + Filename); + if Lib.Loaded then begin - @ZSTD_compress := GetProcAddress(DLLHandle, 'ZSTD_compress'); - @ZSTD_compress2 := GetProcAddress(DLLHandle, 'ZSTD_compress2'); - @ZSTD_decompress := GetProcAddress(DLLHandle, 'ZSTD_decompress'); - @ZSTD_findFrameCompressedSize := GetProcAddress(DLLHandle, - 'ZSTD_findFrameCompressedSize'); - @ZSTD_findDecompressedSize := GetProcAddress(DLLHandle, - 'ZSTD_findDecompressedSize'); - @ZSTD_createCCtx := GetProcAddress(DLLHandle, 'ZSTD_createCCtx'); - @ZSTD_freeCCtx := GetProcAddress(DLLHandle, 'ZSTD_freeCCtx'); - @ZSTD_CCtx_reset := GetProcAddress(DLLHandle, 'ZSTD_CCtx_reset'); - @ZSTD_CCtx_setParameter := GetProcAddress(DLLHandle, - 'ZSTD_CCtx_setParameter'); - @ZSTD_createDCtx := GetProcAddress(DLLHandle, 'ZSTD_createDCtx'); - @ZSTD_freeDCtx := GetProcAddress(DLLHandle, 'ZSTD_freeDCtx'); - @ZSTD_createCDict := GetProcAddress(DLLHandle, 'ZSTD_createCDict'); - @ZSTD_freeCDict := GetProcAddress(DLLHandle, 'ZSTD_freeCDict'); - @ZSTD_compressCCtx := GetProcAddress(DLLHandle, 'ZSTD_compressCCtx'); - @ZSTD_createDDict := GetProcAddress(DLLHandle, 'ZSTD_createDDict'); - @ZSTD_freeDDict := GetProcAddress(DLLHandle, 'ZSTD_freeDDict'); - @ZSTD_decompressDCtx := GetProcAddress(DLLHandle, 'ZSTD_decompressDCtx'); - @ZSTD_compress_usingCDict := GetProcAddress(DLLHandle, - 'ZSTD_compress_usingCDict'); - @ZSTD_decompress_usingDDict := GetProcAddress(DLLHandle, - 'ZSTD_decompress_usingDDict'); - @ZSTD_initCStream := GetProcAddress(DLLHandle, 'ZSTD_initCStream'); - @ZSTD_compressStream := GetProcAddress(DLLHandle, 'ZSTD_compressStream'); - @ZSTD_flushStream := GetProcAddress(DLLHandle, 'ZSTD_flushStream'); - @ZSTD_endStream := GetProcAddress(DLLHandle, 'ZSTD_endStream'); + @ZSTD_compress := Lib.GetProcAddr('ZSTD_compress'); + @ZSTD_compress2 := Lib.GetProcAddr('ZSTD_compress2'); + @ZSTD_decompress := Lib.GetProcAddr('ZSTD_decompress'); + @ZSTD_findFrameCompressedSize := + Lib.GetProcAddr('ZSTD_findFrameCompressedSize'); + @ZSTD_findDecompressedSize := Lib.GetProcAddr('ZSTD_findDecompressedSize'); + @ZSTD_createCCtx := Lib.GetProcAddr('ZSTD_createCCtx'); + @ZSTD_freeCCtx := Lib.GetProcAddr('ZSTD_freeCCtx'); + @ZSTD_CCtx_reset := Lib.GetProcAddr('ZSTD_CCtx_reset'); + @ZSTD_CCtx_setParameter := Lib.GetProcAddr('ZSTD_CCtx_setParameter'); + @ZSTD_createDCtx := Lib.GetProcAddr('ZSTD_createDCtx'); + @ZSTD_freeDCtx := Lib.GetProcAddr('ZSTD_freeDCtx'); + @ZSTD_createCDict := Lib.GetProcAddr('ZSTD_createCDict'); + @ZSTD_freeCDict := Lib.GetProcAddr('ZSTD_freeCDict'); + @ZSTD_compressCCtx := Lib.GetProcAddr('ZSTD_compressCCtx'); + @ZSTD_createDDict := Lib.GetProcAddr('ZSTD_createDDict'); + @ZSTD_freeDDict := Lib.GetProcAddr('ZSTD_freeDDict'); + @ZSTD_decompressDCtx := Lib.GetProcAddr('ZSTD_decompressDCtx'); + @ZSTD_compress_usingCDict := Lib.GetProcAddr('ZSTD_compress_usingCDict'); + @ZSTD_decompress_usingDDict := + Lib.GetProcAddr('ZSTD_decompress_usingDDict'); + @ZSTD_initCStream := Lib.GetProcAddr('ZSTD_initCStream'); + @ZSTD_compressStream := Lib.GetProcAddr('ZSTD_compressStream'); + @ZSTD_flushStream := Lib.GetProcAddr('ZSTD_flushStream'); + @ZSTD_endStream := Lib.GetProcAddr('ZSTD_endStream'); DLLLoaded := Assigned(ZSTD_compress) and Assigned(ZSTD_decompress); - end - else - DLLLoaded := False; + end; end; procedure Deinit; begin - if not DLLLoaded then - Exit; - FreeLibrary(DLLHandle); + Lib.Free; end; const diff --git a/precompressor/PrecompEXE.pas b/precompressor/PrecompEXE.pas index 9dfca77..589382b 100644 --- a/precompressor/PrecompEXE.pas +++ b/precompressor/PrecompEXE.pas @@ -274,7 +274,6 @@ begin S := ReplaceText(S, '', StreamInfo^.OldSize.ToString); S := ReplaceText(S, '', StreamInfo^.NewSize.ToString); Res := 0; - Res := 0; if ContainsText(S, '') and Funcs^.GetResource(StreamInfo^.Resource, nil, @Res) and (Res > 0) then begin @@ -680,7 +679,7 @@ var Bytes: TBytes; Ini: TMemIniFile; SL: TStringList; - ExeStruct: PExeStruct; + ExeStruct: TExeStruct; Y, Z: Integer; List: TStringDynArray; @@ -699,80 +698,84 @@ begin GetCmdStr(Ini.ReadString(SL[I], 'Decode', ''), 0)) then for K := Low(List) to High(List) do begin - New(ExeStruct); Insert(List[K], Codec.Names, Length(Codec.Names)); - ExeStruct^.Name := List[K]; - Bytes := BytesOf(ExeStruct^.Name); - ExeStruct^.ID := Utils.Hash32(0, @Bytes[0], Length(Bytes)); + ExeStruct.Name := List[K]; + Bytes := BytesOf(ExeStruct.Name); + ExeStruct.ID := Utils.Hash32(0, @Bytes[0], Length(Bytes)); for X := 0 to 1 do begin - ExeStruct^.IsLib[X] := False; + ExeStruct.IsLib[X] := False; if X = 0 then S1 := Ini.ReadString(SL[I], 'Encode', '') else S1 := Ini.ReadString(SL[I], 'Decode', ''); S1 := ReplaceText(S1, '', List[K]); - ExeStruct^.Exec[X] := ExtractFilePath(Utils.GetModuleName) + + ExeStruct.Exec[X] := ExtractFilePath(Utils.GetModuleName) + GetCmdStr(S1, 0); - ExeStruct^.Param[X] := ''; - ExeStruct^.Mode[X] := 0; + ExeStruct.Param[X] := ''; + ExeStruct.Mode[X] := 0; for J := 1 to GetCmdCount(S1) - 1 do begin S2 := GetCmdStr(S1, J); if ContainsText(S2, '') then begin - SetBits(ExeStruct^.Mode[X], STDIO_MODE, 0, 2); - ExeStruct^.IsLib[X] := True; + SetBits(ExeStruct.Mode[X], STDIO_MODE, 0, 2); + ExeStruct.IsLib[X] := True; continue; end else if ContainsText(S2, '') or ContainsText(S2, '[stdin]') then begin - SetBits(ExeStruct^.Mode[X], 1, 0, 1); + SetBits(ExeStruct.Mode[X], 1, 0, 1); continue; end else if ContainsText(S2, '') or ContainsText(S2, '[stdout]') then begin - SetBits(ExeStruct^.Mode[X], 1, 1, 1); + SetBits(ExeStruct.Mode[X], 1, 1, 1); continue; end else if ContainsText(S2, '') or ContainsText(S2, '[filein]') then begin S3 := IfThen(X = 0, FILE_IN, FILE_OUT); - SetBits(ExeStruct^.Mode[X], 0, 0, 1); + SetBits(ExeStruct.Mode[X], 0, 0, 1); if ContainsText(S2, '') then - ExeStruct^.InFile[X] := ExtractStr('', S2) + ExeStruct.InFile[X] := ExtractStr('', S2) else - ExeStruct^.InFile[X] := ExtractStr('[filein]', S2); - S2 := ReplaceText(S2, ExeStruct^.InFile[X], S3); - ExeStruct^.InFile[X] := ReplaceText(ExeStruct^.InFile[X], + ExeStruct.InFile[X] := ExtractStr('[filein]', S2); + S2 := ReplaceText(S2, ExeStruct.InFile[X], S3); + ExeStruct.InFile[X] := ReplaceText(ExeStruct.InFile[X], '', S3); - ExeStruct^.InFile[X] := ReplaceText(ExeStruct^.InFile[X], + ExeStruct.InFile[X] := ReplaceText(ExeStruct.InFile[X], '[filein]', S3); + S2 := ExeStruct.InFile[X]; + if ContainsText(S2, '[filein]') then + continue; end else if ContainsText(S2, '') or ContainsText(S2, '[fileout]') then begin S3 := IfThen(X = 0, FILE_OUT, FILE_IN); - SetBits(ExeStruct^.Mode[X], 0, 1, 1); + SetBits(ExeStruct.Mode[X], 0, 1, 1); if ContainsText(S2, '') then - ExeStruct^.OutFile[X] := ExtractStr('', S2) + ExeStruct.OutFile[X] := ExtractStr('', S2) else - ExeStruct^.OutFile[X] := ExtractStr('[fileout]', S2); - S2 := ReplaceText(S2, ExeStruct^.OutFile[X], S3); - ExeStruct^.OutFile[X] := ReplaceText(ExeStruct^.OutFile[X], + ExeStruct.OutFile[X] := ExtractStr('[fileout]', S2); + ExeStruct.OutFile[X] := ReplaceText(ExeStruct.OutFile[X], '', S3); - ExeStruct^.OutFile[X] := ReplaceText(ExeStruct^.OutFile[X], + ExeStruct.OutFile[X] := ReplaceText(ExeStruct.OutFile[X], '[fileout]', S3); + S2 := ExeStruct.OutFile[X]; + if ContainsText(S2, '[fileout]') then + continue; end; S2 := IfThen((Pos(' ', S2) > 0) or (S2 = ''), '"' + S2 + '"', S2); - ExeStruct^.Param[X] := ExeStruct^.Param[X] + ' ' + S2; + ExeStruct.Param[X] := ExeStruct.Param[X] + ' ' + S2; end; - ExeStruct^.Param[X] := Trim(ExeStruct^.Param[X]); + ExeStruct.Param[X] := Trim(ExeStruct.Param[X]); end; - Insert(ExeStruct^, CodecExe, Length(CodecExe)); + Insert(ExeStruct, CodecExe, Length(CodecExe)); end; end; SL.Free; diff --git a/precompressor/PrecompLZ4.pas b/precompressor/PrecompLZ4.pas index a407415..5d82f21 100644 --- a/precompressor/PrecompLZ4.pas +++ b/precompressor/PrecompLZ4.pas @@ -3,9 +3,11 @@ unit PrecompLZ4; interface uses - LZ4DLL, XDeltaDLL, + LZ4DLL, + lz4, Utils, PrecompUtils, + WinAPI.Windows, System.SysUtils, System.StrUtils, System.Classes, System.Math; var @@ -163,7 +165,8 @@ procedure LZ4Scan1(Instance, Depth: Integer; Input: PByte; Funcs: PPrecompFuncs); var Buffer: PByte; - X, Y: Integer; + Pos: NativeInt; + X, Y, Z: Integer; SI: _StrInfo1; DI1, DI2: TDepthInfo; DS: TPrecompStr; @@ -173,8 +176,10 @@ begin if DS <> '' then begin X := IndexTextW(@DS[0], LZ4Codecs); - if (X < 0) or (DI1.OldSize <> SizeEx) then + if X < 0 then exit; + if DI1.OldSize = 0 then + DI1.OldSize := SizeEx; if not CodecAvailable[X] then exit; Y := Max(DI1.NewSize, L_MAXSIZE); @@ -212,6 +217,71 @@ begin end; if BoolArray(CodecEnabled, False) then exit; + Buffer := Funcs^.Allocator(Instance, L_MAXSIZE); + Pos := 0; + while Pos < Size do + begin + if CodecEnabled[LZ4_CODEC] or + (CodecEnabled[LZ4HC_CODEC] and (SOList[Instance][LZ4HC_CODEC].Count = 1)) + then + begin + Y := LZ4_decompress_safe(Input + Pos, Buffer, SizeEx - Pos, L_MAXSIZE); + if Abs(Y) > 256 then + begin + try + X := LZ4_decompress_generic(Input + Pos, Buffer, SizeEx - Pos, Abs(Y), + Integer(endOnOutputSize)); + except + X := 0; + end; + // X := Abs(X); + Y := Abs(Y); + if (Round(X * 1.4) < Y) and (X < Y) and (X > 256) then + begin + Output(Instance, Buffer, Y); + SI.Position := Pos; + SI.OldSize := X; + SI.NewSize := Y; + SI.Option := 0; + if CodecEnabled[LZ4_CODEC] then + SetBits(SI.Option, LZ4_CODEC, 0, 5) + else + SetBits(SI.Option, LZ4HC_CODEC, 0, 5); + SI.Status := TStreamStatus.None; + Funcs^.LogScan1(LZ4Codecs[GetBits(SI.Option, 0, 5)], SI.Position, + SI.OldSize, SI.NewSize); + Add(Instance, @SI, nil, nil); + Inc(Pos, 256); + continue; + end; + end; + end; + if CodecEnabled[LZ4F_CODEC] then + if PCardinal(Input + Pos)^ = $184D2204 then + begin + Y := LZ4F_decompress_safe(Input + Pos, Buffer, SizeEx - Pos, + L_MAXSIZE, @X, @Z); + if (X < Y) then + begin + Output(Instance, Buffer, Y); + SI.Position := Pos; + SI.OldSize := X; + SI.NewSize := Y; + SI.Option := 0; + SetBits(SI.Option, LZ4F_CODEC, 0, 5); + SetBits(SI.Option, Z - 4, 12, 2); + SetBits(SI.Option, 0, 14, 1); + SetBits(SI.Option, LAcceleration, 15, 7); + SI.Status := TStreamStatus.None; + Funcs^.LogScan1(LZ4Codecs[GetBits(SI.Option, 0, 5)], SI.Position, + SI.OldSize, SI.NewSize); + Add(Instance, @SI, nil, nil); + Inc(Pos, SI.OldSize); + continue; + end; + end; + Inc(Pos); + end; end; function LZ4Scan2(Instance, Depth: Integer; Input: Pointer; Size: NativeInt; @@ -271,7 +341,7 @@ begin if GetBits(StreamInfo^.Option, 5, 7) <> I then continue; if (StreamInfo^.Status = TStreamStatus.Database) and - (GetBits(StreamInfo^.Option, 1, 31) = 0) then + (GetBits(StreamInfo^.Option, 31, 1) = 0) then begin Res1 := StreamInfo^.OldSize; Result := True; @@ -283,6 +353,8 @@ begin begin Params := 'a' + GetBits(StreamInfo^.Option, 15, 7).ToString; if not Result then + { Res1 := LZ4_compress_block(NewInput, Buffer, + StreamInfo^.NewSize, Y); } Res1 := LZ4_compress_fast(NewInput, Buffer, StreamInfo^.NewSize, Y, GetBits(StreamInfo^.Option, 15, 7)); end; @@ -314,7 +386,7 @@ begin StreamInfo^.OldSize); Funcs^.LogProcess(LZ4Codecs[GetBits(StreamInfo^.Option, 0, 5)], PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result); - if Result or (StreamInfo^.Status = TStreamStatus.Predicted) then + if Result or (StreamInfo^.Status >= TStreamStatus.Predicted) then break; end; if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or diff --git a/precompressor/PrecompLZO.pas b/precompressor/PrecompLZO.pas index f5d8e80..99ccddc 100644 --- a/precompressor/PrecompLZO.pas +++ b/precompressor/PrecompLZO.pas @@ -3,7 +3,7 @@ unit PrecompLZO; interface uses - LZODLL, XDeltaDLL, + LZODLL, Utils, PrecompUtils, System.SysUtils, System.Classes, System.Math; @@ -14,19 +14,25 @@ var implementation const - LZOCodecs: array of PChar = ['lzo1x']; - CODEC_COUNT = 1; + LZOCodecs: array of PChar = ['lzo1x', 'lzo2a', 'lzo1c']; + CODEC_COUNT = 3; LZO1X_CODEC = 0; + LZO2A_CODEC = 1; + LZO1C_CODEC = 2; const L_WORKMEM = 524288; L_MAXSIZE = 16 * 1024 * 1024; - LZO1X_999 = 0; + LZO1X_999 = 999; + LZO2A_999 = 999; + LZO1C_999 = 999; var SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList; WrkMem: array of array [0 .. L_WORKMEM - 1] of Byte; LZO1XVariant: Integer = LZO1X_999; + LZO2AVariant: Integer = LZO2A_999; + LZO1CVariant: Integer = LZO1C_999; CodecAvailable, CodecEnabled: TArray; type @@ -39,7 +45,7 @@ type var LZOSB: array of Byte = [$11, $00, $00]; -function GetLZOSI(InBuff: Pointer; InSize: Integer; OutBuff: Pointer; +function GetLZO1XSI(InBuff: Pointer; InSize: Integer; OutBuff: Pointer; OutSize: Integer; StreamInfo: PLZOSI): Boolean; const MinSize = 256; @@ -123,11 +129,25 @@ begin begin CodecEnabled[LZO1X_CODEC] := True; if Funcs^.GetParam(Command, X, 'v') = '999' then - LZO1XVariant := 0; + LZO1XVariant := 999; if Funcs^.GetParam(Command, X, 'l') <> '' then for I := Low(SOList) to High(SOList) do SOList[I][LZO1X_CODEC].Update ([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True); + end + else if (CompareText(S, LZOCodecs[LZO2A_CODEC]) = 0) and LZODLL.DLLLoaded + then + begin + CodecEnabled[LZO2A_CODEC] := True; + if Funcs^.GetParam(Command, X, 'v') = '999' then + LZO2AVariant := 999; + end + else if (CompareText(S, LZOCodecs[LZO1C_CODEC]) = 0) and LZODLL.DLLLoaded + then + begin + CodecEnabled[LZO1C_CODEC] := True; + if Funcs^.GetParam(Command, X, 'v') = '999' then + LZO1CVariant := 999; end; Inc(X); end; @@ -135,9 +155,14 @@ begin for I := 1 to 9 do Insert(I, Options, Length(Options)); for X := Low(SOList) to High(SOList) do - for Y := Low(SOList[X]) to High(SOList[X]) do - if SOList[X, Y].Count = 0 then - SOList[X, Y].Update(Options); + if SOList[X, LZO1X_CODEC].Count = 0 then + SOList[X, LZO1X_CODEC].Update(Options); + for X := Low(SOList) to High(SOList) do + if SOList[X, LZO2A_CODEC].Count = 0 then + SOList[X, LZO2A_CODEC].Update([1]); + for X := Low(SOList) to High(SOList) do + if SOList[X, LZO1C_CODEC].Count = 0 then + SOList[X, LZO1C_CODEC].Update([1]); end; procedure LZOFree(Funcs: PPrecompFuncs); @@ -164,11 +189,29 @@ begin if (CompareText(S, LZOCodecs[LZO1X_CODEC]) = 0) and LZODLL.DLLLoaded then begin SetBits(Option^, LZO1X_CODEC, 0, 5); - SetBits(Option^, LZO1XVariant, 12, 5); + SetBits(Option^, LZO1XVariant, 12, 12); if Funcs^.GetParam(Command, I, 'l') <> '' then SetBits(Option^, StrToInt(Funcs^.GetParam(Command, I, 'l')), 5, 7); if Funcs^.GetParam(Command, I, 'v') = '999' then - SetBits(Option^, 0, 12, 5); + SetBits(Option^, 999, 12, 12); + Result := True; + end + else if (CompareText(S, LZOCodecs[LZO2A_CODEC]) = 0) and LZODLL.DLLLoaded + then + begin + SetBits(Option^, LZO2A_CODEC, 0, 5); + SetBits(Option^, LZO2AVariant, 12, 12); + if Funcs^.GetParam(Command, I, 'v') = '999' then + SetBits(Option^, 999, 12, 12); + Result := True; + end + else if (CompareText(S, LZOCodecs[LZO1C_CODEC]) = 0) and LZODLL.DLLLoaded + then + begin + SetBits(Option^, LZO1C_CODEC, 0, 5); + SetBits(Option^, LZO1CVariant, 12, 12); + if Funcs^.GetParam(Command, I, 'v') = '999' then + SetBits(Option^, 999, 12, 12); Result := True; end; Inc(I); @@ -203,6 +246,12 @@ begin LZO1X_CODEC: if not lzo1x_decompress_safe(Input, DI1.OldSize, Buffer, @Res) = 0 then Res := 0; + LZO2A_CODEC: + if not lzo2a_decompress_safe(Input, DI1.OldSize, Buffer, @Res) = 0 then + Res := 0; + LZO1C_CODEC: + if not lzo1c_decompress_safe(Input, DI1.OldSize, Buffer, @Res) = 0 then + Res := 0; end; if (Res > DI1.OldSize) then begin @@ -212,6 +261,14 @@ begin SI.NewSize := Res; SI.Option := 0; SetBits(SI.Option, X, 0, 5); + case X of + LZO1X_CODEC: + SetBits(SI.Option, LZO1XVariant, 12, 12); + LZO2A_CODEC: + SetBits(SI.Option, LZO2AVariant, 12, 12); + LZO1C_CODEC: + SetBits(SI.Option, LZO1CVariant, 12, 12); + end; if System.Pos(SPrecompSep2, DI1.Codec) > 0 then SI.Status := TStreamStatus.Predicted else @@ -232,13 +289,15 @@ begin Pos := 0; while Pos < Size do begin - if GetLZOSI(Input + Pos, SizeEx - Pos, Buffer, L_MAXSIZE, @LZOSI) then + if GetLZO1XSI(Input + Pos, SizeEx - Pos, Buffer, L_MAXSIZE, @LZOSI) then begin Output(Instance, Buffer, LZOSI.DSize); SI.Position := Pos; SI.OldSize := LZOSI.CSize; SI.NewSize := LZOSI.DSize; SI.Option := 0; + SetBits(SI.Option, LZO1X_CODEC, 0, 5); + SetBits(SI.Option, LZO1XVariant, 12, 12); SI.Status := TStreamStatus.None; Funcs^.LogScan1(LZOCodecs[GetBits(SI.Option, 0, 5)], SI.Position, SI.OldSize, SI.NewSize); @@ -269,6 +328,14 @@ begin if not lzo1x_decompress_safe(Input, StreamInfo^.OldSize, Buffer, @Res) = 0 then Res := 0; + LZO2A_CODEC: + if not lzo2a_decompress_safe(Input, StreamInfo^.OldSize, Buffer, @Res) = 0 + then + Res := 0; + LZO1C_CODEC: + if not lzo1c_decompress_safe(Input, StreamInfo^.OldSize, Buffer, @Res) = 0 + then + Res := 0; end; if Res > StreamInfo^.OldSize then begin @@ -303,7 +370,7 @@ begin if GetBits(StreamInfo^.Option, 5, 7) <> I then continue; if (StreamInfo^.Status = TStreamStatus.Database) and - (GetBits(StreamInfo^.Option, 1, 31) = 0) then + (GetBits(StreamInfo^.Option, 31, 1) = 0) then begin Res1 := StreamInfo^.OldSize; Result := True; @@ -313,19 +380,38 @@ begin Res1 := StreamInfo^.NewSize; case X of LZO1X_CODEC: - case GetBits(StreamInfo^.Option, 12, 5) of + case GetBits(StreamInfo^.Option, 12, 12) of LZO1X_999: begin Params := 'l' + I.ToString + ':' + 'v' + - GetBits(StreamInfo^.Option, 12, 5).ToString; + GetBits(StreamInfo^.Option, 12, 12).ToString; if not Result then if not lzo1x_999_compress_level(NewInput, StreamInfo^.NewSize, Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, I) = 0 then Res1 := 0; end; - { if not lzo1x_1_compress(NewInput, StreamInfo^.NewSize, Buffer, - @Res1, @WrkMem[Instance, 0]) = 0 then - Res1 := 0; } + end; + LZO2A_CODEC: + case GetBits(StreamInfo^.Option, 12, 12) of + LZO2A_999: + begin + Params := 'v' + GetBits(StreamInfo^.Option, 12, 12).ToString; + if not Result then + if not lzo2a_999_compress(NewInput, StreamInfo^.NewSize, Buffer, + @Res1, @WrkMem[Instance, 0]) = 0 then + Res1 := 0; + end; + end; + LZO1C_CODEC: + case GetBits(StreamInfo^.Option, 12, 12) of + LZO1C_999: + begin + Params := 'v' + GetBits(StreamInfo^.Option, 12, 12).ToString; + if not Result then + if not lzo1c_999_compress(NewInput, StreamInfo^.NewSize, Buffer, + @Res1, @WrkMem[Instance, 0]) = 0 then + Res1 := 0; + end; end; end; if not Result then @@ -333,25 +419,25 @@ begin StreamInfo^.OldSize); Funcs^.LogProcess(LZOCodecs[GetBits(StreamInfo^.Option, 0, 5)], PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result); - if Result or (StreamInfo^.Status = TStreamStatus.Predicted) then + if Result or (StreamInfo^.Status >= TStreamStatus.Predicted) then break; end; - if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or + { if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or (SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then - begin + begin Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1)); Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1, - Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); + Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, - Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2)); + Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2)); if Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2) then begin - Output(Instance, Buffer + Res1, Res2); - SetBits(StreamInfo^.Option, 1, 31, 1); - SOList[Instance][X].Add(I); - Result := True; + Output(Instance, Buffer + Res1, Res2); + SetBits(StreamInfo^.Option, 1, 31, 1); + SOList[Instance][X].Add(I); + Result := True; end; - end; + end; } if Result then begin SetBits(StreamInfo^.Option, I, 5, 7); @@ -377,17 +463,37 @@ begin Res1 := StreamInfo.NewSize; case X of LZO1X_CODEC: - case GetBits(StreamInfo.Option, 12, 5) of + case GetBits(StreamInfo.Option, 12, 12) of LZO1X_999: begin Params := 'l' + GetBits(StreamInfo.Option, 5, 7).ToString + ':' + - 'v' + GetBits(StreamInfo.Option, 12, 5).ToString; + 'v' + GetBits(StreamInfo.Option, 12, 12).ToString; if not lzo1x_999_compress_level(Input, StreamInfo.NewSize, Buffer, @Res1, @WrkMem[Instance, 0], nil, 0, nil, GetBits(StreamInfo.Option, 5, 7)) = 0 then Res1 := 0; end; end; + LZO2A_CODEC: + case GetBits(StreamInfo.Option, 12, 12) of + LZO2A_999: + begin + Params := 'v' + GetBits(StreamInfo.Option, 12, 12).ToString; + if not lzo2a_999_compress(Input, StreamInfo.NewSize, Buffer, @Res1, + @WrkMem[Instance, 0]) = 0 then + Res1 := 0; + end; + end; + LZO1C_CODEC: + case GetBits(StreamInfo.Option, 12, 12) of + LZO1C_999: + begin + Params := 'v' + GetBits(StreamInfo.Option, 12, 12).ToString; + if not lzo2a_999_compress(Input, StreamInfo.NewSize, Buffer, @Res1, + @WrkMem[Instance, 0]) = 0 then + Res1 := 0; + end; + end; end; Funcs^.LogRestore(LZOCodecs[GetBits(StreamInfo.Option, 0, 5)], PChar(Params), StreamInfo.OldSize, StreamInfo.NewSize, Res1, True); diff --git a/precompressor/PrecompMain.pas b/precompressor/PrecompMain.pas index c02530c..1aa9f42 100644 --- a/precompressor/PrecompMain.pas +++ b/precompressor/PrecompMain.pas @@ -104,7 +104,7 @@ var DBFile: String = ''; ExtDir: String = ''; UseDB: Boolean = False; - StoreDD: Boolean = False; + StoreDD: Integer = -2; VERBOSE: Boolean = False; EXTRACT: Boolean = False; DupSysMem: Int64 = 0; @@ -183,26 +183,31 @@ begin S := ReplaceText(S, 'p', '%'); S := ReplaceText(S, '%', '%*' + CPUCount.ToString); Options.Threads := Max(1, Round(ExpParse.Evaluate(S))); - Options.Depth := EnsureRange(Succ(ArgParse.AsInteger('-d')), 1, 10); + Options.Depth := EnsureRange(Succ(ArgParse.AsInteger('-d', 0, 0)), 1, 10); Options.LowMem := ArgParse.AsBoolean('-lm'); - UseDB := ArgParse.AsBoolean('--dbase'); + UseDB := ArgParse.AsBoolean('-db') or ArgParse.AsBoolean('--dbase'); Options.DBaseFile := ArgParse.AsString('--dbase='); if Options.DBaseFile <> '' then UseDB := True; - StoreDD := ArgParse.AsBoolean('--dedup'); + StoreDD := -2; + if ArgParse.AsBoolean('-dd') or ArgParse.AsBoolean('--dedup') then + StoreDD := -1; + if FileExists(ExtractFilePath(Utils.GetModuleName) + 'srep.exe') then + StoreDD := ArgParse.AsInteger('--dedup=', 0, StoreDD); S := ArgParse.AsString('--diff=', 0, '5p'); S := ReplaceText(S, 'p', '%'); DIFF_TOLERANCE := Max(0.00, ExpParse.Evaluate(S)); - VERBOSE := ArgParse.AsBoolean('--verbose'); + VERBOSE := ArgParse.AsBoolean('-v') or ArgParse.AsBoolean('--verbose'); Options.ExtractDir := ArgParse.AsString('--extract='); if Options.ExtractDir <> '' then EXTRACT := DirectoryExists(Options.ExtractDir); - Options.DoCompress := ArgParse.AsBoolean('--compress'); + Options.DoCompress := ArgParse.AsBoolean('--compress') and + FLZMA2DLL.DLLLoaded; S := ArgParse.AsString('--compress='); S := ReplaceText(S, SPrecompSep3, SPrecompSep2); Options.CompressCfg := S; if Options.CompressCfg <> '' then - Options.DoCompress := True; + Options.DoCompress := FLZMA2DLL.DLLLoaded; finally ArgParse.Free; ExpParse.Free; @@ -1191,7 +1196,7 @@ begin for I := Low(DBInfo) to High(DBInfo) do DBCount[I] := 0; end; - if StoreDD then + if StoreDD > -2 then begin SetLength(DDInfo, $10000); SetLength(DDCount1, $10000); @@ -1409,6 +1414,7 @@ var BlockSize: Int64; UI32: UInt32; I, J, K, X: Integer; + S: String; W: Word; I64: Int64; LastStream, LastPos: Int64; @@ -1420,8 +1426,11 @@ var begin if (Depth = 0) then begin - if StoreDD then - TempOutput := TPrecompVMStream.Create + if StoreDD > -2 then + TempOutput := TBufferedStream.Create + (TFileStream.Create + (LowerCase(ChangeFileExt(ExtractFileName(Utils.GetModuleName), + '-dd.tmp')), fmCreate or fmShareDenyNone), False, 4194304) else TempOutput := Output; end @@ -1525,7 +1534,7 @@ begin begin Inc(StreamCount); DupBool := False; - if (Depth = 0) and StoreDD then + if (Depth = 0) and (StoreDD > -2) then DupBool := not FindOrAddDD(StreamInfo, @DupIdx2, @DupCount); if DupBool then begin @@ -1580,7 +1589,7 @@ begin while J >= 0 do begin DupBool := False; - if (Depth = 0) and StoreDD then + if (Depth = 0) and (StoreDD > -2) then DupBool := FindDD(StreamInfo, @DupIdx2, @DupCount); if (DupBool = False) or (DupIdx1 = DupIdx2) then begin @@ -1663,9 +1672,9 @@ begin with WorkStream[0] do begin Position := 0; - for W := 0 to $10000 - 1 do + for W := Low(DBInfo) to High(DBInfo) do begin - J := DBCount[I]; + J := DBCount[W]; if J > 0 then begin WriteBuffer(W, W.Size); @@ -1682,7 +1691,7 @@ begin Free; end; end; - if StoreDD then + if StoreDD > -2 then begin with WorkStream[0] do begin @@ -1703,9 +1712,37 @@ begin end; Output.WriteBuffer(UI32, UI32.Size); Output.WriteBuffer(WorkStream[0].Memory^, WorkStream[0].Position); - Output.CopyFrom(TempOutput, 0); + try + EncFree; + finally + end; + S := TFileStream(TBufferedStream(TempOutput).Instance).Filename; + TBufferedStream(TempOutput).Flush; + if StoreDD >= 0 then + begin + with TProcessStream.Create(ExtractFilePath(Utils.GetModuleName) + + 'srep.exe', '-m' + StoreDD.ToString + 'f ' + S + ' -', GetCurrentDir, + nil, Output) do + try + if Execute then + begin + Wait; + Done; + end; + finally + Free; + end; + end + else + Output.CopyFrom(TempOutput, 0); TempOutput.Free; - end; + DeleteFile(S); + end + else + try + EncFree; + finally + end; end; end; @@ -1776,7 +1813,7 @@ procedure PrecompOutput2(Instance: Integer; const Buffer: Pointer; begin with ComVars2[CurDepth[Instance]] do DecOutput[Instance].WriteBuffer(Buffer^, Size); - if StoreDD and (CurDepth[Instance] = 0) then + if (StoreDD > -2) and (CurDepth[Instance] = 0) then if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index)) then DataMgr.Write(DDIndex1, Buffer, Size); end; @@ -1821,7 +1858,7 @@ begin end else begin - if StoreDD and (Depth = 0) then + if (StoreDD > -2) and (Depth = 0) then begin Inc(DDIndex1); if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index)) @@ -1886,7 +1923,7 @@ begin end else begin - if StoreDD and (Depth = 0) then + if (StoreDD > -2) and (Depth = 0) then if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index)) then Inc(DDIndex2); @@ -2039,11 +2076,12 @@ var CurrPos: Int64; UI32: UInt32; I, J: Integer; + LStream: TProcessStream; begin if Depth = 0 then begin UI32 := 0; - if StoreDD then + if (StoreDD > -2) then begin Input.ReadBuffer(UI32, UI32.Size); SetLength(DDList2, UI32); @@ -2057,7 +2095,16 @@ begin end; with ComVars2[Depth] do begin - DecInput[Index] := Input; + if (Depth = 0) and (StoreDD >= 0) then + begin + LStream := TProcessStream.Create(ExtractFilePath(Utils.GetModuleName) + + 'srep.exe', '-d -s - -', GetCurrentDir, Input, nil); + if not LStream.Execute then + raise EReadError.CreateRes(@SReadError); + DecInput[Index] := TBufferedStream.Create(LStream, True, 4194304); + end + else + DecInput[Index] := Input; DecOutput[Index] := Output; DecInput[Index].ReadBuffer(StreamCount[Index]^, StreamCount[Index]^.Size); while StreamCount[Index]^ >= 0 do @@ -2137,7 +2184,7 @@ begin if IsErrored(Tasks) then for I := Low(Tasks) to High(Tasks) do Tasks[I].RaiseLastError; - if StoreDD and (Depth = 0) then + if (StoreDD > -2) and (Depth = 0) then begin Inc(DDIndex1); if ((DDIndex2 < DDCount2) and (DDIndex1 = DDList2[DDIndex2].Index)) @@ -2168,6 +2215,15 @@ begin CopyStreamEx(DecInput[Index], DecOutput[Index], UI32); DecInput[Index].ReadBuffer(StreamCount[Index]^, StreamCount[Index]^.Size); end; + if (Depth = 0) and (StoreDD >= 0) then + begin + with LStream do + begin + Wait; + Done; + end; + DecInput[Index].Free; + end; end; end; @@ -2294,7 +2350,7 @@ begin if Options.DoCompress then LOutput.Free; try - EncFree; + // EncFree; finally Stopwatch.Stop; end; diff --git a/precompressor/PrecompMedia.pas b/precompressor/PrecompMedia.pas index 81a71f9..032de67 100644 --- a/precompressor/PrecompMedia.pas +++ b/precompressor/PrecompMedia.pas @@ -5,7 +5,7 @@ unit PrecompMedia; interface uses - BrunsliDLL, FLACDLL, PackJPGDLL, JoJpegDLL, XDeltaDLL, + BrunsliDLL, FLACDLL, PackJPGDLL, JoJpegDLL, Utils, PrecompUtils, System.SysUtils, System.Classes, System.Math; diff --git a/precompressor/PrecompOodle.pas b/precompressor/PrecompOodle.pas index eae05c0..4706056 100644 --- a/precompressor/PrecompOodle.pas +++ b/precompressor/PrecompOodle.pas @@ -3,26 +3,11 @@ unit PrecompOodle; interface uses - OodleDLL, XDeltaDLL, + OodleDLL, Utils, PrecompUtils, System.SysUtils, System.Classes, System.Types, System.Math; -{ 8C 07 - 0:LZH - 8C 00 - 1:LZHLW - 8C 01 - 2:LZNIB - CC 07 - 3:None - 8C 02 - 4:LZB16 - 8C 03 - 5:LZBLW - 8C 04 - 6:LZA - 8C 05 - 7:LZNA - 8C 06 - 8:Kraken - 8C 0A - 9:Mermaid - 8C 0B - 10:BitKnit - 8C 0A - 11:Selkie - 8C 0A - 12:Hydra - 8C 0C - 13:Leviathan } - var Codec: TPrecompressor; @@ -40,13 +25,13 @@ const LEVIATHAN_CODEC = 5; const - O_COUNT = 0; + O_LENGTH = 32; O_TRADEOFF = 256; O_MAXSIZE = 16 * 1024 * 1024; var SOList: array of array [0 .. CODEC_COUNT - 1] of TSOList; - OCount: Integer = O_COUNT; + OLength: Integer = O_LENGTH; OTradeOff: Integer = O_TRADEOFF; CodecAvailable, CodecEnabled: TArray; @@ -247,135 +232,36 @@ begin Result := A; end; -function CustomLZ_Decompress0(src, dst: PByte; srcSize, dstCapacity: Integer; +function CustomLZ_Decompress(src, dst: PByte; srcSize, dstCapacity: Integer; var Res: Integer): Boolean; - -type - T3Res = array [0 .. 2] of Integer; - - procedure AddRes(const I: Integer; var Res: T3Res); - begin - Res[0] := Res[1]; - Res[1] := Res[2]; - Res[2] := I; - end; - const - MinSize = 64; BlkSize = 262144; - Range = 262144; - - function ValidSize(Res: T3Res): Boolean; - const - ThresSize = 32; - begin - Result := (Res[0] > 0) and (Res[0] < Res[1]) and - InRange(Res[0], Res[0], Res[2] + 32); - end; - var - LBuffer: array [0 .. BlkSize - 1] of Byte; - I, J, W, X, Y, Z: Integer; - LR1, LR2: T3Res; + W, X, Y, Z: Integer; begin Result := False; - Y := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 0, Z), - LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 1, Z)); - if Y > MinSize then + Y := 0; + X := dstCapacity; + X := Min(Max(LocalLZ_Decompress(src, dst, srcSize, X, 0, Y), + LocalLZ_Decompress(src, dst, srcSize, X, 1, Z)), Pred(X)); + W := X; + while (Y = 0) and (X > dstCapacity - BlkSize) and (W - X < OLength) do begin - W := IfThen(Y mod BlkSize = 0, Pred(Y div BlkSize), Y div BlkSize) - * BlkSize; - Move((dst + W)^, LBuffer[0], Y - W); + X := Min(Max(LocalLZ_Decompress(src, dst, srcSize, X, 0, Y), + LocalLZ_Decompress(src, dst, srcSize, X, 1, Y)), Pred(X)); end; - if (Y = Z) and (Y = dstCapacity) then + X := Min(Succ(W), dstCapacity); + while (Z = 0) and (X < Min(W + OLength, dstCapacity)) do + begin + LocalLZ_Decompress(src, dst, srcSize, X, 0, Z); + Inc(X); + end; + Y := Max(Y, Z); + if (Y > 0) then begin Res := Y; - I := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity - 1, 0, Z), - LocalLZ_Decompress(src, dst, srcSize, dstCapacity - 1, 1, Z)); - if (Res <> I) and (Res <> Pred(I)) then - begin - Move(LBuffer[0], (dst + W)^, Res - W); - Result := True; - exit; - end; + Result := True; end; - FillChar(LR1, SizeOf(T3Res), 0); - FillChar(LR2, SizeOf(T3Res), 0); - I := Y; - J := Min(dstCapacity, Y + Range); - while I < J do - begin - Y := Max(LocalLZ_Decompress(src, dst, srcSize, I, 0, Z), - LocalLZ_Decompress(src, dst, srcSize, I, 1, Z)); - AddRes(Y, LR1); - AddRes(Z, LR2); - if (LR1[1] = LR2[1]) and ValidSize(LR1) then - begin - Res := LR1[1]; - Move(LBuffer[0], (dst + W)^, Res - W); - Result := True; - break; - end; - if Y > MinSize then - begin - W := IfThen(Y mod BlkSize = 0, Pred(Y div BlkSize), Y div BlkSize) - * BlkSize; - Move((dst + W)^, LBuffer[0], Y - W); - end; - Inc(I); - end; -end; - -function CustomLZ_DecompressN(src, dst: PByte; srcSize, dstCapacity: Integer; - var Res: TIntegerDynArray): Boolean; - -const - BlkSize = 262144; - UpLen = 128; - DownLen = 16; -var - I, J, X, Y, Z: Integer; - Sizes: array [0 .. UpLen + DownLen - 1] of Integer; -begin - SetLength(Res, 0); - Y := Max(LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 0, Z), - LocalLZ_Decompress(src, dst, srcSize, dstCapacity, 1, Z)); - for I := Low(Sizes) to High(Sizes) do - Sizes[I] := -1; - J := Min(dstCapacity, Y + UpLen); - I := Max(IfThen(dstCapacity mod BlkSize = 0, Pred(dstCapacity div BlkSize), - dstCapacity div BlkSize) * BlkSize, Y - DownLen); - X := J - I; - while (J > I) do - begin - Y := Max(LocalLZ_Decompress(src, dst, srcSize, J, 0, Z), - LocalLZ_Decompress(src, dst, srcSize, J, 1, Z)); - Sizes[Length(Sizes) - (J - I)] := Z; - Dec(J); - end; - for I := Low(Sizes) to High(Sizes) do - begin - X := Sizes[I]; - for J := Low(Sizes) to High(Sizes) do - begin - Y := Sizes[J]; - if I <> J then - if X = Y then - begin - Sizes[I] := -1; - Sizes[J] := -1; - end; - end; - end; - for I := Low(Sizes) to High(Sizes) do - if Sizes[I] > srcSize then - if OodleLZ_Decompress(src, srcSize, dst, Sizes[I]) = Sizes[I] then - begin - Insert(Sizes[I], Res, Length(Res)); - if Length(Res) >= OCount then - break; - end; - Result := Length(Res) > 0; end; function GetOodleUS(Instance: Integer; Input: PByte; Pos: NativeInt; @@ -386,25 +272,29 @@ const var Buffer: PByte; B: Boolean; - I: Integer; - ResultN: TIntegerDynArray; SI: _StrInfo1; begin Result := 0; - { if StreamInfo^.Codec = 3 then - exit; } - // StreamInfo^.DSize:=$8001; - Buffer := Funcs^.Allocator(Instance, StreamInfo^.DSize); - if OCount <= 0 then - B := CustomLZ_Decompress0(Input + Pos, Buffer, StreamInfo^.CSize, - StreamInfo^.DSize, Result) + case StreamInfo^.Codec of + 1: + if (CodecEnabled[KRAKEN_CODEC] = False) and + (CodecEnabled[HYDRA_CODEC] = False) then + exit; + 2: + if (CodecEnabled[MERMAID_CODEC] = False) and + (CodecEnabled[SELKIE_CODEC] = False) and + (CodecEnabled[HYDRA_CODEC] = False) then + exit; + 3: + if (CodecEnabled[LEVIATHAN_CODEC] = False) and + (CodecEnabled[HYDRA_CODEC] = False) then + exit; else - begin - B := CustomLZ_DecompressN(Input + Pos, Buffer, StreamInfo^.CSize, - StreamInfo^.DSize, ResultN); - if B then - Result := ResultN[0]; + exit; end; + Buffer := Funcs^.Allocator(Instance, StreamInfo^.DSize); + B := CustomLZ_Decompress(Input + Pos, Buffer, StreamInfo^.CSize, + StreamInfo^.DSize, Result); If B then if (Result > MinSize) and (Result > StreamInfo^.CSize) then begin @@ -415,37 +305,25 @@ begin SetBits(SI.Option, OTradeOff, 13, 11); case StreamInfo^.Codec of 1: - SetBits(SI.Option, KRAKEN_CODEC, 0, 5); + if CodecEnabled[KRAKEN_CODEC] then + SetBits(SI.Option, KRAKEN_CODEC, 0, 5); 2: if CodecEnabled[MERMAID_CODEC] then SetBits(SI.Option, MERMAID_CODEC, 0, 5) - else + else if CodecEnabled[SELKIE_CODEC] then SetBits(SI.Option, SELKIE_CODEC, 0, 5); 3: - SetBits(SI.Option, LEVIATHAN_CODEC, 0, 5); + if CodecEnabled[LEVIATHAN_CODEC] then + SetBits(SI.Option, LEVIATHAN_CODEC, 0, 5); end; if CodecEnabled[HYDRA_CODEC] then SetBits(SI.Option, HYDRA_CODEC, 0, 5); SetBits(SI.Option, Integer(StreamInfo^.HasCRC), 12, 1); SI.Status := TStreamStatus.None; - if OCount <= 0 then - begin - SI.NewSize := Result; - Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position, - SI.OldSize, SI.NewSize); - Add(Instance, @SI, nil, nil); - end - else - begin - if Length(ResultN) > 0 then - for I := Low(ResultN) to High(ResultN) do - begin - SI.NewSize := ResultN[I]; - Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position, - SI.OldSize, SI.NewSize); - Add(Instance, @SI, nil, nil); - end; - end; + SI.NewSize := Result; + Funcs^.LogScan1(OodleCodecs[GetBits(SI.Option, 0, 5)], SI.Position, + SI.OldSize, SI.NewSize); + Add(Instance, @SI, nil, nil); end; end; @@ -502,7 +380,7 @@ begin SOList[I][Y].Update ([StrToInt(Funcs^.GetParam(Command, X, 'l'))], True); if Funcs^.GetParam(Command, X, 'n') <> '' then - OCount := StrToInt(Funcs^.GetParam(Command, X, 'n')); + OLength := StrToInt(Funcs^.GetParam(Command, X, 'n')); if Funcs^.GetParam(Command, X, 't') <> '' then OTradeOff := StrToInt(Funcs^.GetParam(Command, X, 't')); end; @@ -573,7 +451,11 @@ begin if DS <> '' then begin X := IndexTextW(@DS[0], OodleCodecs); - if (X < 0) or (DI1.OldSize <> SizeEx) then + if X < 0 then + exit; + if DI1.OldSize = 0 then + DI1.OldSize := SizeEx; + if not CodecAvailable[X] then exit; if not CodecAvailable[X] then exit; @@ -589,7 +471,7 @@ begin begin if DI1.NewSize <= 0 then begin - if not CustomLZ_Decompress0(Input, Buffer, DI1.OldSize, Res, Res) + if not CustomLZ_Decompress(Input, Buffer, DI1.OldSize, Res, Res) then Res := 0; end @@ -678,7 +560,7 @@ begin then begin Buffer := Funcs^.Allocator(Instance, OodleSI.DSize); - if CustomLZ_Decompress0(Input, Buffer, StreamInfo^.OldSize, + if CustomLZ_Decompress(Input, Buffer, StreamInfo^.OldSize, OodleSI.DSize, Res) then begin Output(Instance, Buffer, Res); @@ -716,7 +598,7 @@ begin if GetBits(StreamInfo^.Option, 5, 7) <> I then continue; if (StreamInfo^.Status = TStreamStatus.Database) and - (GetBits(StreamInfo^.Option, 1, 31) = 0) then + (GetBits(StreamInfo^.Option, 31, 1) = 0) then begin Res1 := StreamInfo^.OldSize; Result := True; @@ -726,6 +608,7 @@ begin SizeOf(TOodleLZ_CompressOptions)); COptions.sendQuantumCRCs := GetBits(StreamInfo^.Option, 12, 1) = 1; COptions.spaceSpeedTradeoffBytes := GetBits(StreamInfo^.Option, 13, 11); + // COptions.dictionarySize := 262144; Params := 'l' + I.ToString + ':' + 'c' + GetBits(StreamInfo^.Option, 12, 1) .ToString + ':' + 't' + GetBits(StreamInfo^.Option, 13, 11).ToString; if not Result then @@ -739,22 +622,22 @@ begin if Result or (StreamInfo^.Status = TStreamStatus.Predicted) then break; end; - if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or + { if (Result = False) and ((StreamInfo^.Status >= TStreamStatus.Predicted) or (SOList[Instance][X].Count = 1)) and (DIFF_TOLERANCE > 0) then - begin + begin Buffer := Funcs^.Allocator(Instance, Res1 + Max(StreamInfo^.OldSize, Res1)); Res2 := PrecompEncodePatch(OldInput, StreamInfo^.OldSize, Buffer, Res1, - Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); + Buffer + Res1, Max(StreamInfo^.OldSize, Res1)); Funcs^.LogPatch1(StreamInfo^.OldSize, Res1, Res2, - Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2)); + Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2)); if Funcs^.AcceptPatch(StreamInfo^.OldSize, Res1, Res2) then begin - Output(Instance, Buffer + Res1, Res2); - SetBits(StreamInfo^.Option, 1, 31, 1); - SOList[Instance][X].Add(I); - Result := True; + Output(Instance, Buffer + Res1, Res2); + SetBits(StreamInfo^.Option, 1, 31, 1); + SOList[Instance][X].Add(I); + Result := True; end; - end; + end; } if Result then begin SetBits(StreamInfo^.Option, I, 5, 7); diff --git a/precompressor/PrecompUtils.pas b/precompressor/PrecompUtils.pas index 82460bd..d1eb443 100644 --- a/precompressor/PrecompUtils.pas +++ b/precompressor/PrecompUtils.pas @@ -16,7 +16,7 @@ resourcestring SPrecompSep2 = ':'; SPrecompSep3 = ','; SPrecompSep4 = '/'; - SPrecompSep5 = '/'; + SPrecompSep5 = '\'; const SuccessStatus = 4; @@ -276,7 +276,7 @@ type procedure SetSize(const NewSize: Int64); override; procedure SetSize(NewSize: Longint); override; private - FInitialised: Boolean; + FInitialised, FDone: Boolean; FStream: TStream; FFilename: String; procedure Initialise; @@ -286,6 +286,8 @@ type function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + procedure Done; + property FileName: String read FFilename; end; PResData = ^TResData; @@ -449,13 +451,15 @@ constructor TPrecompVMStream.Create; begin inherited Create; FInitialised := False; + FDone := False; end; destructor TPrecompVMStream.Destroy; begin if FInitialised then begin - FStream.Free; + if not FDone then + FStream.Free; DeleteFile(FFilename); end; inherited Destroy; @@ -521,6 +525,12 @@ begin Result := 0; end; +procedure TPrecompVMStream.Done; +begin + FStream.Free; + FDone := True; +end; + function PrecompGetCodec(Cmd: PChar; Index: Integer; WithParams: Boolean) : TPrecompStr; var @@ -567,14 +577,16 @@ begin List2 := DecodeStr(List1[Index], SPrecompSep2); if Param = '' then begin - if Length(List1) > 1 then - begin - S := ''; - if not ResourceExists(List2[I]) then - S := S + List2[I] + SPrecompSep2; - if Length(S) > 0 then - S := S.Remove(Pred(Length(S))); - end; + S := ''; + for I := Succ(Low(List2)) to High(List2) do + if ResourceExists(List2[I]) = False then + begin + if S <> '' then + S := S + SPrecompSep2; + S := S + List2[I]; + end; + if S = '' then + S := ' '; end else begin @@ -705,8 +717,9 @@ var S: String; begin Result := 0; - case IndexText(Codec, ['zlib', 'lz4', 'lz4hc', 'lzo1c', 'lzo1x', 'lzo2a', - 'zstd', 'lzna', 'kraken', 'mermaid', 'selkie', 'hydra', 'leviathan']) of + case IndexText(Codec, ['zlib', 'lz4', 'lz4hc', 'lz4f', 'lzo1c', 'lzo1x', + 'lzo2a', 'zstd', 'lzna', 'kraken', 'mermaid', 'selkie', 'hydra', + 'leviathan']) of 0: if ZLibDLL.DLLLoaded then begin @@ -729,10 +742,13 @@ begin 1, 2: if LZ4DLL.DLLLoaded then Result := LZ4_decompress_safe(InBuff, OutBuff, InSize, OutSize); - 6: + 3: + if LZ4DLL.DLLLoaded then + Result := LZ4F_decompress_safe(InBuff, OutBuff, InSize, OutSize); + 7: if ZSTDDLL.DLLLoaded then Result := ZSTD_decompress(OutBuff, OutSize, InBuff, InSize); - 7 .. 12: + 8 .. 13: if OodleDLL.DLLLoaded then Result := OodleLZ_Decompress(InBuff, InSize, OutBuff, OutSize); end; @@ -855,6 +871,8 @@ var Res: NativeUInt; begin Result := 0; + if not XDeltaDLL.DLLLoaded then + exit; if xd3_encode(OldBuff, OldSize, NewBuff, NewSize, PatchBuff, @Res, PatchSize, Integer(XD3_NOCOMPRESS)) = 0 then Result := Res; @@ -868,6 +886,8 @@ var Res: NativeUInt; begin Result := 0; + if not XDeltaDLL.DLLLoaded then + exit; if xd3_decode(PatchBuff, PatchSize, OldBuff, OldSize, NewBuff, @Res, NewSize, Integer(XD3_NOCOMPRESS)) = 0 then Result := Res; @@ -1234,5 +1254,7 @@ EncodeSICmp := TEncodeSIComparer.Create; FutureSICmp := TFutureSIComparer.Create; StockMethods := TStringList.Create; ExternalMethods := TStringList.Create; +if not XDeltaDLL.DLLLoaded then + DIFF_TOLERANCE := 0; end. diff --git a/precompressor/PrecompZLib.pas b/precompressor/PrecompZLib.pas index 5ae50ee..a844c23 100644 --- a/precompressor/PrecompZLib.pas +++ b/precompressor/PrecompZLib.pas @@ -530,7 +530,7 @@ begin Res := inflate(ZStream^, Z_BLOCK); if not(Res in [Z_OK, Z_STREAM_END]) then begin - if (LastIn >= Z_MINSIZE) then + if (Res <> Z_DATA_ERROR) and (LastIn >= Z_MINSIZE) then Res := Z_STREAM_END; break; end; diff --git a/precompressor/PrecompZSTD.pas b/precompressor/PrecompZSTD.pas index bb60918..fb3dfad 100644 --- a/precompressor/PrecompZSTD.pas +++ b/precompressor/PrecompZSTD.pas @@ -3,7 +3,7 @@ unit PrecompZSTD; interface uses - ZSTDDLL, XDeltaDLL, + ZSTDDLL, Utils, PrecompUtils, System.SysUtils, System.Classes, System.Math; @@ -267,7 +267,7 @@ begin if GetBits(StreamInfo^.Option, 5, 7) <> I then continue; if (StreamInfo^.Status = TStreamStatus.Database) and - (GetBits(StreamInfo^.Option, 1, 31) = 0) then + (GetBits(StreamInfo^.Option, 31, 1) = 0) then begin Res1 := StreamInfo^.OldSize; Result := True; @@ -317,7 +317,7 @@ begin StreamInfo^.OldSize); Funcs^.LogProcess(ZSTDCodecs[GetBits(StreamInfo^.Option, 0, 5)], PChar(Params), StreamInfo^.OldSize, StreamInfo^.NewSize, Res1, Result); - if Result or (StreamInfo^.Status = TStreamStatus.Predicted) then + if Result or (StreamInfo^.Status >= TStreamStatus.Predicted) then break; end; if Res1 < 0 then diff --git a/xtool.dpr b/xtool.dpr index 516684e..f89db4d 100644 --- a/xtool.dpr +++ b/xtool.dpr @@ -24,11 +24,8 @@ program xtool; {$APPTYPE CONSOLE} {$R *.res} -{$SETPEOSVERSION 6.0} -{$SETPESUBSYSVERSION 6.0} {$WEAKLINKRTTI ON} {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} -{$R *.dres} uses WinAPI.Windows, @@ -38,6 +35,7 @@ uses System.Types, System.Math, System.IOUtils, + LibImport in 'common\LibImport.pas', Threading in 'common\Threading.pas', Utils in 'common\Utils.pas', FuncHook in 'contrib\Delphi_MemoryModule\FuncHook.pas', @@ -47,8 +45,6 @@ uses SynCrypto in 'contrib\mORMot\SynCrypto.pas', SynLZ in 'contrib\mORMot\SynLZ.pas', SynTable in 'contrib\mORMot\SynTable.pas', - DelphiCL in 'contrib\opencl\DelphiCL.pas', - OpenCL in 'contrib\opencl\OpenCL.pas', oObjects in 'contrib\ParseExpression\oObjects.pas', ParseClass in 'contrib\ParseExpression\ParseClass.pas', ParseExpr in 'contrib\ParseExpression\ParseExpr.pas', @@ -102,6 +98,7 @@ const CommandPatch = 'patch'; CommandArchive = 'archive'; CommandExecute = 'execute'; + CommandInject = 'inject'; CommandDecode = 'decode'; procedure ProgramInfo; @@ -121,6 +118,7 @@ begin WriteLine(' ' + CommandExtract); WriteLine(' ' + CommandFind); WriteLine(' ' + CommandGenerate); + WriteLine(' ' + CommandInject); WriteLine(' ' + CommandPatch); WriteLine(' ' + CommandPrecomp); WriteLine(' ' + CommandReplace); @@ -141,6 +139,15 @@ begin WriteLine(''); end; +procedure InjectPrintHelp; +begin + WriteLine('inject - embed libraries as part of xtool'); + WriteLine(''); + WriteLine('Usage:'); + WriteLine(' xtool inject dll'); + WriteLine(''); +end; + function GetInStream(Input: string): TStream; begin if (Input = '-') or (Input = '') then @@ -153,7 +160,7 @@ begin Result := TDirInputStream.Create(Input); end; -function GetOutStream(Output: string; MultiInput: Boolean = False): TStream; +function GetOutStream(Output: string): TStream; begin if (Output = '') then Result := TNullStream.Create @@ -170,6 +177,7 @@ const var I, J: Integer; + S: String; ParamArg: array [0 .. 1] of TArray; StrArray: TArray; IsParam: Boolean; @@ -345,6 +353,18 @@ begin Output.Free; end; end; + if ParamStr(1).StartsWith(CommandInject, True) then + if (Length(ParamArg[0]) = 0) and (Length(ParamArg[1]) = 0) then + InjectPrintHelp + else + begin + S := ChangeFileExt(GetModuleName, + '_inj' + ExtractFileExt(GetModuleName)); + if not FileExists(S) then + TFile.Copy(GetModuleName, S); + InjectLib(ParamArg[1, 0], S); + WriteLine('Successfully injected ' + ExtractFileName(ParamArg[1, 0])); + end; if ParamStr(1).StartsWith(CommandDecode, True) then if (Length(ParamArg[0]) = 0) and (Length(ParamArg[1]) = 0) then DecodePrintHelp diff --git a/xtool.dproj b/xtool.dproj index b28a609..15ff681 100644 --- a/xtool.dproj +++ b/xtool.dproj @@ -1,7 +1,7 @@  {E490A6E6-3D5F-49E7-860E-CB57A73FBF77} - 19.4 + 19.5 None xtool.dpr True @@ -13,6 +13,26 @@ true + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + true Base @@ -51,6 +71,28 @@ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) xtool + + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + annotation-1.2.0.dex.jar;asynclayoutinflater-1.0.0.dex.jar;billing-4.0.0.dex.jar;browser-1.0.0.dex.jar;cloud-messaging.dex.jar;collection-1.0.0.dex.jar;coordinatorlayout-1.0.0.dex.jar;core-1.5.0-rc02.dex.jar;core-common-2.0.1.dex.jar;core-runtime-2.0.1.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;firebase-annotations-16.0.0.dex.jar;firebase-common-20.0.0.dex.jar;firebase-components-17.0.0.dex.jar;firebase-datatransport-18.0.0.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.0.0.dex.jar;firebase-installations-interop-17.0.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-22.0.0.dex.jar;fmx.dex.jar;fragment-1.0.0.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;legacy-support-core-ui-1.0.0.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.0.0.dex.jar;lifecycle-livedata-2.0.0.dex.jar;lifecycle-livedata-core-2.0.0.dex.jar;lifecycle-runtime-2.0.0.dex.jar;lifecycle-service-2.0.0.dex.jar;lifecycle-viewmodel-2.0.0.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;play-services-ads-20.1.0.dex.jar;play-services-ads-base-20.1.0.dex.jar;play-services-ads-identifier-17.0.0.dex.jar;play-services-ads-lite-20.1.0.dex.jar;play-services-base-17.5.0.dex.jar;play-services-basement-17.6.0.dex.jar;play-services-cloud-messaging-16.0.0.dex.jar;play-services-drive-17.0.0.dex.jar;play-services-games-21.0.0.dex.jar;play-services-location-18.0.0.dex.jar;play-services-maps-17.0.1.dex.jar;play-services-measurement-base-18.0.0.dex.jar;play-services-measurement-sdk-api-18.0.0.dex.jar;play-services-places-placereport-17.0.0.dex.jar;play-services-stats-17.0.0.dex.jar;play-services-tasks-17.2.0.dex.jar;print-1.0.0.dex.jar;room-common-2.1.0.dex.jar;room-runtime-2.1.0.dex.jar;slidingpanelayout-1.0.0.dex.jar;sqlite-2.0.1.dex.jar;sqlite-framework-2.0.1.dex.jar;swiperefreshlayout-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.0.0.dex.jar;transport-runtime-3.0.0.dex.jar;user-messaging-platform-1.0.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.1.0.dex.jar + + + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + annotation-1.2.0.dex.jar;asynclayoutinflater-1.0.0.dex.jar;billing-4.0.0.dex.jar;browser-1.0.0.dex.jar;cloud-messaging.dex.jar;collection-1.0.0.dex.jar;coordinatorlayout-1.0.0.dex.jar;core-1.5.0-rc02.dex.jar;core-common-2.0.1.dex.jar;core-runtime-2.0.1.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;firebase-annotations-16.0.0.dex.jar;firebase-common-20.0.0.dex.jar;firebase-components-17.0.0.dex.jar;firebase-datatransport-18.0.0.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.0.0.dex.jar;firebase-installations-interop-17.0.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-22.0.0.dex.jar;fmx.dex.jar;fragment-1.0.0.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;legacy-support-core-ui-1.0.0.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.0.0.dex.jar;lifecycle-livedata-2.0.0.dex.jar;lifecycle-livedata-core-2.0.0.dex.jar;lifecycle-runtime-2.0.0.dex.jar;lifecycle-service-2.0.0.dex.jar;lifecycle-viewmodel-2.0.0.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;play-services-ads-20.1.0.dex.jar;play-services-ads-base-20.1.0.dex.jar;play-services-ads-identifier-17.0.0.dex.jar;play-services-ads-lite-20.1.0.dex.jar;play-services-base-17.5.0.dex.jar;play-services-basement-17.6.0.dex.jar;play-services-cloud-messaging-16.0.0.dex.jar;play-services-drive-17.0.0.dex.jar;play-services-games-21.0.0.dex.jar;play-services-location-18.0.0.dex.jar;play-services-maps-17.0.1.dex.jar;play-services-measurement-base-18.0.0.dex.jar;play-services-measurement-sdk-api-18.0.0.dex.jar;play-services-places-placereport-17.0.0.dex.jar;play-services-stats-17.0.0.dex.jar;play-services-tasks-17.2.0.dex.jar;print-1.0.0.dex.jar;room-common-2.1.0.dex.jar;room-runtime-2.1.0.dex.jar;slidingpanelayout-1.0.0.dex.jar;sqlite-2.0.1.dex.jar;sqlite-framework-2.0.1.dex.jar;swiperefreshlayout-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.0.0.dex.jar;transport-runtime-3.0.0.dex.jar;user-messaging-platform-1.0.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.1.0.dex.jar + + + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers + iPhoneAndiPad + true + Debug + $(MSBuildProjectName) + + + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers + iPhoneAndiPad + true + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) @@ -97,6 +139,7 @@ MainSource + @@ -106,8 +149,6 @@ - - @@ -148,17 +189,7 @@ - - ResourceItem - RCDATA - xdelta3_dll - - - ResourceItem - RCDATA - fast_lzma2 - Base @@ -180,7 +211,7 @@ Microsoft Office XP Sample Automation Server Wrapper Components - + true @@ -196,42 +227,15 @@ true + .\ true - - - .\ - true - - - - - .\ - true - - - - - .\ - true - - - - - .\ - true - - - - - xtool.exe - true - - + + xtool.exe @@ -260,16 +264,6 @@ 64 - - - classes - 1 - - - classes - 1 - - res\xml @@ -579,7 +573,7 @@ 1 .dylib - + 1 .dylib @@ -612,7 +606,7 @@ 1 .dylib - + 1 .dylib @@ -649,7 +643,7 @@ 0 - + 0 @@ -673,13 +667,17 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -689,137 +687,27 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -829,7 +717,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -839,7 +727,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -849,7 +737,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -859,7 +747,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -869,191 +757,37 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -1063,7 +797,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -1073,7 +807,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1083,7 +817,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1093,7 +827,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1103,7 +837,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1113,7 +847,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1123,7 +857,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1145,12 +879,8 @@ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - - - 1 - - + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 @@ -1163,6 +893,10 @@ ..\ 1 + + ..\ + 1 + @@ -1171,7 +905,7 @@ 1 - + 1 @@ -1180,7 +914,7 @@ ..\$(PROJECTNAME).launchscreen 64 - + ..\$(PROJECTNAME).launchscreen 64 @@ -1192,7 +926,7 @@ 1 - + 1 @@ -1263,7 +997,7 @@ 1 - + 1 @@ -1323,6 +1057,7 @@ + @@ -1332,6 +1067,11 @@ + False + False + False + False + False True True diff --git a/xtool.dres b/xtool.dres index 41f324e..26a7ef3 100644 Binary files a/xtool.dres and b/xtool.dres differ diff --git a/xtoolResource.rc b/xtoolResource.rc index 88aceb4..c3628fe 100644 --- a/xtoolResource.rc +++ b/xtoolResource.rc @@ -1,2 +1 @@ -xdelta3_dll RCDATA "resources\\Win64\\xdelta3_dll.dll" -fast_lzma2 RCDATA "resources\\Win64\\fast-lzma2.dll" +XTOOL RCDATA "cpp\\xtool\\x64\\Release\\xtool.dll"