zlibpas.pas 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157
  1. {Portable Network Graphics Delphi ZLIB linking (16 May 2002) }
  2. {This unit links ZLIB to pngimage unit in order to implement }
  3. {the library. It's now using the new ZLIB version, 1.1.4 }
  4. {Note: The .obj files must be located in the subdirectory \obj}
  5. unit zlibpas;
  6. interface
  7. type
  8. TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
  9. TFree = procedure (AppData, Block: Pointer);
  10. // Internal structure. Ignore.
  11. TZStreamRec = packed record
  12. next_in: PChar; // next input byte
  13. avail_in: Integer; // number of bytes available at next_in
  14. total_in: Integer; // total nb of input bytes read so far
  15. next_out: PChar; // next output byte should be put here
  16. avail_out: Integer; // remaining free space at next_out
  17. total_out: Integer; // total nb of bytes output so far
  18. msg: PChar; // last error message, NULL if no error
  19. internal: Pointer; // not visible by applications
  20. zalloc: TAlloc; // used to allocate the internal state
  21. zfree: TFree; // used to free the internal state
  22. AppData: Pointer; // private data object passed to zalloc and zfree
  23. data_type: Integer; // best guess about the data type: ascii or binary
  24. adler: Integer; // adler32 value of the uncompressed data
  25. reserved: Integer; // reserved for future use
  26. end;
  27. function inflateInit_(var strm: TZStreamRec; version: PChar;
  28. recsize: Integer): Integer; forward;
  29. function inflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
  30. function inflateEnd(var strm: TZStreamRec): Integer; forward;
  31. function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  32. recsize: Integer): Integer; forward;
  33. function deflate(var strm: TZStreamRec; flush: Integer): Integer; forward;
  34. function deflateEnd(var strm: TZStreamRec): Integer; forward;
  35. const
  36. zlib_version = '1.2.3';
  37. const
  38. Z_NO_FLUSH = 0;
  39. Z_PARTIAL_FLUSH = 1;
  40. Z_SYNC_FLUSH = 2;
  41. Z_FULL_FLUSH = 3;
  42. Z_FINISH = 4;
  43. Z_OK = 0;
  44. Z_STREAM_END = 1;
  45. Z_NEED_DICT = 2;
  46. Z_ERRNO = (-1);
  47. Z_STREAM_ERROR = (-2);
  48. Z_DATA_ERROR = (-3);
  49. Z_MEM_ERROR = (-4);
  50. Z_BUF_ERROR = (-5);
  51. Z_VERSION_ERROR = (-6);
  52. Z_NO_COMPRESSION = 0;
  53. Z_BEST_SPEED = 1;
  54. Z_BEST_COMPRESSION = 9;
  55. Z_DEFAULT_COMPRESSION = (-1);
  56. Z_FILTERED = 1;
  57. Z_HUFFMAN_ONLY = 2;
  58. Z_DEFAULT_STRATEGY = 0;
  59. Z_BINARY = 0;
  60. Z_ASCII = 1;
  61. Z_UNKNOWN = 2;
  62. Z_DEFLATED = 8;
  63. _z_errmsg: array[0..9] of PChar = (
  64. 'need dictionary', // Z_NEED_DICT (2)
  65. 'stream end', // Z_STREAM_END (1)
  66. '', // Z_OK (0)
  67. 'file error', // Z_ERRNO (-1)
  68. 'stream error', // Z_STREAM_ERROR (-2)
  69. 'data error', // Z_DATA_ERROR (-3)
  70. 'insufficient memory', // Z_MEM_ERROR (-4)
  71. 'buffer error', // Z_BUF_ERROR (-5)
  72. 'incompatible version', // Z_VERSION_ERROR (-6)
  73. ''
  74. );
  75. implementation
  76. {$L obj\adler32.obj}
  77. {$L obj\deflate.obj}
  78. {$L obj\infback.obj}
  79. {$L obj\inffast.obj}
  80. {$L obj\inflate.obj}
  81. {$L obj\inftrees.obj}
  82. {$L obj\trees.obj}
  83. {$L obj\compress.obj}
  84. {$L obj\crc32.obj}
  85. function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; external;
  86. procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
  87. begin
  88. FillChar(P^, count, B);
  89. end;
  90. procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
  91. begin
  92. Move(source^, dest^, count);
  93. end;
  94. // deflate compresses data
  95. function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  96. recsize: Integer): Integer; external;
  97. function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
  98. function deflateEnd(var strm: TZStreamRec): Integer; external;
  99. // inflate decompresses data
  100. function inflateInit_(var strm: TZStreamRec; version: PChar;
  101. recsize: Integer): Integer; external;
  102. function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
  103. function inflateEnd(var strm: TZStreamRec): Integer; external;
  104. function inflateReset(var strm: TZStreamRec): Integer; external;
  105. function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
  106. begin
  107. GetMem(Result, Items*Size);
  108. end;
  109. procedure zcfree(AppData, Block: Pointer);
  110. begin
  111. FreeMem(Block);
  112. end;
  113. end.