vclzip.pas

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

      begin
        {$IFDEF KPDEBUG}
        ShowError('ByPosition', e);
        exit;
        {$ELSE}
        raise;
        {$ENDIF}
      end;
    end;
    Inc(Result);
    tmpecrec.num_entries := tmpecrec.num_entries + 1;
    tmpecrec.num_entries_this_disk := tmpecrec.num_entries_this_disk + 1;
    if Dispose then
      DisposeFiles.Add(FilesList[i]);
  end;

  procedure DisposeOfFiles;
  var
    x: Integer;
    Skip: Boolean;
  begin
    Skip := False;
    for x := 0 to DisposeFiles.Count - 1 do
    begin
      if Assigned(FOnDisposeFile) then
      begin
        Skip := False;
        FOnDisposeFile(Self, DisposeFiles[x], Skip);
      end;
      if not Skip then
        SysUtils.DeleteFile(DisposeFiles[x]);
    end;
    DisposeFiles.Free;
    DisposeFiles := nil;
  end;


  procedure MoveExistingFiles;

    function FilesListMatches(FName: string): Boolean;
    var
      tmpFName: string;
    begin
      if (OEMConvert = oemAlways) then
        OemFilter(Fname);
      tmpFName := LowerCase(FName);
      if (Deleting) and (IsWildCard(FName)) then
      begin { Wildcards should only be there if deleting }
        if (Pos('\', FName) > 0) then
          Result := IsMatch(tmpFName, LowerCase(tmpfile_info.directory + tmpfile_info.filename))
        else
          Result := IsMatch(tmpFName, LowerCase(tmpfile_info.filename));
      end
      else
      begin
        if not Deleting then
        begin
          tmpFName := ComparePath(tmpFName) + ExtractFilename(tmpFName);
        end;
        Result := tmpFName = LowerCase(tmpfile_info.directory + tmpfile_info.filename);
      end;
    end;

  var
    i, j: Integer;
    MoveTheFile: Boolean;
    Skip: Boolean;
    tmpComment: PChar;
    SearchRec: TSearchRec;

  begin
    if files = nil then { 3/28/98 2.1 }
      exit; { fixed GPF when adding to empty archive }
    for i := 0 to files.Count - 1 do { Check each file in existing zip }
    begin
      //if (Assigned(OnTotalPercentDone)) then
      //  FOnTotalPercentDone(self, CBigRate(files.Count, i + 1));
      tmpfile_info := CreateNewZipHeader;
      tmpfile_info.Assign(files.Items[i] as TZipHeaderInfo);
      if ((i = 0) and (tmpfile_info.relative_offset > 0) and (FPreserveStubs)) then
      begin { save sfx stub from beginning of file }
        theZipFile.Seek(0, soBeginning);
        zfile.CopyFrom(theZipFile, tmpfile_info.relative_offset);
      end;
      if (tmpfile_info.FileIsOK = 2) then { skip files that are corrupted }
      begin
        tmpfile_info.Free;
        continue;
      end;
      if (tmpfile_info.file_comment_length > 0) and (tmpfile_info.filecomment = nil) then
      begin
        tmpComment := StrToPChar(FileComment[i]);
        tmpfile_info.filecomment := tmpComment;
        StrDispose(tmpComment);
      end;
      MoveTheFile := True;

      if (Deleting) and (tmpfile_info.Selected) then
      begin
        Skip := False;
        tmpfile_info.Selected := False;
        if (assigned(FOnDeleteEntry)) then
          FOnDeleteEntry(Self, tmpfile_info.directory + tmpfile_info.filename, Skip);
        if (not Skip) then
        begin
          Inc(Result);
          MoveTheFile := False;
        end;
      end
      else if (FilesList.Count > 0) then
        for j := 0 to FilesList.Count - 1 do { Compare to each file in FilesList }
        begin
            if CancelOperation then
            begin
              CancelOperation := False;
              raise EUserCanceled.Create(LoadStr(IDS_CANCELOPERATION));
            end;
          if (FilesListMatches(FilesList[j])) then
          begin { This file is in zip file and fileslist too }
            if (StreamZipping) or (MemZipping) or (ZipAction = zaReplace) or
              (Deleting) or (((ZipAction = zaUpdate) or (ZipAction = zaFreshen))
              and (DateTime[i] < FileDate(FilesList[j]))) then
            begin { Don't move files that will be replaced }
              Skip := False;
              if (Deleting) and (Assigned(FOnDeleteEntry)) then
                FOnDeleteEntry(Self, tmpfile_info.directory + tmpfile_info.filename, Skip);
              if (Deleting) and (not Skip) then
                Inc(Result); { 5/18/98  2.13 }
              if not Skip then
              begin
                MoveTheFile := False; { or deleted. }
                if (Deleting) and (not IsWildcard(FilesList[j])) then
                  FilesList.Delete(j); { We're deleting, not zipping }
                if (not Deleting) then
                begin
                  tmpfile_info.Free;
                  tmpfile_info := CreateNewZipHeader;
                  if Assigned(FOnUpdate) then
                    FOnUpdate(self, uaReplacing, i);
                  try
                    if AddFileToZip(FilesList[j]) then
                      AddTheNewFile(j)
                    else
                    begin
                      tmpfile_info.Free;
                      tmpfile_info := nil;
                    end;
                  except
                    tmpfile_info.Free;
                    tmpfile_info := nil;
                    raise;
                  end;
                  FilesList.Delete(j);
                end;
              end
              else
              begin
                MoveTheFile := True; { File should just be saved from current zip }
                FilesList.Delete(j); { because current file is not older }
              end;
            end
            else
            begin
              if Dispose then { 11/23/00  2.21b4+ }
                DisposeFiles.Add(FilesList[j]); { Dispose of original file anyway }
              MoveTheFile := True; { File should just be saved from current zip }
              if FindFirst(FilesList[j], FSearchAttribute, SearchRec) = 0 then
              begin
                TotalUncompressedSize := TotalUncompressedSize - GetFileSize(SearchRec)
                                          + tmpfile_info.compressed_size;
                FindClose(SearchRec);
              end;
              FilesList.Delete(j); { because disk file is not newer }
            end;
            Break;
          end;
        end;

      if MoveTheFile then { Save this old file into new zip }
      begin
        if (Assigned(FOnUpdate)) then
          FOnUpdate(self, uaKeeping, i);
        MoveFile(i);
        tmpfiles.AddObject(tmpfile_info); { Add info to new stuff }
        tmpfiles2.AddObject(tmpfile_info);
        tmpecrec.num_entries := tmpecrec.num_entries + 1;
        tmpecrec.num_entries_this_disk := tmpecrec.num_entries_this_disk + 1;
      end
      else
        if (Deleting) then
          tmpfile_info.Free
    end;
    tmpfile_info := nil;
  end;



{$IFNDEF USE_ZLIB}
  procedure AllocateZipArrays;
  begin
{$IFDEF WIN16}
    if windowObj = nil then
    begin
      windowObj := TkpHugeByteArray.Create(2 * WSIZE);
      window := windowtypePtr(windowObj.AddrOf[0]);
      prevObj := TkpHugeWordArray.Create(WSIZE);
      prev := prevtypePtr(prevObj.AddrOf[0]);
      headObj := TkpHugeWordArray.Create(HASH_SIZE);
      head := headtypePtr(headObj.AddrOf[0]);
      l_bufObj := TkpHugeByteArray.Create(LIT_BUFSIZE);
      l_buf := l_buftypePtr(l_bufObj.AddrOf[0]);
      d_bufObj := TkpHugeWordArray.Create(DIST_BUFSIZE);
      d_buf := d_buftypePtr(d_bufObj.AddrOf[0]);
      flag_bufObj := TkpHugeByteArray.Create(LIT_BUFSIZE div 8);
      flag_buf := flag_buftypePtr(flag_bufObj.AddrOf[0]);
    end;
{$ELSE}
    if window = nil then
    begin
      New(window);
      New(prev);
      New(head);
      New(l_buf);
      New(d_buf);
      New(flag_buf);
    end;
{$ENDIF}
  end;

  procedure DeAllocateZipArrays;
  begin
{$IFDEF WIN16}
    windowObj.Free;
    windowObj := nil;
    prevObj.Free;
    prevObj := nil;
    headObj.Free;
    headObj := nil;
    l_bufObj.Free;
    l_bufObj := nil;
    d_bufObj.Free;
    d_bufObj := nil;
    flag_bufObj.Free;
    flag_bufObj := nil;
{$ELSE}
    System.Dispose(window);
    window := nil;
    System.Dispose(prev);
    prev := nil;
    System.Dispose(head);
    head := nil;
    System.Dispose(l_buf);
    l_buf := nil;
    System.Dispose(d_buf);
    d_buf := nil;
    System.Dispose(flag_buf);
    flag_buf := nil;
{$ENDIF}
  end;
{$ENDIF}

 procedure zipdata( i: Integer);
 begin
         tmpfile_info := CreateNewZipHeader;
        try
          if AddFileToZip(FilesList[i]) then
            AddTheNewFile(i)
          else
          begin
            tmpfile_info.Free;
            tmpfile_info := nil;
          end;
        except
          tmpfile_info.Free;
          tmpfile_info := nil;
          raise;
        end;
 end;

var
  i: Integer;
  FinishedOK: Boolean;
  SaveSortedFiles: TSortedZip;
  SaveSortMode: TZipSortMode;
  SaveKeepZipOpen: Boolean;
  SaveZipName: string;
  StopNow: Boolean;
  TotalCentralSize: LongInt;
  SaveCentralPos: BIGINT;
  temporaryZipName: String;
  nextFile: String;
  OldBusy: Boolean;
  clusterSize: DWORD;
  span_sig: LongInt;
  span_not_sig: LongInt;
  OldOperationMode: TOperationMode;

  {$IFNDEF INT64STREAMS}
  newStream: TStream;
  {$ENDIF}


begin {************** ProcessFiles Main Body ****************}
  Result := 0;
  CancelOperation := False;
  if FilesList = nil then
    exit;
  { Either ZipName or ArchiveStream should be set }
  if ((Trim(ZipName) = '') and (ArchiveStream = nil)) then { 09/07/99 2.18+ }
    exit;
  OldBusy := SetBusy(True);
  FinishedOK := False;
  CurrentDisk := 0;
  SaveSortedFiles := nil;
  if {(SortMode <> byNone) and}(CreatingSFX) then
    SaveSortedFiles := sortfiles
  else
    if (sortfiles <> nil) and (sortfiles <> files) then
      sortfiles.Free;
  SaveSortMode := SortMode;
  SaveKeepZipOpen := KeepZipOpen;
  KeepZipOpen := True;
  sortfiles := files;
  SortMode := ByNone;
  OldOperationMode := SetOperationMode(omZip);

 try { Moved up to here 4/12/98  2.11 }
  if Dispose then
    DisposeFiles := TStringList.Create;
  if (not Deleting) and (not StreamZipping) and (not MemZipping) and (FilesList.Count > 0) then
    ExpandForWildCards;

    if (not Deleting) and (FilesList.Count > 0) then
    begin
      StopNow := False;
      if Assigned(FOnStartZipInfo) then
        FOnStartZipInfo(Self, FilesList.Count, TotalUncompressedSize, tmpecrec, StopNow);
      if StopNow then
        raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPOPERATION));
    end;

    if ((ArchiveIsStream) and (Count > 0))
      or ((File_Exists(ZipName)) and (MultiZipInfo.MultiMode = mmNone)) then
    begin
{$IFNDEF USE_ZLIB} { Added Multimode check 06/11/00  2.21b3+ }
      AllocateZipArrays;
{$ENDIF}
     { create new file in temporary directory }
      UsingTempFile := True;
      if not ArchiveIsStream then
      begin
        {PathSize := GetTempPath( SizeOf(tempPathPStr), @tempPathPStr[0] );}
        { Changed to TempFilename  5/5/98  2.12 }
        tmpZipName := TempFilename(TemporaryPath);
        {tmpZipName := StrPas(tempPathPStr) + ExtractFileName( ZipName );}
      end;
      CreateTempZip;
      OpenZip; { open existing zip so we can move existing files }
      MoveExistingFiles; {Move those existing files}
    end
    else
    begin
{$IFNDEF USE_ZLIB}
      AllocateZipArrays;
{$ENDIF}
      if not ArchiveIsStream then
        tmpZipName := ZipName;
      UsingTempFile := False;
      CreateTempZip;
    end;

      {  Guesstimate space needed for the Zip Configuration File that will go on first disk of
     a spanned zip file if SaveZipInfoOnFirstDisk is True }
  if (MultiZipInfo.MultiMode <> mmNone) and (MultiZipInfo.SaveZipInfoOnFirstDisk) then
  begin
     { We'll pad a little extra because comments aren't figured in and we want to make sure
       we allow for sector's being allocated on disk }
    MultiZipInfo.SaveOnFirstDisk :=
      MultiZipInfo.SaveOnFirstDisk +
      (FilesList.Count * (SizeOf(central_file_header) + FilenameSize)) +
      SizeOf(end_of_central) + ecrec.zip_comment_length + 2048; { + 2048 for some padding }