zip4.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

  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
  begin
    if (zipfi^.dosDate <> 0) then
      zi^.ci.dosDate := zipfi^.dosDate
    else
      zi^.ci.dosDate := ziplocal_TmzDateToDosDate(zipfi^.tmz_date,zipfi^.dosDate);
  end;
  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( ALLOC( uInt(zi^.ci.size_centralheader)) );

  ziplocal_putValue_inmemory(zi^.ci.central_header,uLong(CENTRALHEADERMAGIC),4);
  { version info }
  ziplocal_putValue_inmemory(zi^.ci.central_header+4,uLong(VERSIONMADEBY),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+6,uLong(20),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+8,uLong(zi^.ci.flag),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+10,uLong(zi^.ci.method),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+12,uLong(zi^.ci.dosDate),4);
  ziplocal_putValue_inmemory(zi^.ci.central_header+16,uLong(0),4); {crc}
  ziplocal_putValue_inmemory(zi^.ci.central_header+20,uLong(0),4); {compr size}
  ziplocal_putValue_inmemory(zi^.ci.central_header+24,uLong(0),4); {uncompr size}
  ziplocal_putValue_inmemory(zi^.ci.central_header+28,uLong(size_filename),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+30,uLong(size_extrafield_global),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+32,uLong(size_comment),2);
  ziplocal_putValue_inmemory(zi^.ci.central_header+34,uLong(0),2); {disk nm start}

  if (zipfi=NIL) then
    ziplocal_putValue_inmemory(zi^.ci.central_header+36,uLong(0),2)
  else
    ziplocal_putValue_inmemory(zi^.ci.central_header+36,uLong(zipfi^.internal_fa),2);

   if (zipfi=NIL) then
    ziplocal_putValue_inmemory(zi^.ci.central_header+38,uLong(0),4)
  else
    ziplocal_putValue_inmemory(zi^.ci.central_header+38,uLong(zipfi^.external_fa),4);

  ziplocal_putValue_inmemory(zi^.ci.central_header+42,uLong(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, uLong(LOCALHEADERMAGIC),4);

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(20),2); { version needed to extract }
  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.flag),2);

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.method),2);

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(zi^.ci.dosDate),4);

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(0),4); { crc 32, unknown }
  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(0),4); { compressed size, unknown }
  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(0),4); { uncompressed size, unknown }

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(size_filename),2);

  if (err=ZIP_OK) then
    err := ziplocal_putValue(zi^.filezip,uLong(size_extrafield_local),2);

  if ((err=ZIP_OK) and (size_filename>0)) then
  begin
    if (fwrite(filename,uInt(size_filename),1,zi^.filezip)<>1) then
      err := ZIP_ERRNO;
  end;

  if ((err=ZIP_OK) and (size_extrafield_local>0)) then
  begin
    if (fwrite(extrafield_local, uInt(size_extrafield_local),1,zi^.filezip) <>1) then
      err := ZIP_ERRNO;
  end;

  zi^.ci.stream.avail_in := uInt(0);
  zi^.ci.stream.avail_out := uInt(Z_BUFSIZE);
  zi^.ci.stream.next_out := pBytef(@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
    zi^.ci.stream.zalloc := NIL;
    zi^.ci.stream.zfree := NIL;
    zi^.ci.stream.opaque := NIL;

    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;
{$HINTS ON}

function zipWriteInFileInZip (afile : zipFile; const buf : voidp; len : unsigned) : int; {ZEXPORT} 
var
  zi : zip_internal_ptr;
  err : int;
var
  uTotalOutBefore : uLong;
var
  copy_this,i : uInt;
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,uInt(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 := uInt(Z_BUFSIZE);
      zi^.ci.stream.next_out := pBytef(@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,  uInt(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;

{$HINTS OFF}
function zipCloseFileInZip (afile : zipFile) : int; {ZEXPORT}
var
  zi : zip_internal_ptr;
  err : int;
var
  uTotalOutBefore : uLong;
var
  cur_pos_inzip : long;
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,uInt(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 := uInt(Z_BUFSIZE);
      zi^.ci.stream.next_out := pBytef(@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, uInt(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
  begin
    if fwrite(@zi^.ci.buffered_data,uInt(zi^.ci.pos_in_buffered_data),1,zi^.filezip) <>1 then
      err := ZIP_ERRNO;
  end;

  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, uLong(zi^.ci.crc32),4); {crc}
  ziplocal_putValue_inmemory(zi^.ci.central_header+20, uLong(zi^.ci.stream.total_out),4); {compr size}
  ziplocal_putValue_inmemory(zi^.ci.central_header+24, uLong(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, uLong(zi^.ci.size_centralheader));

  TRYFREE(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, uLong(zi^.ci.crc32),4); { crc 32, unknown }

    if (err=ZIP_OK) then { compressed size, unknown }
      err := ziplocal_putValue(zi^.filezip, uLong(zi^.ci.stream.total_out),4);

    if (err=ZIP_OK) then { uncompressed size, unknown }
      err := ziplocal_putValue(zi^.filezip,uLong(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;
{$HINTS ON}

function zipClose (afile : zipFile;
                   const global_comment : PChar) : int; {ZEXPORT}
var
  zi : zip_internal_ptr;
  err : int;
  size_centraldir : uLong;
  centraldir_pos_inzip : uLong;
  size_global_comment : uInt;
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
  begin
    err := zipCloseFileInZip (afile);
  end;

  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
      begin
        if fwrite(@ldi^.data,uInt(ldi^.filled_in_this_block), 1,zi^.filezip)<>1 then
          err := ZIP_ERRNO;
      end;

      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, uLong(ENDHEADERMAGIC),4);

  if (err=ZIP_OK) then { number of this disk }
    err := ziplocal_putValue(zi^.filezip, uLong(0),2);

  if (err=ZIP_OK) then { number of the disk with the start of the central directory }
    err := ziplocal_putValue(zi^.filezip, uLong(0),2);

  if (err=ZIP_OK) then { total number of entries in the central dir on this disk }
    err := ziplocal_putValue(zi^.filezip, uLong(zi^.number_entry),2);

  if (err=ZIP_OK) then { total number of entries in the central dir }
    err := ziplocal_putValue(zi^.filezip, uLong(zi^.number_entry),2);

  if (err=ZIP_OK) then { size of the central directory }
    err := ziplocal_putValue(zi^.filezip, uLong(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, uLong(centraldir_pos_inzip) ,4);

  if (err=ZIP_OK) then { zipfile comment length }
    err := ziplocal_putValue(zi^.filezip, uLong(size_global_comment),2);

  if ((err=ZIP_OK) and (size_global_comment>0)) then
  begin
    if fwrite(global_comment, uInt(size_global_comment),1,zi^.filezip)<>1 then
      err := ZIP_ERRNO;
  end;
  fclose(zi^.filezip);
  TRYFREE(zi);

  zipClose := err;
end;

end.