zip.pas

天涯進銷存系統

      CurrentFileLabel.Caption := '';
      if NumZipped > 0 then
         InfoWin.Lines.Add(IntToStr(NumZipped) + ' 文件已经压缩!')
      else
         InfoWin.Lines.Add('无文件压缩!');
   end;
end;

procedure TVCLZipForm.OnAddFiles(Sender: TObject);
begin
   if Zipper.ZipName <> '' then
   begin
      CompressDlg.SelectedFiles.Clear;
      CompressDlg.ZipFilename.Enabled := False;
      CompressDlg.ZipFileBtn.Enabled := False;
      AddFiles;
      CompressDlg.ZipFilename.Enabled := True;
      CompressDlg.ZipFileBtn.Enabled := True;
      OpenTheZip;
   end;
end;

procedure TVCLZipForm.DeleteFromZip;
var
  i:    Integer;
begin
   {MakeFilesListFromListBox;}
   Zipper.FilesList.Clear;
   for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
      if VCLZipForm.FilesList.Selected[i] then
         {Zipper.FilesList.Add(Zipper.FullName[i]);}
        Zipper.Selected[i] := True;
   Zipper.DeleteEntries;
   OpenTheZip;
end;

procedure TVCLZipForm.FormKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   if (Key = 46) and (FilesList.SelCount > 0) then
      DeleteFromZip;
end;

procedure TVCLZipForm.UpdateConfigDlg;
begin
   with ConfigInfo, Zipper do
   begin
      ConfigDlg.DefaultViewer.Text := DefaultViewer;
      ConfigDlg.ForceDefaultViewer.Checked := ForceDefaultViewer;
      ConfigDlg.LowerCaseFiles.Checked := LowerCaseFiles;
      ConfigDlg.ProcessMessagesChk.Checked := DoProcessMessages;
      ConfigDlg.OEMConvertChk.Checked := OEMConvert;
      {$IFDEF WIN32}
      ConfigDlg.OnStartUnZipInfoChk.Checked := Assigned(OnStartUnZipInfo);
      ConfigDlg.OnStartUnZipChk.Checked := Assigned(OnStartUnZip);
      ConfigDlg.OnBadCRCChk.Checked := Assigned(OnBadCRC);
      ConfigDlg.OnBadPasswordChk.Checked := Assigned(OnBadPassword);
      ConfigDlg.OnSkippingFileChk.Checked := Assigned(OnSkippingFile);
      ConfigDlg.OnStartZipInfoChk.Checked := Assigned(OnStartUnZipInfo);
      ConfigDlg.OnStartZipChk.Checked := Assigned(OnStartZip);
      ConfigDlg.OnEndZipChk.Checked := Assigned(OnEndZip);
      {$ENDIF}
      ConfigDlg.sfx16.Text := sfx16;
      ConfigDlg.sfx32.Text := sfx32;
   end;
end;

procedure TVCLZipForm.GetConfigDlgInfo;
begin
   with ConfigInfo do
   begin
      DefaultViewer := ConfigDlg.DefaultViewer.Text;
      ForceDefaultViewer := ConfigDlg.ForceDefaultViewer.Checked;
      LowerCaseFiles := ConfigDlg.LowerCaseFiles.Checked;
      Zipper.DoProcessMessages := ConfigDlg.ProcessMessagesChk.Checked;
      Zipper.OEMConvert := ConfigDlg.OEMConvertChk.Checked;
      sfx16 := ConfigDlg.sfx16.Text;
      sfx32 := ConfigDlg.sfx32.Text;
      SetLogging;
   end;
end;

procedure TVCLZipForm.Configure1Click(Sender: TObject);
begin
   UpdateConfigDlg;
   ConfigDlg.ShowModal;
   if ConfigDlg.ModalResult = mrOK then
      GetConfigDlgInfo;
end;

procedure TVCLZipForm.ZipperStartZip(Sender: TObject; FName: string;
   var ZipHeader: TZipHeaderInfo; var Skip: Boolean);
begin
   Inc(zipcounter);
   InfoWin.Lines.Add(IntToStr(zipcounter) + '. 正在压缩 ' + FName);
   StatusBar.Caption := '正在压缩...';
   CurrentFileLabel.Caption := ExtractFilename(FName);
   CurrentFileLabel.Repaint;
end;



procedure TVCLZipForm.DeleteBtnClick(Sender: TObject);
begin
   if FilesList.SelCount > 0 then
      DeleteFromZip;
end;

procedure TVCLZipForm.AbortBtnClick(Sender: TObject);
begin
   MessageBeep(0);
   if (Testing) and (checkZipper <> nil) then
     checkZipper.CancelTheOperation
   else
     Zipper.CancelTheOperation;
end;

procedure TVCLZipForm.BackupBtnClick(Sender: TObject);
var
   tmpFilesList               : TStrings;
   i                          : Integer;
