123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792 |
- unit zip;
- { zip.c -- IO on .zip files using zlib
- zip.h -- IO for compress .zip files using zlib
- Version 0.15 alpha, Mar 19th, 1998,
- Copyright (C) 1998 Gilles Vollant
- This package allows to create .ZIP file, compatible with PKZip 2.04g
- WinZip, InfoZip tools and compatible.
- Encryption and multi volume ZipFile (span) are not supported.
- Old compressions used by old PKZip 1.x are not supported
- For decompression of .zip files, look at unzip.pas
- Pascal tranlastion
- Copyright (C) 2000 by Jacques Nomssi Nzali
- For conditions of distribution and use, see copyright notice in readme.txt }
- interface
- {$ifdef WIN32}
- {$define Delphi}
- {$endif}
- uses
- //zutil,
- zbase,
- //zLib,
- ziputils;
- const
- ZIP_OK = (0);
- ZIP_ERRNO = (Z_ERRNO);
- ZIP_PARAMERROR = (-102);
- ZIP_INTERNALERROR = (-104);
- Z_DEFAULT_COMPRESSION = -(1);
- Z_DEFLATED = 8;
- (*
- { tm_zip contain date/time info }
- type
- tm_zip = record
- tm_sec : integer; { seconds after the minute - [0,59] }
- tm_min : integer; { minutes after the hour - [0,59] }
- tm_hour : integer; { hours since midnight - [0,23] }
- tm_mday : integer; { day of the month - [1,31] }
- tm_mon : integer; { months since January - [0,11] }
- tm_year : integer; { years - [1980..2044] }
- end;
- *)
- type
- zip_fileinfo = record
- tmz_date: tm_zip; { date in understandable format }
- dosDate: longword; { if dos_date = 0, tmu_date is used }
- { flag : longint; }{ general purpose bit flag 2 bytes }
- internal_fa: longint; { internal file attributes 2 bytes }
- external_fa: longint; { external file attributes 4 bytes }
- end;
- zip_fileinfo_ptr = ^zip_fileinfo;
- function zipOpen(const pathname: PChar; append: longint): zipFile; {ZEXPORT}
- { Create a zipfile.
- pathname contain on Windows NT a filename like "c:\\zlib\\zlib111.zip" or on
- an Unix computer "zlib/zlib111.zip".
- if the file pathname exist and append=1, the zip will be created at the end
- of the file. (useful if the file contain a self extractor code)
- If the zipfile cannot be opened, the return value is NIL.
- Else, the return value is a zipFile Handle, usable with other function
- of this zip package. }
- function zipOpenNewFileInZip(afile: zipFile;
- {const} filename: PChar; const zipfi: zip_fileinfo_ptr; const extrafield_local: pointer; size_extrafield_local: integer; const extrafield_global: pointer; size_extrafield_global: integer; const comment: PChar; method: longint; level: longint): longint; {ZEXPORT}
- { Open a file in the ZIP for writing.
- filename : the filename in zip (if NIL, '-' without quote will be used
- zipfi^ contain supplemental information
- if extrafield_local<>NIL and size_extrafield_local>0, extrafield_local
- contains the extrafield data the the local header
- if extrafield_global<>NIL and size_extrafield_global>0, extrafield_global
- contains the extrafield data the the local header
- if comment <> NIL, comment contain the comment string
- method contain the compression method (0 for store, Z_DEFLATED for deflate)
- level contain the level of compression (can be Z_DEFAULT_COMPRESSION) }
- function zipWriteInFileInZip(afile: zipFile; const buf: pointer; len: cardinal): longint; {ZEXPORT}
- { Write data in the zipfile }
- function zipCloseFileInZip(afile: zipFile): longint; {ZEXPORT}
- { Close the current file in the zipfile }
- function zipClose(afile: zipFile; const global_comment: PChar): longint; {ZEXPORT}
- { Close the zipfile }
- implementation
- uses
- {$ifdef Delphi}
- SysUtils,
- {$else}
- strings,
- {$endif}
- zDeflate, crc;
- const
- VERSIONMADEBY = ($0); { platform depedent }
- const
- zip_copyright: PChar = ' zip 0.15 Copyright 1998 Gilles Vollant ';
- const
- SIZEDATA_INDATABLOCK = (4096 - (4 * 4));
- LOCALHEADERMAGIC = $04034b50;
- {CENTRALHEADERMAGIC = $02014b50;}
- ENDHEADERMAGIC = $06054b50;
- FLAG_LOCALHEADER_OFFSET = $06;
- CRC_LOCALHEADER_OFFSET = $0e;
- SIZECENTRALHEADER = $2e; { 46 }
- type
- linkedlist_datablock_internal_ptr = ^linkedlist_datablock_internal;
- linkedlist_datablock_internal = record
- next_datablock: linkedlist_datablock_internal_ptr;
- avail_in_this_block: longint;
- filled_in_this_block: longint;
- unused: longint; { for future use and alignement }
- Data: array[0..SIZEDATA_INDATABLOCK - 1] of byte;
- end;
- type
- linkedlist_data = record
- first_block: linkedlist_datablock_internal_ptr;
- last_block: linkedlist_datablock_internal_ptr;
- end;
- linkedlist_data_ptr = ^linkedlist_data;
- type
- curfile_info = record
- stream: z_stream; { zLib stream structure for inflate }
- stream_initialised: boolean; { TRUE is stream is initialised }
- pos_in_buffered_data: integer; { last written byte in buffered_data }
- pos_local_header: longint; { offset of the local header of the file
- currenty writing }
- central_header: PChar; { central header data for the current file }
- size_centralheader: longint; { size of the central header for cur file }
- flag: longint; { flag of the file currently writing }
- method: longint; { compression method of file currenty wr.}
- buffered_data: array[0..Z_BUFSIZE - 1] of byte;{ buffer contain compressed data to be written}
- dosDate: longint;
- crc32: longint;
- end;
- type
- zip_internal = record
- filezip: FILEptr;
- central_dir: linkedlist_data; { datablock with central dir in construction}
- in_opened_file_inzip: boolean; { TRUE if a file in the zip is currently writ.}
- ci: curfile_info; { info on the file curretly writing }
- begin_pos: longint; { position of the beginning of the zipfile }
- number_entry: longint;
- end;
- zip_internal_ptr = ^zip_internal;
- function allocate_new_datablock: linkedlist_datablock_internal_ptr;
- var
- ldi: linkedlist_datablock_internal_ptr;
- begin
- ldi := linkedlist_datablock_internal_ptr(GetMem(sizeof(linkedlist_datablock_internal)));
- if (ldi <> nil) then
- begin
- ldi^.next_datablock := nil;
- ldi^.filled_in_this_block := 0;
- ldi^.avail_in_this_block := SIZEDATA_INDATABLOCK;
- end;
- allocate_new_datablock := ldi;
- end;
- procedure free_datablock(ldi: linkedlist_datablock_internal_ptr);
- var
- ldinext: linkedlist_datablock_internal_ptr;
- begin
- while (ldi <> nil) do
- begin
- ldinext := ldi^.next_datablock;
- FreeMem(ldi);
- ldi := ldinext;
- end;
- end;
- procedure init_linkedlist(var ll: linkedlist_data);
- begin
- ll.last_block := nil;
- ll.first_block := nil;
- end;
- procedure free_linkedlist(var ll: linkedlist_data);
- begin
- free_datablock(ll.first_block);
- ll.last_block := nil;
- ll.first_block := nil;
- end;
- function add_data_in_datablock(ll: linkedlist_data_ptr; const buf: pointer; len: longint): longint;
- var
- ldi: linkedlist_datablock_internal_ptr;
- from_copy: {const} Pbyte;
- var
- copy_this: integer;
- i: integer;
- to_copy: Pbyte;
- begin
- if (ll = nil) then
- begin
- add_data_in_datablock := ZIP_INTERNALERROR;
- exit;
- end;
- if (ll^.last_block = nil) then
- begin
- ll^.last_block := allocate_new_datablock;
- ll^.first_block := ll^.last_block;
- if (ll^.first_block = nil) then
- begin
- add_data_in_datablock := ZIP_INTERNALERROR;
- exit;
- end;
- end;
- ldi := ll^.last_block;
- from_copy := Pbyte(buf);
- while (len > 0) do
- begin
- if (ldi^.avail_in_this_block = 0) then
- begin
- ldi^.next_datablock := allocate_new_datablock;
- if (ldi^.next_datablock = nil) then
- begin
- add_data_in_datablock := ZIP_INTERNALERROR;
- exit;
- end;
- ldi := ldi^.next_datablock;
- ll^.last_block := ldi;
- end;
- if (ldi^.avail_in_this_block < len) then
- copy_this := integer(ldi^.avail_in_this_block)
- else
- copy_this := integer(len);
- to_copy := @(ldi^.Data[ldi^.filled_in_this_block]);
- for i := 0 to copy_this - 1 do
- Pbytearray(to_copy)^[i] := Pbytearray(from_copy)^[i];
- Inc(ldi^.filled_in_this_block, copy_this);
- Dec(ldi^.avail_in_this_block, copy_this);
- Inc(from_copy, copy_this);
- Dec(len, copy_this);
- end;
- add_data_in_datablock := ZIP_OK;
- end;
- function write_datablock(fout: FILEptr; ll: linkedlist_data_ptr): longint;
- var
- ldi: linkedlist_datablock_internal_ptr;
- begin
- ldi := ll^.first_block;
- while (ldi <> nil) do
- begin
- if (ldi^.filled_in_this_block > 0) then
- if (fwrite(@ldi^.Data, integer(ldi^.filled_in_this_block), 1, fout) <> 1) then
- begin
- write_datablock := ZIP_ERRNO;
- exit;
- end;
- ldi := ldi^.next_datablock;
- end;
- write_datablock := ZIP_OK;
- end;
- {**************************************************************************}
- { ===========================================================================
- Outputs a long in LSB order to the given file
- nbByte = 1, 2 or 4 (byte, short or long) }
- function ziplocal_putValue(afile: FILEptr; x: longint; nbByte: longint): longint;
- var
- buf: array[0..4 - 1] of byte;
- n: longint;
- begin
- for n := 0 to nbByte - 1 do
- begin
- buf[n] := byte(x and $ff);
- x := x shr 8;
- end;
- if (fwrite(@buf, nbByte, 1, afile) <> 1) then
- ziplocal_putValue := ZIP_ERRNO
- else
- ziplocal_putValue := ZIP_OK;
- end;
- procedure ziplocal_putValue_inmemory(dest: pointer; x: longint; nbByte: longint);
- var
- buf: Pbytearray;
- n: longint;
- begin
- buf := Pbytearray(dest);
- for n := 0 to nbByte - 1 do
- begin
- buf^[n] := Byte(x and $ff);
- x := x shr 8;
- end;
- end;
- {**************************************************************************}
- function ziplocal_TmzDateToDosDate(var ptm: tm_zip; dosDate: longint): longint;
- var
- year: longint;
- begin
- year := longint(ptm.tm_year);
- if (year > 1980) then
- Dec(year, 1980)
- else
- if (year > 80) then
- Dec(year, 80);
- ziplocal_TmzDateToDosDate := longint(
- ((ptm.tm_mday) + (32 * (ptm.tm_mon + 1)) + (512 * year)) shl 16) or
- ((ptm.tm_sec div 2) + (32 * ptm.tm_min) + (2048 * longint(ptm.tm_hour)));
- end;
- {**************************************************************************}
- function zipOpen(const pathname: PChar; append: longint): zipFile; {ZEXPORT}
- var
- ziinit: zip_internal;
- zi: zip_internal_ptr;
- begin
- if (append = 0) then
- ziinit.filezip := fopen(pathname, fopenwrite)
- else
- ziinit.filezip := fopen(pathname, fappendwrite);
- if (ziinit.filezip = nil) then
- begin
- zipOpen := nil;
- exit;
- end;
- ziinit.begin_pos := ftell(ziinit.filezip);
- ziinit.in_opened_file_inzip := False;
- ziinit.ci.stream_initialised := False;
- ziinit.number_entry := 0;
- init_linkedlist(ziinit.central_dir);
- zi := zip_internal_ptr(AllocMem(sizeof(zip_internal)));
- if (zi = nil) then
- begin
- fclose(ziinit.filezip);
- zipOpen := nil;
- exit;
- end;
- zi^ := ziinit;
- zipOpen := zipFile(zi);
- end;
- function zipOpenNewFileInZip(afile: zipFile;
- {const} filename: PChar; const zipfi: zip_fileinfo_ptr; const extrafield_local: pointer; size_extrafield_local: integer; const extrafield_global: pointer; size_extrafield_global: integer; const comment: PChar; method: longint; level: longint): longint; {ZEXPORT}
- var
- zi: zip_internal_ptr;
- size_filename: integer;
- size_comment: integer;
- i: integer;
- err: longint;
- begin
- err := ZIP_OK;
- if (afile = nil) then
- begin
- zipOpenNewFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- if ((method <> 0) and (method <> Z_DEFLATED)) then
- begin
- zipOpenNewFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- zi := zip_internal_ptr(afile);
- if (zi^.in_opened_file_inzip = True) then
- begin
- err := zipCloseFileInZip(afile);
- if (err <> ZIP_OK) then
- begin
- zipOpenNewFileInZip := err;
- exit;
- end;
- end;
- if (filename = nil) then
- filename := '-';
- if (comment = nil) then
- size_comment := 0
- else
- size_comment := strlen(comment);
- size_filename := strlen(filename);
- if (zipfi = nil) then
- zi^.ci.dosDate := 0
- else
- if (zipfi^.dosDate <> 0) then
- zi^.ci.dosDate := zipfi^.dosDate
- else
- zi^.ci.dosDate := ziplocal_TmzDateToDosDate(zipfi^.tmz_date, zipfi^.dosDate);
- zi^.ci.flag := 0;
- if ((level = 8) or (level = 9)) then
- zi^.ci.flag := zi^.ci.flag or 2;
- if ((level = 2)) then
- zi^.ci.flag := zi^.ci.flag or 4;
- if ((level = 1)) then
- zi^.ci.flag := zi^.ci.flag or 6;
- zi^.ci.crc32 := 0;
- zi^.ci.method := method;
- zi^.ci.stream_initialised := False;
- zi^.ci.pos_in_buffered_data := 0;
- zi^.ci.pos_local_header := ftell(zi^.filezip);
- zi^.ci.size_centralheader := SIZECENTRALHEADER + size_filename +
- size_extrafield_global + size_comment;
- zi^.ci.central_header := PChar(AllocMem(integer(zi^.ci.size_centralheader)));
- ziplocal_putValue_inmemory(zi^.ci.central_header, longint(CENTRALHEADERMAGIC), 4);
- { version info }
- ziplocal_putValue_inmemory(zi^.ci.central_header + 4, longint(VERSIONMADEBY), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 6, longint(20), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 8, longint(zi^.ci.flag), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 10, longint(zi^.ci.method), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 12, longint(zi^.ci.dosDate), 4);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 16, longint(0), 4); {crc}
- ziplocal_putValue_inmemory(zi^.ci.central_header + 20, longint(0), 4); {compr size}
- ziplocal_putValue_inmemory(zi^.ci.central_header + 24, longint(0), 4); {uncompr size}
- ziplocal_putValue_inmemory(zi^.ci.central_header + 28, longint(size_filename), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 30, longint(size_extrafield_global), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 32, longint(size_comment), 2);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 34, longint(0), 2); {disk nm start}
- if (zipfi = nil) then
- ziplocal_putValue_inmemory(zi^.ci.central_header + 36, longint(0), 2)
- else
- ziplocal_putValue_inmemory(zi^.ci.central_header + 36, longint(zipfi^.internal_fa), 2);
- if (zipfi = nil) then
- ziplocal_putValue_inmemory(zi^.ci.central_header + 38, longint(0), 4)
- else
- ziplocal_putValue_inmemory(zi^.ci.central_header + 38, longint(zipfi^.external_fa), 4);
- ziplocal_putValue_inmemory(zi^.ci.central_header + 42, longint(zi^.ci.pos_local_header), 4);
- i := 0;
- while (i < size_filename) do
- begin
- (zi^.ci.central_header +SIZECENTRALHEADER + i)^ := (filename + i)^;
- Inc(i);
- end;
- i := 0;
- while (i < size_extrafield_global) do
- begin
- (zi^.ci.central_header +SIZECENTRALHEADER + size_filename + i)^ :=
- ({const} PChar(extrafield_global) + i)^;
- Inc(i);
- end;
- i := 0;
- while (i < size_comment) do
- begin
- (zi^.ci.central_header +SIZECENTRALHEADER + size_filename + size_extrafield_global + i)^ := (filename + i)^;
- Inc(i);
- end;
- if (zi^.ci.central_header = nil) then
- begin
- zipOpenNewFileInZip := ZIP_INTERNALERROR;
- exit;
- end;
- { write the local header }
- err := ziplocal_putValue(zi^.filezip, longint(LOCALHEADERMAGIC), 4);
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(20), 2); { version needed to extract }
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.flag), 2);
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.method), 2);
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.dosDate), 4);
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(0), 4); { crc 32, unknown }
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(0), 4); { compressed size, unknown }
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(0), 4); { uncompressed size, unknown }
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(size_filename), 2);
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(size_extrafield_local), 2);
- if ((err = ZIP_OK) and (size_filename > 0)) then
- if (fwrite(filename, integer(size_filename), 1, zi^.filezip) <> 1) then
- err := ZIP_ERRNO;
- if ((err = ZIP_OK) and (size_extrafield_local > 0)) then
- if (fwrite(extrafield_local, integer(size_extrafield_local), 1, zi^.filezip) <> 1) then
- err := ZIP_ERRNO;
- zi^.ci.stream.avail_in := integer(0);
- zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
- zi^.ci.stream.next_out := Pbyte(@zi^.ci.buffered_data);
- zi^.ci.stream.total_in := 0;
- zi^.ci.stream.total_out := 0;
- if ((err = ZIP_OK) and (zi^.ci.method = Z_DEFLATED)) then
- begin
- err := deflateInit2(zi^.ci.stream, level,
- Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0);
- if (err = Z_OK) then
- zi^.ci.stream_initialised := True;
- end;
- if (err = Z_OK) then
- zi^.in_opened_file_inzip := True;
- zipOpenNewFileInZip := err;
- end;
- function zipWriteInFileInZip(afile: zipFile; const buf: pointer; len: cardinal): longint; {ZEXPORT}
- var
- zi: zip_internal_ptr;
- err: longint;
- var
- uTotalOutBefore: longint;
- var
- copy_this, i: integer;
- begin
- err := ZIP_OK;
- if (afile = nil) then
- begin
- zipWriteInFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- zi := zip_internal_ptr(afile);
- if (zi^.in_opened_file_inzip = False) then
- begin
- zipWriteInFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- zi^.ci.stream.next_in := buf;
- zi^.ci.stream.avail_in := len;
- zi^.ci.crc32 := crc32(zi^.ci.crc32, buf, len);
- while ((err = ZIP_OK) and (zi^.ci.stream.avail_in > 0)) do
- begin
- if (zi^.ci.stream.avail_out = 0) then
- begin
- if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
- err := ZIP_ERRNO;
- zi^.ci.pos_in_buffered_data := 0;
- zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
- zi^.ci.stream.next_out := Pbyte(@zi^.ci.buffered_data);
- end;
- if (zi^.ci.method = Z_DEFLATED) then
- begin
- uTotalOutBefore := zi^.ci.stream.total_out;
- err := deflate(zi^.ci.stream, Z_NO_FLUSH);
- Inc(zi^.ci.pos_in_buffered_data, integer(zi^.ci.stream.total_out - uTotalOutBefore));
- end
- else
- begin
- if (zi^.ci.stream.avail_in < zi^.ci.stream.avail_out) then
- copy_this := zi^.ci.stream.avail_in
- else
- copy_this := zi^.ci.stream.avail_out;
- for i := 0 to copy_this - 1 do
- (PChar(zi^.ci.stream.next_out) +i)^ :=
- ( {const} PChar(zi^.ci.stream.next_in) + i)^;
- Dec(zi^.ci.stream.avail_in, copy_this);
- Dec(zi^.ci.stream.avail_out, copy_this);
- Inc(zi^.ci.stream.next_in, copy_this);
- Inc(zi^.ci.stream.next_out, copy_this);
- Inc(zi^.ci.stream.total_in, copy_this);
- Inc(zi^.ci.stream.total_out, copy_this);
- Inc(zi^.ci.pos_in_buffered_data, copy_this);
- end;
- end;
- zipWriteInFileInZip := 0;
- end;
- function zipCloseFileInZip(afile: zipFile): longint; {ZEXPORT}
- var
- zi: zip_internal_ptr;
- err: longint;
- var
- uTotalOutBefore: longint;
- var
- cur_pos_inzip: longint;
- begin
- err := ZIP_OK;
- if (afile = nil) then
- begin
- zipCloseFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- zi := zip_internal_ptr(afile);
- if (zi^.in_opened_file_inzip = False) then
- begin
- zipCloseFileInZip := ZIP_PARAMERROR;
- exit;
- end;
- zi^.ci.stream.avail_in := 0;
- if (zi^.ci.method = Z_DEFLATED) then
- while (err = ZIP_OK) do
- begin
- if (zi^.ci.stream.avail_out = 0) then
- begin
- if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
- err := ZIP_ERRNO;
- zi^.ci.pos_in_buffered_data := 0;
- zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
- zi^.ci.stream.next_out := Pbyte(@zi^.ci.buffered_data);
- end;
- uTotalOutBefore := zi^.ci.stream.total_out;
- err := deflate(zi^.ci.stream, Z_FINISH);
- Inc(zi^.ci.pos_in_buffered_data, integer(zi^.ci.stream.total_out - uTotalOutBefore));
- end;
- if (err = Z_STREAM_END) then
- err := ZIP_OK; { this is normal }
- if (zi^.ci.pos_in_buffered_data > 0) and (err = ZIP_OK) then
- if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
- err := ZIP_ERRNO;
- if ((zi^.ci.method = Z_DEFLATED) and (err = ZIP_OK)) then
- begin
- err := deflateEnd(zi^.ci.stream);
- zi^.ci.stream_initialised := False;
- end;
- ziplocal_putValue_inmemory(zi^.ci.central_header + 16, longint(zi^.ci.crc32), 4); {crc}
- ziplocal_putValue_inmemory(zi^.ci.central_header + 20, longint(zi^.ci.stream.total_out), 4); {compr size}
- ziplocal_putValue_inmemory(zi^.ci.central_header + 24, longint(zi^.ci.stream.total_in), 4); {uncompr size}
- if (err = ZIP_OK) then
- err := add_data_in_datablock(@zi^.central_dir, zi^.ci.central_header, longint(zi^.ci.size_centralheader));
- FreeMem(zi^.ci.central_header);
- if (err = ZIP_OK) then
- begin
- cur_pos_inzip := ftell(zi^.filezip);
- if fseek(zi^.filezip, zi^.ci.pos_local_header + 14, SEEK_SET) <> 0 then
- err := ZIP_ERRNO;
- if (err = ZIP_OK) then
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.crc32), 4); { crc 32, unknown }
- if (err = ZIP_OK) then { compressed size, unknown }
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.stream.total_out), 4);
- if (err = ZIP_OK) then { uncompressed size, unknown }
- err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.stream.total_in), 4);
- if fseek(zi^.filezip, cur_pos_inzip, SEEK_SET) <> 0 then
- err := ZIP_ERRNO;
- end;
- Inc(zi^.number_entry);
- zi^.in_opened_file_inzip := False;
- zipCloseFileInZip := err;
- end;
- function zipClose(afile: zipFile; const global_comment: PChar): longint; {ZEXPORT}
- var
- zi: zip_internal_ptr;
- err: longint;
- size_centraldir: longint;
- centraldir_pos_inzip: longint;
- size_global_comment: integer;
- var
- ldi: linkedlist_datablock_internal_ptr;
- begin
- err := 0;
- size_centraldir := 0;
- if (afile = nil) then
- begin
- zipClose := ZIP_PARAMERROR;
- exit;
- end;
- zi := zip_internal_ptr(afile);
- if (zi^.in_opened_file_inzip = True) then
- err := zipCloseFileInZip(afile);
- if (global_comment = nil) then
- size_global_comment := 0
- else
- size_global_comment := strlen(global_comment);
- centraldir_pos_inzip := ftell(zi^.filezip);
- if (err = ZIP_OK) then
- begin
- ldi := zi^.central_dir.first_block;
- while (ldi <> nil) do
- begin
- if ((err = ZIP_OK) and (ldi^.filled_in_this_block > 0)) then
- if fwrite(@ldi^.Data, integer(ldi^.filled_in_this_block), 1, zi^.filezip) <> 1 then
- err := ZIP_ERRNO;
- Inc(size_centraldir, ldi^.filled_in_this_block);
- ldi := ldi^.next_datablock;
- end;
- end;
- free_datablock(zi^.central_dir.first_block);
- if (err = ZIP_OK) then { Magic End }
- err := ziplocal_putValue(zi^.filezip, longint(ENDHEADERMAGIC), 4);
- if (err = ZIP_OK) then { number of this disk }
- err := ziplocal_putValue(zi^.filezip, longint(0), 2);
- if (err = ZIP_OK) then { number of the disk with the start of the central directory }
- err := ziplocal_putValue(zi^.filezip, longint(0), 2);
- if (err = ZIP_OK) then { total number of entries in the central dir on this disk }
- err := ziplocal_putValue(zi^.filezip, longint(zi^.number_entry), 2);
- if (err = ZIP_OK) then { total number of entries in the central dir }
- err := ziplocal_putValue(zi^.filezip, longint(zi^.number_entry), 2);
- if (err = ZIP_OK) then { size of the central directory }
- err := ziplocal_putValue(zi^.filezip, longint(size_centraldir), 4);
- if (err = ZIP_OK) then { offset of start of central directory with respect to the
- starting disk number }
- err := ziplocal_putValue(zi^.filezip, longint(centraldir_pos_inzip), 4);
- if (err = ZIP_OK) then { zipfile comment length }
- err := ziplocal_putValue(zi^.filezip, longint(size_global_comment), 2);
- if ((err = ZIP_OK) and (size_global_comment > 0)) then
- if fwrite(global_comment, integer(size_global_comment), 1, zi^.filezip) <> 1 then
- err := ZIP_ERRNO;
- fclose(zi^.filezip);
- FreeMem(zi);
- zipClose := err;
- end;
- end.
|