192 lines
5.9 KiB
ObjectPascal
192 lines
5.9 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// ****************************************************************************
|
|
// * Project : FWZip
|
|
// * Unit Name : FWZipZLibFPC
|
|
// * Purpose : Линковка ZLib для Free Pascal
|
|
// * Author : Александр (Rouse_) Багель
|
|
// * Copyright : © Fangorn Wizards Lab 1998 - 2024.
|
|
// * Version : 2.0.4
|
|
// * Home Page : http://rouse.drkb.ru
|
|
// * Home Blog : http://alexander-bagel.blogspot.ru
|
|
// ****************************************************************************
|
|
// * Stable Release : http://rouse.drkb.ru/components.php#fwzip
|
|
// * Latest Source : https://github.com/AlexanderBagel/FWZip
|
|
// ****************************************************************************
|
|
//
|
|
// Используемые источники:
|
|
// ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
|
|
// https://zlib.net/zlib-1.3.1.tar.gz
|
|
// http://www.base2ti.com/
|
|
//
|
|
|
|
unit FWZipZLibFPC;
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE Delphi}
|
|
{$H+}
|
|
{$ELSE}
|
|
{$MESSAGE ERROR 'FPC ONLY!!!'}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
const
|
|
{** version ids *******************************************************************************}
|
|
|
|
ZLIB_VERSION: PAnsiChar = '1.3.1';
|
|
|
|
ZLIB_VERNUM = $1310;
|
|
|
|
ZLIB_VER_MAJOR = 1;
|
|
ZLIB_VER_MINOR = 3;
|
|
ZLIB_VER_REVISION = 1;
|
|
ZLIB_VER_SUBREVISION = 0;
|
|
|
|
{** return codes ******************************************************************************}
|
|
|
|
Z_OK = 0;
|
|
Z_STREAM_END = 1;
|
|
Z_NEED_DICT = 2;
|
|
Z_ERRNO = (-1);
|
|
Z_STREAM_ERROR = (-2);
|
|
Z_DATA_ERROR = (-3);
|
|
Z_MEM_ERROR = (-4);
|
|
Z_BUF_ERROR = (-5);
|
|
Z_VERSION_ERROR = (-6);
|
|
|
|
{** compression levels ************************************************************************}
|
|
|
|
Z_NO_COMPRESSION = 0;
|
|
Z_BEST_SPEED = 1;
|
|
Z_BEST_COMPRESSION = 9;
|
|
Z_DEFAULT_COMPRESSION = (-1);
|
|
|
|
type
|
|
TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer; cdecl;
|
|
TZFree = procedure (opaque, block: Pointer); cdecl;
|
|
|
|
{** TZStreamRec *******************************************************************************}
|
|
|
|
{$IFDEF LINUX}
|
|
LongwordType = NativeUInt;
|
|
{$ELSE}
|
|
LongwordType = Longword;
|
|
{$ENDIF}
|
|
|
|
TZStreamRec = record
|
|
next_in : PByte; // next input byte
|
|
avail_in : Cardinal; // number of bytes available at next_in
|
|
total_in : LongwordType; // total nb of input bytes read so far
|
|
|
|
next_out : PByte; // next output byte should be put here
|
|
avail_out: Cardinal; // remaining free space at next_out
|
|
total_out: LongwordType; // total nb of bytes output so far
|
|
|
|
msg : PAnsiChar; // last error message, NULL if no error
|
|
state : Pointer; // not visible by applications
|
|
|
|
zalloc : TZAlloc; // used to allocate the internal state
|
|
zfree : TZFree; // used to free the internal state
|
|
opaque : Pointer; // private data object passed to zalloc and zfree
|
|
|
|
data_type: Integer; // best guess about the data type: ascii or binary
|
|
adler : LongwordType; // adler32 value of the uncompressed data
|
|
reserved : LongwordType; // reserved for future use
|
|
end;
|
|
|
|
{** external routines ***************************************************************************}
|
|
|
|
function deflateInit_(var strm: TZStreamRec; level: Integer;
|
|
version: PAnsiChar; recsize: Integer): Integer; cdecl;
|
|
|
|
function deflateInit2_(var strm: TZStreamRec; level, method, windowBits,
|
|
memLevel, strategy: Integer; version: PAnsiChar; recsize: Integer): Integer; cdecl;
|
|
|
|
function deflate(var strm: TZStreamRec; flush: Integer): Integer; cdecl;
|
|
|
|
function deflateEnd(var strm: TZStreamRec): Integer; cdecl;
|
|
|
|
function deflateReset(var strm: TZStreamRec): Integer; cdecl;
|
|
|
|
function inflateInit_(var strm: TZStreamRec; version: PAnsiChar;
|
|
recsize: Integer): Integer; cdecl;
|
|
|
|
function inflateInit2_(var strm: TZStreamRec; windowBits: Integer;
|
|
version: PAnsiChar; recsize: Integer): Integer; cdecl;
|
|
|
|
function inflate(var strm: TZStreamRec; flush: Integer): Integer; cdecl;
|
|
|
|
function inflateEnd(var strm: TZStreamRec): Integer; cdecl;
|
|
|
|
function inflateReset(var strm: TZStreamRec): Integer; cdecl;
|
|
|
|
function adler32(adler: Longint; const buf; len: Integer): Longint; cdecl;
|
|
|
|
function crc32(crc: Longint; const buf; len: Integer): Longint; cdecl;
|
|
|
|
implementation
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF CPU64}
|
|
{$LINKLIB fpc_lib\libzlib_coff_win_amd64.a}
|
|
{$ELSE}
|
|
{$LINKLIB fpc_lib\libzlib_coff_x386.a}
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF CPU64}
|
|
{$LINKLIB fpc_lib\libzlib_elf64_for_x86-64.a}
|
|
{$ELSE}
|
|
{$LINKLIB fpc_lib\libzlib_elf_intel_386.a}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
{** external routines ***************************************************************************}
|
|
|
|
function deflateInit_ external;
|
|
function deflateInit2_ external;
|
|
function deflate external;
|
|
function deflateEnd external;
|
|
function deflateReset external;
|
|
function inflateInit_ external;
|
|
function inflateInit2_ external;
|
|
function inflate external;
|
|
function inflateEnd external;
|
|
function inflateReset external;
|
|
function adler32 external;
|
|
function crc32 external;
|
|
|
|
{** c function implementations ******************************************************************}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
|
|
function malloc(size : size_t): Pointer; cdecl;
|
|
public name {$IFDEF CPU32}'_malloc'{$ELSE}'malloc'{$ENDIF};
|
|
begin
|
|
GetMem(result, size);
|
|
end;
|
|
|
|
procedure free(block: Pointer); cdecl;
|
|
public name {$IFDEF CPU32}'_free'{$ELSE}'free'{$ENDIF};
|
|
begin
|
|
FreeMem(block);
|
|
end;
|
|
|
|
function memset(dest: Pointer; val: Integer; count: size_t): Pointer; cdecl;
|
|
public name {$IFDEF CPU32}'_memset'{$ELSE}'memset'{$ENDIF};
|
|
begin
|
|
FillChar(dest^, count, val);
|
|
Result := dest;
|
|
end;
|
|
|
|
procedure memcpy(dest, src: Pointer; count: size_t); cdecl;
|
|
public name {$IFDEF CPU32}'_memcpy'{$ELSE}'memcpy'{$ENDIF};
|
|
begin
|
|
Move(src^, dest^, count);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
end.
|