FWZipZLibFPC.pas

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * 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.