unit1.pas

ziptv为delphi控件

   (* Delimiter is a property of the ZipListBox *)
   With ZipView1 Do                     (* for the Delimiter variable *)
   Begin

      BuildString :=
         ExtractFilename(ZipCommon.FileName) + Delimiter +

      (* Date property 			*)
      FormatDateTime('mm' + DateSeparator + 'dd' +
         DateSeparator + 'yy hh:mm', ZipCommon.Date) + Delimiter +

      IntToStr(ZipCommon.PackedSize) + Delimiter +
         IntToStr(ZipCommon.UnpackedSize) + Delimiter +
         IntToStr(ZipCommon.Ratio) + '%' + Delimiter +

      ZipCommon.sCompressionMethod + Delimiter +
         //..or
      //IntToStr( ZipCommon.wCompressionMethod ) + Delimiter +

      ZipCommon.FileAttrToString(ZipCommon.ExternalAttr, Byte('_')) +
         ' (' + IntToStr(ZipCommon.ExternalAttr) + ')' + Delimiter +

      ExtractFilePath(ZipCommon.FileName) + Delimiter +
         ZipCommon.GetFileType(ZipCommon.FileName) + Delimiter +

      //IntToStr( ZipCommon.CRC ) + Delimiter +
      //..or
      IntToHex(ZipCommon.CRC, 8) + Delimiter +

      IntToStr(Offset) + Delimiter;

      If ZipCommon.Encrypted Then
         BuildString := BuildString + 'Yes' + Delimiter
      Else
         BuildString := BuildString + 'No' + Delimiter;

      BuildString := BuildString + ZipCommon.VolumeName + Delimiter;

      (* FileComment is NOT included in TZipCommon (as we typecast-ed using
      Sender previously in this procedure)... only TZipTV *)
      BuildString := BuildString + StrPas(ZipCommon.FileComment);

      ZipView1.Items.Add(BuildString);
   End;
End;
//-------------------------------------------------------------
// TZipTV: OnTotals event

Procedure TForm1.ZipTV1Totals(Sender: TObject; UnpackSize, PackSize: Int64;
   Ratio, NumFiles: Integer);
Begin
   If NumFiles > 0 Then
   Begin
      Ratio := CalcRatio(ZipTV1.TotalPackedSize, ZipTV1.TotalUnpackedSize);

      With StatusBar1 Do
      Begin

         If NumFiles > 0 Then
            Panels[0].Text := ArcTypeNames[ZipTV1.ArcType]
         Else
            Panels[0].Text := '';

         Panels[1].Text := 'Files: ' + IntToStr(NumFiles);
         Panels[2].Text := 'Packed: ' + Format('%.0n', [ZipTV1.TotalPackedSize]);
         Panels[3].Text := 'Unpacked: ' + Format('%.0n', [ZipTV1.TotalUnpackedSize]);
         Panels[4].Text := 'Ratio: ' + IntToStr(Ratio) + '%';
      End;
   End
   Else
      StatusBar1.SimpleText := '';

   ProgressBar1.Position := 0;
   ProgressBar2.Position := 0;
   ProgressBar1.Visible := False;
   ProgressBar2.Visible := False;
   StatusBar1.SimplePanel := False;
   StatusBar1.Update();
End;
//-------------------------------------------------------------

Procedure TForm1.BitBtn1Click(Sender: TObject);
Begin
   OpenDialog1.FileName := Edit1.Text;
   OpenDialog1.Title := 'Select file(s) to add ( Ctrl+Click or Shift+Click )';
   OpenDialog1.Options := [ofHideReadOnly, ofPathMustExist];
   OpenDialog1.Filter := 'All_files (*.*)|*.*';

   If OpenDialog1.Execute() Then
   Begin
      Edit1.Text := OpenDialog1.FileName;

      // display contents of existing archive
      With ZipTV1 Do
      Begin
         ZipView1.Items.BeginUpdate();
         ZipView1.Items.Clear();

         ArchiveFile := Edit1.Text;     // assign the archive file-name

         If IsArcValid(ArcType) And SetComboBox2(ArcType) Then
         Begin
            FileSpec.Clear();
            FileSpec.Add('*.*');
            Activate();                 // activate ZipTV1... fill the listbox
         End;

         ZipView1.Items.EndUpdate();
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.pbxLedClick(Sender: TObject);
Var
   DoCancel: Boolean;
Begin
   DoCancel := True;
   If fCompBase <> Nil Then
      fCompBase.Cancel := True
   Else
      DoCancel := False;

   If DoCancel Then
   Begin
      StatusBar1.SimpleText := 'Aborting...';
      StatusBar1.Update();
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.pbxLedPaint(Sender: TObject);
Begin
   With Sender As TPaintBox Do
      Canvas.Draw((Width - imgLed.Width) Div 2,
         (Height - imgLed.Height) Div 2,
         imgLed.Picture.Graphic);
End;
//-------------------------------------------------------------
// Change colors of little light in corner of form

Procedure TForm1.SetLedColor(lColor: TColor);
Begin
   With imgLed.Canvas Do
   Begin
      Brush.Color := lColor;
      FloodFill(6, 6, Pixels[6, 6], fsSurface);
   End;
   pbxLed.Repaint;
End;
//-------------------------------------------------------------
// TFoundData.Data points to a TWin32FindData structure for each item in FileList

Procedure TForm1.ZipView1DroppedFiles(Sender: TObject; FileList: TStringList);
Var
   FilesCompressed: Integer;
   CB_EventHandlers: TCompBase_EventHandlers;
