zip.pas

天涯進銷存系統

         OnSkippingFile := ZipperSkippingFile
      else
         OnSkippingFile := nil;
      if OnStartZipInfoChk.Checked then
         OnStartZipInfo := ZipperStartZipInfo
      else
         OnStartZipInfo := nil;
      if OnStartZipChk.Checked then
         OnStartZip := ZipperStartZip
      else
         OnStartZip := nil;
      if OnEndZipChk.Checked then
         OnEndZip := ZipperEndZip
      else
         OnEndZip := nil;
   end;
end;

procedure TVCLZipForm.ZipperGetNextDisk(Sender: TObject;
   NextDisk: Integer; var FName: string);
var
   {$IFDEF WIN32}
   MsgArray                   : array[0..255] of Char;
   {$ELSE}
   MsgArray                   : string;
   {$ENDIF}
begin
   if Zipper.MultiZipInfo.MultiMode = mmSpan then
   begin
      Screen.Cursor := crDefault;
      {$IFDEF WIN32}
      StrPCopy(MsgArray, '请插入多磁盘集中的磁盘 ' + IntToStr(NextDisk));
      {$ELSE}
      MsgArray := '请插入多磁盘集中的磁盘 ' + IntToStr(NextDisk);
      {$ENDIF}
      if MessageDlg(MsgArray, mtConfirmation, [mbOK, mbCancel], 0) = mrCancel then
         FName := '';
      Screen.Cursor := crHourGlass;
   end
   else
   begin
      FName := ChangeFileExt(FName, '.' + Format('%3.3d', [NextDisk]));
      {$IFDEF SKIPCODE}
      FileSelectDlg.InitialDir := ExtractFilePath(FName);
      FileSelectDlg.Title := '选择多部压缩文件号 ' + IntToStr(NextDisk);
      FileSelectDlg.Filter := 'Zip 文件 (*.ZIP)|*.zip' + '|所有文件 (*.*)|*.*';
      if FileSelectDlg.Execute then
         FName := FileSelectDlg.Filename
      else
         FName := '';
      {$ENDIF}
   end;
end;

procedure TVCLZipForm.FilesList1DrawItem(Control: TWinControl; Index: Integer;
   Rect: TRect; State: TOwnerDrawState);
var
   r                          : TRect;
   x                          : Integer;
   FName                      : string;
   ZipTimeStr                 : string;
   ZipDateStr                 : string;
   zSize, zPacked, zRate      : string;
const
   M                          = 4;                      { Margin }
