vclzip.pas

这是在磁疗用DELPHI编写一套安装软件的程序源码

      if (MultiZipInfo.MultiMode = mmSpan) then
      begin
        try
          clusterSize := GetClusterSize(ExtractFileDrive(ZipName)+'\');
        except
          clusterSize := 4096; // if error just default to 4096
        end;
        MultiZipInfo.SaveOnFirstDisk := MultiZipInfo.SaveOnFirstDisk + clusterSize;
      end;
  end;

  if MultiZipInfo.MultiMode = mmSpan then
    AmountToWrite := DiskRoom - MultiZipInfo.SaveOnFirstDisk
  else if MultiZipInfo.MultiMode = mmBlocks then
  begin
    if (MultiZipInfo.FirstBlockSize = 0) then
      AmountToWrite := MultiZipInfo.BlockSize - MultiZipInfo.SaveOnFirstDisk
    else
      AmountToWrite := MultiZipInfo.FirstBlockSize - MultiZipInfo.SaveOnFirstDisk;
  end;

    if MultiZipInfo.MultiMode <> mmNone then
    begin
      TotalUncompressedSize := TotalUnCompressedSize * 2;
      span_sig := SPANNED_SIG;
      zfile.Write(span_sig,SizeOf(LongInt));
    end;

  { For each file in the FilesList AddFileToZip }
    if (not Deleting) and (FilesList.Count > 0) then
    begin
      if (not StreamZipping) then
      begin
        for i := 0 to FilesList.Count - 1 do
        begin
          zipdata(i);
        end;
      end
      else
      begin
        Repeat
          zipdata(0);
          if (FFreeStream) then
            ZipStream.Free;
          ZipStream := nil;
          if (Assigned(FOnGetNextStream)) {$IFNDEF INT64STREAMS} or (Assigned(FOnGetNextTStream)) {$ENDIF} then
          begin
            FilesList.Clear;
            NextFile := '';
            {$IFNDEF INT64STREAMS}
            if (Assigned(FOnGetNextTStream)) then
            begin
              newStream := nil;
              FOnGetNextTStream(self, newStream, nextFile);
              if (newStream <> nil) then
              begin
                ZipStream := tKpHugeMemoryStream.Create;
                ZipStream.Size := newStream.Size;
                newStream.Position:=0;
                ZipStream.CopyFrom(newStream,newStream.Size);
                if (FFreeStream) then
                  newStream.Free;
              end;
            end
            else
            {$ENDIF}
            if (Assigned(FOnGetNextStream)) then
            begin
              FOnGetNextStream(self, ZipStream, nextFile);
            end;

            if (ZipStream <> nil) then
            begin
              ZipStream.Position := 0;
              FilesList.Add(nextFile);
            end;
          end;
        Until (ZipStream = nil);
      end;
    end; { If not Deleting }

    tmpecrec.offset_central := zfile.Position;
    tmpecrec.start_central_disk := CurrentDisk;
    totalCentralSize := 0;
    saveCentralPos := tmpecrec.offset_central;
    for i := 0 to tmpfiles2.Count - 1 do
    begin
      tmpfile_info := tmpfiles2.Items[i] as TZipHeaderInfo;
      if (MultiZipInfo.MultiMode <> mmNone) and (RoomLeft < tmpfile_info.CentralSize) then
      begin
        Inc(TotalCentralSize, zfile.Position - saveCentralPos);
        saveCentralPos := 0;
        NextPart;
        tmpecrec.num_entries_this_disk := 0;
        if i = 0 then
        begin
          tmpecrec.offset_central := 0;
          tmpecrec.start_central_disk := CurrentDisk;
        end;
      end;
      tmpfile_info.SaveCentralToStream(zfile, theZipFile, UsingTempFile);
      tmpecrec.num_entries_this_disk :=  tmpecrec.num_entries_this_disk + 1;
{ DONE :
Figure out how to handle the extra field length when using a temporary file
if there is a zip64 extra field that WE added. }
//      if (tmpfile_info.Cextra_field_length > 0) and (UsingTempFile) then
//      begin { Copy central directory's extra field } { 04/06/02  2.22+ }
//        theZipFile.Seek(tmpfile_info.central_offset + sizeOf(central_file_header) +
//          tmpfile_info.filename_length, soBeginning);
//        zfile.CopyFrom(theZipFile, tmpfile_info.Cextra_field_length);
//      end;
    end;
    Inc(TotalCentralSize, zfile.Position - saveCentralPos);
    tmpecrec.size_central := TotalCentralSize;
    if (MultiZipInfo.MultiMode <> mmNone) and (RoomLeft < tmpecrec.EndCentralSize) then
      NextPart;
    tmpecrec.this_disk := CurrentDisk;
    tmpecrec.SaveToStream(zfile);
    if MultiZipInfo.MultiMode = mmSpan then
      LabelDisk;
    FinishedOK := True;
  finally
{$IFNDEF USE_ZLIB}
    DeAllocateZipArrays;
{$ENDIF}
    if (not ArchiveIsStream) then
    begin
      if (MultiZipInfo.MultiMode <> mmNone) and (ecrec.num_disks = 1) then
      begin
        // Replace the spanning signature if only one spanned part
        zfile.Seek(0,soBeginning);
        span_not_sig := SPANNED_NOT_SIG;
        zfile.Write(span_not_sig, SizeOf(LongInt));
      end;
      zfile.Free; { close the temp zip file }
      zfile := nil;
    end;
    if FinishedOK then
    begin
      if (not ArchiveIsStream) and (not CreatingSFX) then
        SaveZipName := ZipName;
     { Removed (not ArchiveIsStream) because it was keeping files from getting freed }
     { 01/20/02  2.22+ }
      if (not CreatingSFX) and ({(not ArchiveIsStream) and}(UsingTempFile)) then
        ClearZip;
      if (MultiZipInfo.MultiMode = mmBlocks) then
      begin
        // Last of split parts
        temporaryZipName := FZipNameNoExtension;
        DoFileNameForSplitPart(temporaryZipName,CurrentDisk+1,spLast);
        ZipName := temporaryZipName;
        RenameFile(tmpZipName, ZipName);
      end
      else if (not ArchiveIsStream) and (not CreatingSFX) then
        ZipName := SaveZipName;
      if (UsingTempFile) then
        MoveTempFile
      else if ArchiveIsStream then
        zfile := nil; {2/11/98}
      if (Dispose) then
        DisposeOfFiles;

      if not CreatingSFX then
      begin { We'll point everyting to the newly created information }
        ecrec.Assign(tmpecrec);
        files := tmpfiles2;
        sortfiles := files;
        SortMode := ByNone;
      end
      else { We're going back to the same zip file }
      begin
        tmpfiles2.Free;
        tmpfiles2 := nil;
        sortfiles := SaveSortedFiles;
      end;

      if (not ArchiveIsStream) and (not CreatingSFX) then
        filesDate := FileDate(ZipName);
      if (SaveSortMode <> ByName) and (not CreatingSFX) then
        Sort(SaveSortMode)
      else if (not CreatingSFX) then
      begin
        sortfiles := tmpfiles; { already sorted by name }
        tmpfiles := nil;
      end;
      WriteNumDisks(CurrentDisk + 1);

     { Changed to call even if not spanned zip files 9/30/01 2.22+ }
     { When last file skipped OnTotalPercent wasn't being called }
      if {(MultiZipInfo.MultiMode <> mmNone) and}(Assigned(FOnTotalPercentDone)) then
        OnTotalPercentDone(self, 100); { To be sure. 5/23/99 2.18+}

      if (MultiZipInfo.MultiMode <> mmNone) and (MultiZipInfo.SaveZipInfoOnFirstDisk)
        and (ecrec.this_disk > 0) then
      begin
        if MultiZipInfo.MultiMode = mmSpan then
        begin
          AskForNewDisk(1); { Ask for 1st disk }
        end;
        SaveZipInfoToFile(ChangeFileExt(ZipName, '.zfc'));
      end;

    end
    else
    begin
      tmpfiles2.Free;
      tmpfiles2 := nil;
      SysUtils.DeleteFile(tmpZipName);
    end;

    SortMode := SaveSortMode;
    KeepZipOpen := SaveKeepZipOpen;
    tmpfiles.Free;
    tmpfiles := nil;
    tmpecrec.Free;
    tmpecrec := nil;
    CloseZip;
    if ArchiveIsStream then
      GetFileInfo(theZipFile);
    SetBusy(OldBusy);
    FilesList.Clear; { 6/27/99 2.18+ }
    SetOperationMode(OldOperationMode);
  end;
end;

procedure TVCLZip.CreateTempZip;
begin
  if MultiZipInfo.MultiMode = mmBlocks then
  begin
    //tmpZipName := ChangeFileExt(tmpZipName, '.' + Format('%3.3d', [CurrentDisk + 1]));
    tmpZipName := FZipNameNoExtension;
    DoFileNameForSplitPart(tmpZipName,CurrentDisk+1, spFirst);
  end;
  // Call OnGetNextDisk to get first disk   { 09/13/2003  3.03+ }
  if (MultiZipInfo.MultiMode = mmSpan) then
  begin
    DoGetNextDisk(CurrentDisk+1,tmpZipName);
    if tmpZipName = '' then
      raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPOPERATION));
    if FileExists(tmpZipName) then
      SysUtils.DeleteFile(tmpZipName); { 10/19/99  2.20b3+ }
    if Assigned(FOnPrepareNextDisk) then
      FOnPrepareNextDisk(self, CurrentDisk + 1);
  end;
  if not ArchiveIsStream then
    zfile := TLFNFileStream.CreateFile(tmpZipName, fmCreate, FFlushFilesOnClose, BufferedStreamSize)
  else
  begin
    if UsingTempFile then
      zfile := TkpMemoryStream.Create
    else
      zfile := theZipFile; {2/11/98}
  end;
  if CreatingSFX then
    zfile.CopyFrom(SFXStubFile, SFXStubFile.Size);
  tmpfiles := TSortedZip.Create(DupError);
  tmpfiles.SortMode := ByName;
  tmpfiles.DestroyObjects := False;
  tmpfiles2 := TSortedZip.Create(DupError);
  tmpfiles2.SortMode := ByNone;
  tmpfiles.Capacity := FilesList.Count + Count;
  tmpfiles2.Capacity := FilesList.Count + Count;
  tmpecrec := TEndCentral.Create;
  if (UsingTempFile) or (ecrec.Modified) then
  begin
    tmpecrec.Assign(ecrec);
    if (tmpecrec.zip_comment_length > 0) and (tmpecrec.ZipComment = nil) then
      tmpecrec.ZipComment := StrToPChar(ZipComment);
    tmpecrec.num_entries := 0;
    tmpecrec.num_entries_this_disk := 0;
    tmpecrec.Modified := False;
  end;
end;

function TVCLZip.DiskRoom: BIGINT;
var
  Disk: Byte;
begin
  if ZipName[2] <> ':' then
    Disk := 0
  else
  begin
    Disk := Ord(ZipName[1]) - 64;
    if Disk > 32 then
      Dec(Disk, 32);
  end;
  Result := DiskFree(Disk);
end;

function TVCLZip.RoomLeft: BIGINT;
begin
  Result := AmountToWrite - zfile.Size;
end;

procedure TVCLZip.LabelDisk;
var
  Disk: string;
  NewLabel: string;
  {Rslt: LongBool;}
begin
  if (MultiZipInfo.MultiMode = mmSpan) and (MultiZipInfo.WriteDiskLabels) then
  begin
    Disk := ExtractFileDrive(ZipName);
    if (isDriveRemovable(Disk)) then
    begin
      NewLabel := 'PKBACK# ' + Format('%3.3d', [CurrentDisk + 1]);
      SetVolLabel(Disk, NewLabel);
    end;
  end;
end;

procedure TVCLZip.NextPart;
var
  saveTmpName: string;
begin
  if MultiZipInfo.MultiMode <> mmNone then
  begin
    if MultiZipInfo.MultiMode = mmSpan then
    begin
        zfile.Free;
        zfile := nil;
        LabelDisk; { Label disk before they change it }
        DoGetNextDisk(CurrentDisk + 2, tmpZipName);
        if tmpZipName = '' then
          raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPOPERATION));
        Inc(CurrentDisk);
        if FileExists(tmpZipName) then
          SysUtils.DeleteFile(tmpZipName); { 10/19/99  2.20b3+ }
        if Assigned(FOnPrepareNextDisk) then
          FOnPrepareNextDisk(self, CurrentDisk + 1);
        AmountToWrite := DiskRoom;
    end
    else
    begin
      zfile.Free;
      zfile := nil;
      saveTmpName := tmpZipName;
      tmpZipName := FZipNameNoExtension;
      DoFileNameForSplitPart(tmpZipName,CurrentDisk+2, spMiddle);
      Inc(CurrentDisk);
      AmountToWrite := MultiZipInfo.BlockSize;
    end;
    zfile := TLFNFileStream.CreateFile(tmpZipName, fmCreate, FFlushFilesOnClose, BufferedStreamSize);
    AmountWritten := 0;
    tmpecrec.num_entries_this_disk := 0;
  end;
end;

function TVCLZip.AddFileToZip(FName: string): Boolean;
var
  SavePos: BIGINT;
  tmpDir: string;
  Idx: Integer;
  Skip: Boolean;
  {tempPathPStr: array [0..PATH_LEN] of char;}
  {PathSize: LongInt;}

  procedure CalcFileCRC;
  { Modified to use a PChar for cbuffer 4/12/98  2.11 }
  const
      {BLKSIZ = OUTBUFSIZ;}
    BLKSIZ = DEF_BUFSTREAMSIZE;
  var
    cbuffer: PChar;
    AmountRead: BIGINT;
    AmtLeft: BIGINT;
  begin
    AmtLeft := 0;
    cbuffer := nil;

    if (not MemZipping) then
      GetMem(cbuffer, BLKSIZ);
    try
      Crc32Val := $FFFFFFFF;
      if (MemZipping) then
      begin
        cbuffer := MemBuf