begin
   if Zipper.Count > 0 then
   begin
      tmpFilesList := TStringList.Create;
      try
         for i := 0 to Zipper.Count - 1 do
            if Pos(':', Zipper.Pathname[i]) > 0 then
               tmpFilesList.Add(Zipper.FullName[i]);
         if tmpFilesList.Count > 0 then
         begin
            if tmpFilesList.Count < Zipper.Count then
               if (MessageDlg('有些入口没有卷信息.'
                  + #13 + #10 + ' 这些文件将不能备份.'
                  + #13 + #10, mtWarning, [mbOK, mbCancel], 0)
                  = mrCancel) then exit;

            Zipper.StorePaths := True;
            Zipper.StoreVolumes := True;
            Zipper.PackLevel := 9;
            CompressDlg.SelectedFiles.Items.Assign(tmpFilesList);
            CompressDlg.ZipFilename.Enabled := True;
            AddFiles;
         end
         else
            MessageDlg('该压缩入口没有卷信息.'
               + #13 + #10 + '备份必须要卷信息.', mtWarning, [mbOK],
                  0);
      finally
         tmpFilesList.Free;
      end;
   end;
end;

procedure TVCLZipForm.SaveMenuItemClick(Sender: TObject);
begin
   Screen.Cursor := crHourGlass;
   Zipper.SaveModifiedZipFile;
   OpenTheZip;
   Screen.Cursor := crDefault;
end;

procedure TVCLZipForm.FileCommentBtnClick(Sender: TObject);
var
   Idx                        : Integer;
begin
   if FilesList.SelCount > 1 then
      ShowMessage('必须只选择一个入口.')
   else
      if FilesList.SelCount = 0 then
         ShowMessage('请首先选择一个入口.')
      else
      begin
         with CommentEditor do
         begin
            Idx := FilesList.ItemIndex;
            CommentMemo.Clear;
            CommentEditor.Caption := '修改压缩注释 ' + Zipper.Filename[Idx];
            if Zipper.FileHasComment[Idx] then
               CommentMemo.Text := Zipper.FileComment[Idx];
            ShowModal;
            if ModalResult = mrOK then
               if CommentMemo.Text <> Zipper.FileComment[Idx] then
                  Zipper.FileComment[Idx] := CommentMemo.Text;
         end;
      end;
end;

procedure TVCLZipForm.FileMenuClick(Sender: TObject);
begin
   SaveMenuItem.Enabled := Zipper.IsModified;
   SFXToZipMnu.Enabled := (Zipper.ZipName <> '') and
      (LowerCase(ExtractFileExt(Zipper.ZipName)) = '.exe');
end;

procedure TVCLZipForm.FixMenuClick(Sender: TObject);
begin
   Zipper.FixZip('', '');
   OpenTheZip;
end;

procedure TVCLZipForm.MakeSFX32MnuClick(Sender: TObject);
begin
   MakeSFX(sfx32);
   MessageBeep(0);
   OpenTheZip;
end;

procedure TVCLZipForm.MakeSFX(Stub: string);
begin
   if Zipper.ZipName = '' then
   begin
      ShowMessage('无 zip 文件处理');
      exit;
   end;
   Zipper.FilesList.Clear;
   Screen.Cursor := crHourGlass;
   try
       Zipper.MakeNewSFX(Stub,Zipper.ZipName,nil,0);
      {Zipper.MakeSFX(Stub, False);}
   finally
      Screen.Cursor := crDefault;
   end;
end;

procedure TVCLZipForm.Make16bitSFXMnuClick(Sender: TObject);
begin
   MakeSFX(sfx16);
   MessageBeep(0);
   OpenTheZip;
end;

procedure TVCLZipForm.ZipperEndZip(Sender: TObject; FName: string;
   UncompressedSize, CompressedSize, CurrentZipSize: LongInt);
begin
   InfoWin.Lines.Add(' ' + ExtractFilename(FName) + ' 压缩了. ' + IntToStr(UnCompressedSize) +
      ' ' + IntToStr(CompressedSize) + ' ' +
      IntToStr(100-crate(UncompressedSize, CompressedSize)) + '%');
   ZipSizeLabel.Caption := IntToStr(CurrentZipSize);
end;

procedure TVCLZipForm.ZipperStartZipInfo(Sender: TObject;
   NumFiles: Integer; TotalBytes: Comp; var EndCentralRecord: TEndCentral; var StopNow:
      Boolean);
begin
   InfoWin.Lines.Add(' ');
   InfoWin.Lines.Add('被压缩的文件数: ' + IntToStr(NumFiles));
   InfoWin.Lines.Add('处理的总字节: ' + FloatToStr(TotalBytes));
end;

procedure TVCLZipForm.ZipperDeleteEntry(Sender: TObject; FName: string;
   var Skip: Boolean);
begin
   if MessageDlg('删除文件 ' + FName + '?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      InfoWin.Lines.Add('删除入口 ' + FName)
   else
      Skip := True;
end;

procedure TVCLZipForm.ZipperDisposeFile(Sender: TObject; FName: string;
   var Skip: Boolean);
begin
   InfoWin.Lines.Add('正在移去: ' + FName);
end;

procedure TVCLZipForm.ModifyPathClick(Sender: TObject);
var
   i                          : Integer;
begin
   if FilesList.SelCount > 0 then
   begin
      ModInfoForm.NewInfoEdit.Text := '';
      ModInfoForm.ShowModal;
      if ModInfoForm.ModalResult = mrOK then
         for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
            if VCLZipForm.FilesList.Selected[i] then
               Zipper.Pathname[i] := ModInfoForm.NewInfoEdit.Text;
      SaveMenuItemClick(Self);
   end;
end;

procedure TVCLZipForm.ModifyFilename1Click(Sender: TObject);
begin
   if FilesList.SelCount = 1 then
   begin
      ModInfoForm.NewInfoEdit.Text := Zipper.Filename[FilesList.ItemIndex];
      ModInfoForm.ShowModal;
      if ModInfoForm.ModalResult = mrOK then
         Zipper.Filename[FilesList.ItemIndex] := ModInfoForm.NewInfoEdit.Text;
   end;
end;

procedure TVCLZipForm.TestZipFile1Click(Sender: TObject);
begin
   { A separate VCLZip object is used to test the integrity of the zip file so that we can
     have control over the events that get called }
   Testing := True;
{   checkZipper := TVCLUnZip.Create(Application);
   checkZipper.ZipName := Zipper.ZipName;
   checkZipper.Password := Zipper.Password;
   checkZipper.OnFilePercentDone := Zipper.OnFilePercentDone;
   checkZipper.OnTotalPercentDone := Zipper.OnTotalPercentDone;
   checkZipper.OnBadCRC := Zipper.OnBadCRC;
   checkZipper.OnBadPassword := Zipper.OnBadPassword;
   checkZipper.OnStartUnZip := Zipper.OnStartUnZip;
   checkZipper.ReadZip;
}
   InfoWin.Lines.Add('开始完整性测试 ' + IntToStr(Zipper.Count) + ' 文件的 ' +
      {check}Zipper.ZipName);
   if ({check}Zipper.CheckArchive) then
     InfoWin.Lines.Add('All Files OK')
   else
     InfoWin.Lines.Add('文件可能已损坏');
   {checkZipper.Free;}
   Gauge1.Progress := 0;
   Gauge2.Progress := 0;
   Testing := False;
end;

procedure TVCLZipForm.SFXtoZipMnuClick(Sender: TObject);
begin
   if (Zipper.ZipName <> '') and (Zipper.Count > 0) then
      Zipper.SFXToZip(True);
   SFXToZipMnu.Enabled := False;
   Caption := Zipper.ZipName;
end;

procedure TVCLZipForm.ZipperUnZipComplete(sender: TObject;
   FileCount: Integer);
begin
   {ShowMessage('Got Here');}
end;

procedure TVCLZipForm.ZipperUpdate(Sender: TObject;
  UDAction: TUpdateAction; FileIndex: Integer);
begin
  Case UDAction of
     uaReplacing: InfoWin.Lines.Add( '正在替换 ' + TVCLZip(Sender).FullName[FileIndex] );
     uaKeeping:   InfoWin.Lines.Add( '正在保持 ' + TVCLZip(Sender).FullName[FileIndex]   );
  end;
end;

procedure TVCLZipForm.TestSelectedFiles1Click(Sender: TObject);
var
   i                          : Integer;
begin
   Testing := True;
   if FilesList.SelCount > 0 then
   begin
     InfoWin.Lines.Add('>>> ' + IntToStr(FilesList.SelCount) + ' 个文件被测试.');
     for i := 0 to VCLZipForm.FilesList.Items.Count - 1 do
        if VCLZipForm.FilesList.Selected[i] then
           if Zipper.FileIsOK[i] then
              InfoWin.Lines.Add('>>> ' + Zipper.Filename[i] + ' 测试 OK.')
           else
              InfoWin.Lines.Add('>>> ' + Zipper.Filename[i] + ' 可能已损坏.');
   end;
   Gauge1.Progress := 0;
   Gauge2.Progress := 0;
   Testing := False;
end;

procedure TVCLZipForm.ZipperRecursingFile(Sender: TObject; FName: String);
begin
   StatusBar.Caption := '正在递归...';
   CurrentFileLabel.Caption := ExtractFilename(FName);
   CurrentFileLabel.Repaint;
end;

end.