zip.pas

天涯進銷存系統

   end;
   OpenTheZip;
end;

procedure TVCLZipForm.OpenTheZip;
var
   TryAgain                   : Boolean;
   tmpName                    : string;
begin
   with Zipper do
      if (ZipName <> '') and (ZipName[Length(ZipName)] <> '?') then
      begin
         CleanupViewList;
         tmpName := ZipName;
         repeat
            TryAgain := False;
            try
               ReadZip;
            except
               on EincompleteZip do
               begin
                 if
                     MessageDlg('插入最后一张盘. 按是继续或否终止',
                     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                   begin
                     tryagain := True;
                     ZipName := tmpName;
                   end
                  else
                     tryagain := False;
               end;
            end;
         until (TryAgain = False);

         if ZipName = '' then
         begin
            Close1Click(self);
            exit;
         end;

         { The following not needed since I fixed VCLUnZip 3/10/98 2.03}
         if (NumDisks > 1) then                         { 3/7/98 2.03 }
         begin
            if ((AnsiCompareStr(ZipName[1], 'A') = 0) or (AnsiCompareStr(ZipName[1], 'A') = 0))
               then
               MultiMode := mmSpan
            else
               MultiMode := mmBlocks;
         end;
         Self.FilesList.Items.BeginUpdate;
         FillList(Self.FilesList.Items);
         Self.FilesList.Items.EndUpdate;
         Self.FilesList.Update;
         StatusBar.Caption := IntToStr(Zipper.Count) + ' 个文件';
         ZipCommentMnu.Checked := Zipper.ZipHasComment;
         Caption := ZipName;
         ZipFromDir := ExtractFileDir(ZipName);
         ZipSizeLabel.Caption := IntToStr(Zipper.ZipSize);
      end;
end;

procedure TVCLZipForm.InitHeaderWidths;
begin
   with Header1 do
   begin
      SectionWidth[0] := Canvas.TextWidth('XXXXXXXX.XXXX'); { File }
      SectionWidth[1] := Canvas.TextWidth('XXXX/XX/XXX'); { Date }
      SectionWidth[2] := Canvas.TextWidth('99:99PMX');  { Time }
      SectionWidth[3] := Canvas.TextWidth('99999999');  { Size }
      SectionWidth[4] := Canvas.TextWidth('99999999');  { Packed }
      SectionWidth[5] := Canvas.TextWidth('XXXXx');     { Rate }
      SectionWidth[6] := Canvas.TextWidth('XXXXXX');    { Method }
      SectionWidth[7] := Canvas.TextWidth('XXXXXXXXXXXXXX'); { Path }
   end;
end;

procedure TVCLZipForm.OnExitBtn(Sender: TObject);
begin
   Close;
end;

procedure TVCLZipForm.ReadIni;
var
   IniFile                    : TIniFile;
begin
   IniFile := TIniFile.Create('VCLZip.Ini');
   with ConfigInfo, IniFile, Zipper do
   begin
      DefaultViewer := ReadString('Viewer', 'Default', 'NOTEPAD');
      ForceDefaultViewer := ReadBool('Viewer', 'Force', False);
      LowerCaseFiles := ReadBool('Viewer', 'Lowecase', True);
      if not ReadBool('Logging', 'OnStartUnZipInfo', True) then
         OnStartUnZipInfo := nil;
      if not ReadBool('Logging', 'OnStartUnZip', True) then
         OnStartUnZip := nil;
      if not ReadBool('Logging', 'OnBadCRC', True) then
         OnBadCRC := nil;
      if not ReadBool('Logging', 'OnBadPassword', True) then
         OnBadPassword := nil;
      if not ReadBool('Logging', 'OnSkippingFile', True) then
         OnSkippingFile := nil;
      if not ReadBool('Logging', 'OnStartZipInfo', True) then
         OnStartZipInfo := nil;
      if not ReadBool('Logging', 'OnStartZip', True) then
         OnStartZip := nil;
      if not ReadBool('Logging', 'OnEndZip', True) then
         OnEndZip := nil;
      DestDir := ReadString('Paths', 'DestDir', 'c:\');
      sfx16 := ReadString('SFX', '16Bit', '');
      sfx32 := ReadString('SFX', '32Bit', '');
      if sfx16 = '' then
         sfx16 := ExtractFilePath(Application.EXEName) + 'zipsfx16.bin';
      if sfx32 = '' then
         sfx32 := ExtractFilePath(Application.EXEName) + 'zipsfx32.bin';
      ZipFromDir := ReadString('Paths', 'FromDir', 'c:\');
      if (Length(ZipFromDir) > 0) and (ZipFromDir[Length(ZipFromDir)] = '\') then
         SetLength(ZipFromDir, Length(ZipFromDir) - 1);
      IniFile.Free;
   end;
end;

procedure TVCLZipForm.WriteIni;
var
   IniFile                    : TIniFile;
begin
   IniFile := TIniFile.Create('VCLZip.Ini');
   with IniFile, Zipper do
   begin
      WriteString('Viewer', 'Default', ConfigInfo.DefaultViewer);
      WriteBool('Viewer', 'Force', ConfigInfo.ForceDefaultViewer);
      WriteBool('Viewer', 'Lowercase', ConfigInfo.LowercaseFiles);
      {$IFDEF WIN32}
      WriteBool('Logging', 'OnStartUnZipInfo', Assigned(OnStartUnZipInfo));
      WriteBool('Logging', 'OnStartUnZip', Assigned(OnStartUnZip));
      WriteBool('Logging', 'OnBadCRC', Assigned(OnBadCRC));
      WriteBool('Logging', 'OnBadPassword', Assigned(OnBadPassword));
      WriteBool('Logging', 'OnSkippingFile', Assigned(OnSkippingFile));
      WriteBool('Logging', 'OnStartZipInfo', Assigned(OnStartZipInfo));
      WriteBool('Logging', 'OnStartZip', Assigned(OnStartZip));
      WriteBool('Logging', 'OnEndZip', Assigned(OnEndZip));
      {$ENDIF}
      { Just to be sure, we don't want dialog boxes to come up if user has this app
      associated with zip files and double clicks on a zip file in File Manager or
      Explorer }
      if Zipper.DestDir = '?' then
         Zipper.DestDir := 'C:\';
      if (ZipFromDir = '?') or (ZipFromDir = '') then
         ZipFromDir := 'C:';
      if ZipFromDir[Length(ZipFromDir)] = '\' then
         SetLength(ZipFromDir, Length(ZipFromDir) - 1);
      WriteString('Paths', 'DestDir', Zipper.DestDir);
      WriteString('Paths', 'FromDir', ZipFromDir);
      WriteString('SFX', '16Bit', sfx16);
      WriteString('SFX', '32bit', sfx32);
   end;
   IniFile.Free;
end;

procedure TVCLZipForm.CleanupViewList;
var
   i                          : Integer;
begin
   if ViewFilesList.Count > 0 then
   begin
      for i := 0 to ViewFilesList.Count - 1 do
         SysUtils.DeleteFile(ViewFilesList[i]);
      ViewFilesList.Clear;
   end;
end;

procedure TVCLZipForm.Close1Click(Sender: TObject);
begin
   FilesList.Clear;
   Zipper.ClearZip;
   CleanupViewList;
   ZipSizeLabel.Caption := '0';
   Caption := 'VCLUnZip 实用程序';
end;

procedure TVCLZipForm.OnSort(Sender: TObject);
begin
   with Sender as TMenuItem do
   begin
      Zipper.Sort(TZipSortMode(Tag));
      Zipper.FillList(FilesList.Items);
      Checked := True;
      CheckedSortItem.Checked := False;
   end;
   CheckedSortItem := TMenuItem(Sender);
end;

procedure TVCLZipForm.Header1Sized(Sender: TObject; ASection,
   AWidth: Integer);
begin
   FilesList.Refresh;
end;

procedure TVCLZipForm.ZipperStartUnZip(Sender: TObject; FileIndex: Integer;
   var FName: string; var Skip: Boolean);
begin
      If (Testing) then
        Infowin.Lines.Add('正在测试 ' + TVCLUnZip(Sender).FullName[FileIndex])
      Else
        Infowin.Lines.Add('解压 ' + FName + '. 方法 -> ' +
           TVCLUnZip(Sender).CompressMethodStr[FileIndex]);
      StatusBar.Caption := '正在解压...';
      CurrentFileLabel.Caption := TVCLUnZip(Sender).Filename[FileIndex];
      CurrentFileLabel.Repaint;
end;

procedure TVCLZipForm.ZipperBadPassword(Sender: TObject; FileIndex: Integer; var NewPassword:
   string);
var
   MsgArray                   : array[0..255] of char;
begin
   with TVCLZip(Sender) do
   begin
      InvalidPwdDlg.PasswordEdit.Text := NewPassword;
      InvalidPwdDlg.Filename.Caption := Filename[FileIndex];
      MessageBeep(0);
      InvalidPwdDlg.ShowModal;
      if InvalidPwdDlg.ModalResult = mrOK then
         NewPassword := InvalidPwdDlg.PasswordEdit.Text
      else
      begin
         StrPCopy(MsgArray, '无效的文件口令 ' + Filename[FileIndex]);
         Application.MessageBox(MsgArray, '口令错', mb_OK);
         InfoWin.Lines.Add('...无效的文件口令 ' + Filename[FileIndex]);
      end;
   end;
end;

procedure TVCLZipForm.ZipperFilePercentDone(Sender: TObject;
   Percent: Longint);
begin
   Gauge1.Progress := Percent;
end;

procedure TVCLZipForm.ZipperSkippingFile(Sender: TObject; Reason: TSkipReason; FName: string;
   FileIndex: Integer; var Retry: Boolean );
var
   theReason                  : string;
begin
   if Reason = srFileOpenError then
    begin
      theReason := '文件 ' + FName + ' 已打开.  关闭文件并按 OK 来继续';
      theReason := ' 或按 Cancel 来跳过它并继续备份其它文件.';
      if MessageDlg(theReason, mtWarning, [mbOK, mbCancel], 0) = mrOK then
        Retry := True;
      exit;
    end;
   if Reason = srBadPassword then
      theReason := '口令错'
   else
      if Reason = srNoOverwrite then
      begin
         if FileIndex = -1 then
            theReason := '避免重复进入'
         else
            theReason := '避免复盖';
      end
      else
         theReason := '打开文件错';

   with Zipper do
      InfoWin.Lines.Add('...跳过文件 ' + FName + '. 原因: ' + theReason);
end;

procedure TVCLZipForm.ZipperPromptForOverwrite(Sender: TObject;
   var OverWriteIt: Boolean; FileIndex: Integer; var FName: string);
var
   AllDone                    : Boolean;
begin
   AllDone := True;
   with Zipper do
      repeat
         OverwriteDlg.FName.Caption := FName;
         Screen.Cursor := crDefault;
         OverwriteDlg.ShowModal;
         Screen.Cursor := crHourGlass;
         if OverwriteDlg.Action = oaOverwrite then
            OverwriteIt := True
         else
            if OverwriteDlg.Action = oaSkip then
               OverwriteIt := False;
         if OverwriteDlg.Action = oaRename then
            with RenameDlg do
            begin
               AllDone := False;
               InitialDir := ExtractFilePath(FName);
               FileName := ExtractFilename(FName);
               if RenameDlg.Execute then
               begin
                  FName := FileName;
                  OverWriteIt := True;
                  AllDone := True;
               end;
            end;
      until AllDone;
end;

procedure TVCLZipForm.ZipperBadCRC(Sender: TObject;
   CalcCRC, StoredCRC: LongInt; FileIndex: Integer);
var
   MsgArray                   : array[0..255] of char;
begin
   If Testing then
      InfoWin.Lines.Add('...' + TVCLZip(Sender).Filename[FileIndex] + ' 可能已损坏.')
   else with Zipper do
   begin
      StrPCopy(MsgArray, '错误的文件 CRC ' + Filename[FileIndex]);
      Application.MessageBox(MsgArray, 'CRC 错', mb_OK);
      InfoWin.Lines.Add('...错误的文件 CRC  ' + Filename[FileIndex]);
      InfoWin.Lines.Add('......保存的 CRC 是     ' + IntToStr(StoredCRC));
      InfoWin.Lines.Add('......计算的 CRC 是 ' + IntToStr(CalcCRC));
   end;
end;

procedure TVCLZipForm.ZipperTotalPercentDone(Sender: TObject;
   Percent: Longint);
begin
   Gauge2.Progress := Percent;
end;

procedure TVCLZipForm.ZipCommentMnuClick(Sender: TObject);
begin
   if Zipper.ZipName <> '' then
      with CommentEditor do
      begin
         CommentMemo.Clear;
         CommentEditor.Caption := '修改压缩注释 ' + ExtractFilename(Zipper.ZipName);
         if Zipper.ZipHasComment then
            CommentMemo.Text := Zipper.ZipComment;
         ShowModal;
         if ModalResult = mrOK then
            if CommentMemo.Text <> Zipper.ZipComment then
               Zipper.ZipComment := CommentMemo.Text;
      end;
end;

procedure TVCLZipForm.ZipperStartUnzipInfo(Sender: TObject;
   NumFiles: Integer; TotalBytes: Comp; var StopNow: Boolean);
begin
   If Testing then
     exit;
   InfoWin.Lines.Add(' ');
   InfoWin.Lines.Add('压缩的文件数: ' + IntToStr(NumFiles));
   InfoWin.Lines.Add('处理的总字节数: ' + FloatToStr(TotalBytes));
   InfoWin.Lines.Add('文件解压到: ' + Zipper.DestDir);
end;

procedure TVCLZipForm.SetLogging;
begin
   with Zipper, ConfigDlg do
   begin
      if OnStartUnZipInfoChk.Checked then
         OnStartUnZipInfo := ZipperStartUnzipInfo
      else
         OnStartUnZipInfo := nil;
      if OnStartUnZipChk.Checked then
         OnStartUnZip := ZipperStartUnZip
      else
         OnStartUnZip := nil;
      if OnBadCRCChk.Checked then
         OnBadCRC := ZipperBadCRC
      else
         OnBadCRC := nil;
      if OnBadPasswordChk.Checked then
         OnBadPassword := ZipperBadPassword
      else
         OnBadPassword := nil;
      if OnSkippingFileChk.Checked then