Begin
   // Each item in FileList contains a TFoundData object.
   //
   // The TFoundData object contains a TWin32FindData record for each item in
   // FileList.  See "FindFirstFile" function for a description of the
   // WIN32_FIND_DATA record structure.
   //
   // Example:
   //
   //    Var
   //       i: Integer;
   //       Attr: Integer;
   //       Filename: String;
   //       FoundData: TFoundData;
   // Begin
   //    For i := 0 To FileList.Count - 1 Do
   //    Begin
   //       FoundData := TFoundData( FileList.Objects[i] );
   //       Filename := FoundData.Data.cFilename;
   //       Attr := FoundData.Data.dwFileAttributes;
   //    End;
   // End;

   //If FileExists( Edit1.Text ) Then
   //Begin
 //	If MessageDlg(Edit1.Text + ' already exists, overwrite?', mtConfirmation, [mbYes, mbNo], 0) = mrNo Then
   //		Exit;
   //
   //   If Not DeleteFile( Edit1.Text ) Then
   //   Begin
   //      ShowMessage('Unable to delete archive.');
   //      Exit;
   //   End;
   //End;

   ZipView1.Cursor := crHourGlass;
   SetLedColor(clRed);
   ProgressBar1.Position := 0;
   ProgressBar2.Position := 0;
   ProgressBar1.Visible := True;
   ProgressBar2.Visible := True;

   Try

      // Archive Type
      Case ComboBox2.ItemIndex Of
         0: fCompBase := TBlakHole.Create(Nil);
         1: fCompBase := TMakeCab.Create(Nil);
         2: fCompBase := TGZip.Create(Nil);
         3: fCompBase := TJar.Create(Nil);
         4: fCompBase := TLha.Create(Nil);
         5: fCompBase := TTar.Create(Nil);
         6: fCompBase := TZip.Create(Nil);
      Else
         fCompBase := Nil;
      End;

      If fCompBase <> Nil Then
      Try
         fCompBase.EncryptHeaders := False;

         (* Define FCompBase prior to call to		*)
         (* ConvertDate so variable ArchiveDate 	*)
         (* contains the correct date value 		*)
         fCompBase.ArchiveFile := Edit1.Text;
         fCompBase.CompressionMethod := TCompressionMethod(ComboBox3.ItemIndex);
         fCompBase.DateAttribute := TDateAttribute(ComboBox4.ItemIndex);
         fCompBase.ExcludeSpec.Clear();
         fCompBase.FileSpec.Clear();
         fCompBase.FileSpec.Assign(FileList);
         fCompBase.RecurseDirs := CheckBox1.Checked;
         fCompBase.StoredDirNames := TStoredDirNames(ComboBox1.ItemIndex);
         fCompBase.StoreEmptySubDirs := False;
         fCompBase.Switch := swAdd;
         //fCompBase.DeflateType := TDeflateType( rgDeflateType.ItemIndex );
         //fCompBase.OnActivate := OnCompressActivate;
         //fCompBase.OnDeactivate := ArcOnDeactivate;

         CB_EventHandlers := TCompBase_EventHandlers.Create();
         Try
            With fCompBase, CB_EventHandlers Do
            Begin
               OnBegin := ArcOnCompressBegin;
               OnEnd := ArcOnCompressEnd;
               OnError := ArcOnError;
               OnFileExists := ArcOnCompressFileExists;
               OnGetPassword := ArcOnGetPassword;
               OnProgress := ArcOnProgress;
               OnRenameDupeFile := ArcOnRenameDupeFile;
               OnReplaceFile := ArcOnReplaceFile;
               OnRecurseDir := ArcOnRecurseDir;
               OnFileScanStatus := ArcOnScanStatus;
            End;

            // activate the compression
            FilesCompressed :=
               fCompBase.Compress();

            ZipView1.Items.BeginUpdate();
            ZipView1.Clear();
            StatusBar1.SimpleText := '';

            // redisplay the archive contents using the TZipTV component
            With ZipTV1 Do
            Begin
               ArchiveFile := fCompBase.ArchiveFile;
               FileSpec.Clear();
               FileSpec.Add('*.*');
               If IsArcValid(ArcType) Then
                  Activate();

            End;

            ZipView1.Items.EndUpdate();
            ShowMessage('Files compressed: ' + IntToStr(FilesCompressed));

         Finally
            CB_EventHandlers.Destroy();
         End;

      Finally
         fCompBase.Free();
      End;
   Finally
      ZipView1.Cursor := crDefault;
      SetLedColor(clGreen);
      ProgressBar1.Position := 0;
      ProgressBar2.Position := 0;
      ProgressBar1.Visible := False;
      ProgressBar2.Visible := False;
   End;

End;
//-------------------------------------------------------------

Procedure TForm1.FormActivate(Sender: TObject);
Begin
   ComboBox1.ItemIndex := Ord(sdRelative);
   //ComboBox2.ItemIndex := 6;  // .zip format as default
   ComboBox3.ItemIndex := Ord(cmTempFile); // write to temp-file as default
   ComboBox4.ItemIndex := Ord(daFileDate);  // set compressed file's date as the disk file's date
   //ZipView1.DragDrop_DirSpec := Edit2.Text;
End;
//-------------------------------------------------------------
// assign the filetype of files dropped to compress

Procedure TForm1.ZipView1DroppedFilesStart(Sender: TObject; Var FileSpec: String);
Begin
   If Length(Edit2.Text) > 0 Then
      FileSpec := Edit2.Text;
End;
//-------------------------------------------------------------

Procedure TForm1.ZipView1DroppedFilesEnd(Sender: TObject);
Begin
   //
End;
//-------------------------------------------------------------

Procedure TForm1.TestArchive1Click(Sender: TObject);
Begin
   If ZipTV1.IsArcValid(ZipTV1.ArcType) Then
      frmTestArchive.ShowModal();
End;
//-------------------------------------------------------------

End.