begin
   if Index > Zipper.Count - 1 then
      exit;
   with (Control as TListBox) do
      with Zipper do
      begin
         r := Rect;

         { Filename }
         FName := Filename[Index];
         if ConfigInfo.LowerCaseFiles then
            FName := LowerCase(FName);
         if IsEncrypted[Index] then
            FName := FName + '#';
         if FileHasComment[Index] then
            FName := FName + '$';
         r.Right := r.Left + Header1.SectionWidth[0];
         x := r.Left + M;
         Canvas.TextRect(r, x, r.Top, FName);

         { Date and Time }
         ZipDateStr := Format('%8s', [FormatDateTime('yyyy/mm/dd', DateTime[Index])]);
         ZipTimeStr := Format('%7s', [FormatDateTime('hh:mmam/pm', DateTime[Index])]);

         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[1];
         x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(ZipDateStr) - M;
         Canvas.TextRect(r, x, r.Top, ZipDateStr);

         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[2];
         x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(ZipTimeStr) - M;
         Canvas.TextRect(r, x, r.Top, ZipTimeStr);

         { Size }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[3];
         zSize := Format('%8d', [UnCompressedSize[Index]]);
         x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zSize) - M;
         Canvas.TextRect(r, x, r.Top, zSize);

         { Packed }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[4];
         zPacked := Format('%8d', [CompressedSize[Index]]);
         x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zPacked) - M;
         Canvas.TextRect(r, x, r.Top, zPacked);

         { Rate }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[5];
         zRate := Format('%3d%s', [100 - CRate(UnCompressedSize[Index], CompressedSize[Index]),
            '%']);
         x := r.Left + (r.Right - r.Left) - Canvas.TextWidth(zRate) - M;
         Canvas.TextRect(r, x, r.Top, zRate);

         { Method }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[6];
         x := r.Left + M;
         Canvas.TextRect(r, x, r.Top, CompressMethodStr[Index]);

         { Path }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[7];
         x := r.Left + M;
         Canvas.TextRect(r, x, r.Top, Pathname[Index]);

         { Disk # }
         r.Left := r.Right;
         r.Right := r.Left + Header1.SectionWidth[8];
         x := r.Left + M;
         Canvas.TextRect(r, x, r.Top, IntToStr(DiskNo[Index]));

      end;
end;

procedure TVCLZipForm.FilesList1MeasureItem(Control: TWinControl;
   Index: Integer; var Height: Integer);
begin
   Height := (Control as TListBox).Canvas.TextHeight('W');
end;

procedure TVCLZipForm.ZipperInCompleteZip(Sender: TObject;
   var IncompleteMode: TIncompleteZipMode);
var
   IncZipDlg                  : TIncompleteZipDlg;
   mResult                    : Integer;
begin
   IncZipDlg := TIncompleteZipDlg.Create(Self);
   mResult := IncZipDlg.ShowModal;
   if ( mResult = mrOK) then
      IncompleteMode := izAssumeMulti
   else if (mResult = mrRetry) then
      IncompleteMode := izAssumeBad
   else
      IncompleteMode := izAssumeNotAZip;
   IncZipDlg.Release;
end;

procedure TVCLZipForm.ClearLogWindow1Click(Sender: TObject);
begin
   InfoWin.Clear;
end;

procedure TVCLZipForm.FilesListDblClick(Sender: TObject);
var
   ViewFilePStr               : array[0..PATH_LEN] of char;
   ViewFile                   : string;
   tempPathPStr               : array[0..PATH_LEN] of char;
   tempPath                   : string;
   savePath                   : string;
   saveRecreateDirs           : Boolean;
   ExecStat                   : Integer;
   Msg                        : array[0..255] of char;
begin
   GetTempPath(SizeOf(tempPathPStr), @tempPathPStr[0]);
   tempPath := PCharToStr(tempPathPStr);
   ViewFile := Zipper.Filename[FilesList.ItemIndex];
   StrPCopy(PChar(@ViewFilePStr[0]), ViewFile);
   Zipper.FilesList.Clear;
   Zipper.FilesList.Add(Zipper.Fullname[FilesList.ItemIndex]);
   saveRecreateDirs := Zipper.RecreateDirs;
   Zipper.RecreateDirs := False;
   savePath := Zipper.DestDir;
   Zipper.DestDir := tempPath;
   Zipper.Password := CompressDlg.Password.Text;
   if ViewFilesList.IndexOf(tempPath + ViewFile) = -1 then
      if (Zipper.UnZip > 0) then
         ViewFilesList.Add(tempPath + ViewFile);
   Zipper.DestDir := savePath;
   Zipper.RecreateDirs := saveRecreateDirs;
   if File_Exists(tempPath + ViewFile) then
   begin
      ExecStat := 32;
      if not ConfigInfo.ForceDefaultViewer then
         THandle(ExecStat) := ShellExecute(Handle, nil, ViewFilePStr, nil, tempPathPStr,
            SW_SHOWNORMAL);
      if (ExecStat < 32) or (ConfigInfo.ForceDefaultViewer) then
      begin
         StrPCopy(Msg, ConfigInfo.DefaultViewer + ' ' + tempPath + ViewFile);
         ExecStat := WinExec(Msg, SW_SHOWNORMAL);
      end;
      if ExecStat < 32 then
         ShowMessage('不能查看文件');
      Gauge1.Progress := 0;
      Gauge2.Progress := 0;
      CurrentFileLabel.Caption := '';
   end
   else
      ShowMessage('不能解压文件');
   Screen.Cursor := crDefault;
end;

procedure TVCLZipForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
   MsgBoxResult               : WORD;
begin
   if Zipper.IsModified then
   begin
      MsgBoxResult :=
         MessageDlg('压缩文件已被修改.  你要 ' + #13 + #10 +
         '保存你的修改吗?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);
      if MsgBoxResult = mrYes then
      begin
         Screen.Cursor := crHourGlass;
         Zipper.SaveModifiedZipFile;
         Screen.Cursor := crDefault;
      end
      else
         if MsgBoxResult = mrCancel then
            Action := caNone;
   end;
   if Action <> caNone then
   begin
      WriteIni;
      CleanupViewList;
      ViewFilesList.Free;
   end;
end;

procedure TVCLZipForm.About1Click(Sender: TObject);
begin
   ShowMessage('KpGb 压缩实用程序, 基于 VCLZip Delphi 组件' + #13 + #10 +
      ' Copyright 1997 Kevin L. Boylan, KpGb Software');
end;

procedure TVCLZipForm.NewZipBtnClick(Sender: TObject);
begin
   CompressDlg.SelectedFiles.Clear;
   CompressDlg.ZipFilename.Enabled := True;
   AddFiles;
   OpenTheZip;
end;

procedure TVCLZipForm.UpdateCompressDlg;
begin
   with CompressDlg do
   begin
      {$IFNDEF WIN32}
      SelectFilesBtn.Hint := '添加要压缩的文件到列表.  可以重复这样做.';
      {$ENDIF}
      ZipFilename.Text := Zipper.ZipName;
      RootDir.Text := Zipper.RootDir;
      RelativeDir.Checked := Zipper.RelativePaths;
      RelativeDir.Enabled := (RootDir.Text <> '') and (Zipper.StorePaths);
      RecurseChk.Checked := Zipper.Recurse;
      SaveDirInfoChk.Checked := Zipper.StorePaths;
      SaveVolumesChk.Enabled := Zipper.StorePaths = True;
      SaveVolumesChk.Checked := (SaveVolumesChk.Enabled) and (Zipper.StoreVolumes);
      CompLevel.Caption := IntToStr(Zipper.PackLevel);
      Password.Text := Zipper.Password;
      MultiMode.ItemIndex := Ord(Zipper.MultiZipInfo.Multimode);
      SaveZipInfoChk.Checked := Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk;
      ZipAction.ItemIndex := Ord(Zipper.ZipAction);
      WriteDiskLabelsChk.Checked := Zipper.MultiZipInfo.WriteDiskLabels;
      FirstBlockSize.Text := IntToStr(Zipper.MultiZipInfo.FirstBlockSize);
      BlockSize.Text := IntToStr(Zipper.MultiZipInfo.BlockSize);
   end;
end;

procedure TVCLZipForm.GetCompressDlgInfo;
begin
   with CompressDlg do
   begin
      Zipper.FilesList.Assign(CompressDlg.SelectedFiles.Items);
      Zipper.ZipName := ZipFilename.Text;
      Zipper.RootDir := RootDir.Text;
      Zipper.Recurse := RecurseChk.Checked;
      Zipper.StorePaths := SaveDirInfoChk.Checked;
      Zipper.StoreVolumes := SaveVolumesChk.Checked;
      Zipper.RelativePaths := RelativeDir.Checked;
      Zipper.PackLevel := StrToInt(CompLevel.Caption);
      Zipper.Dispose := DisposeChk.Checked;
      Zipper.Password := Password.Text;
      Zipper.MultiZipInfo.MultiMode := TMultiMode(MultiMode.ItemIndex);
      Zipper.ZipAction := TZipAction(ZipAction.ItemIndex);
      Zipper.MultiZipInfo.WriteDiskLabels := WriteDiskLabelsChk.Checked;
      If Zipper.MultiZipInfo.MultiMode = mmBlocks then
       begin
        Zipper.MultiZipInfo.FirstBlockSize := StrToInt(FirstBlockSize.Text);
        Zipper.MultiZipInfo.BlockSize := StrToInt(BlockSize.Text);
        Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk := SaveZipInfoChk.Checked;
       end
      Else If Zipper.MultiZipInfo.MultiMode = mmSpan then
       begin
        Zipper.MultiZipInfo.SaveOnFirstDisk := StrToInt(FirstBlockSize.Text);
        Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk := SaveZipInfoChk.Checked;
       end;
      Zipper.Store83Names := Store83Format.Checked;
   end;
end;

procedure TVCLZipForm.AddFiles;

   function IsANewZip: Boolean;
   begin
      Result := CompressDlg.ZipFilename.Enabled;
   end;

var
   NumZipped                  : Integer;
begin
   NumZipped := 0;
   Zipper.FilesList.Clear;
   UpdateCompressDlg;
   with CompressDlg do
   begin
      if IsANewZip then
      begin                                             { new zip file }
         GetZipFileDlg.Filename := '';
         if GetZipFileDlg.Execute then
         begin
            ZipFilename.Text := GetZipFileDlg.FileName;
            if UpperCase(ExtractFileExt(ZipFilename.Text)) <> '.ZIP' then
               ChangeFileExt(ZipFilename.Text, '.zip');
         end
         else
            exit;
      end;
   end;
   try
    try
      if (CompressDlg.ShowModal = mrOK) and (CompressDlg.SelectedFiles.Items.Count > 0) then
      begin
         GetCompressDlgInfo;
         Application.ProcessMessages;
         Screen.Cursor := crHourGlass;
         if (IsANewZip) and (FileExists(Zipper.ZipName)) then
            SysUtils.DeleteFile(Zipper.ZipName);
         NumZipped := Zipper.Zip;
         If (Zipper.MultiZipInfo.MultiMode = mmSpan) and (Zipper.MultiZipInfo.SaveZipInfoOnFirstDisk) then
           ShowMessage('文档配置文件已经保存');
         MessageBeep(0);
         OpenTheZip;
      end;
    except
     On EUserCanceled do
      begin
        StatusBar.Caption := '';
      end;
   end;
   finally
      Screen.Cursor := crDefault;
      Gauge1.Progress := 0;
      Gauge2.Progress := 0;
      zipcounter := 0;