unit1.pas

ziptv为delphi控件

(*
 Drag & drop compression demo using Borlands TListView control.
*)
Unit Unit1;

Interface

{$I compiler.inc}
{$IFDEF DEL6_OR_HIGHER}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   ComCtrls,
   ExtCtrls,
   ShellAPI,
   StdCtrls,
   iniFiles,
   Menus,
   Buttons,
   ImgList,
   FileCtrl,
   Clipbrd,
   Printers,

   ztvBase,
   ztvConsts,     {TCompressionMethod}
   ztvGbls,
   ztvBlakHole,
   ztvMakeCab,
   ztvGZip,
   ztvJar,
   ztvLha,
   ztvTar,
   ztvZip,
   ztvRegister,
   ztvZipTV,
   ztvZipView;

Const
   MaxColumn = 11;

   // ListView captions
   Captions: Array[0..MaxColumn] Of String =
      ('Filename', 'Date / Time', 'Packed', 'Unpacked',
      'Ratio', 'Method', 'Attr', 'Folder', 'File Type',
      'CRC', 'FileOffset', 'Encrypted');

   // ListView's default column widths
   DefaultWidths: Array[0..MaxColumn] Of Integer =
      (120, 100, 75, 75, 70, 90, 60, 150, 120, 90, 80, 80);

   DefaultChecked: Array[0..MaxColumn] Of Boolean =
      (True, True, True, True, True, False,
      False, False, False, False, False, False);

Type
   TDest = (ToClipboard, ToPrinter, ToFile);

   // Custom TListView
   TDragDropListView = Class(TListView)
      Procedure DefaultHandler(Var Message); Override;
   Private
   Public
   End;

   // ZipTV's CompBase event handlers
   TCompBase_EventHandlers = Class(TObject)
      Procedure ArcOnCompressBegin(Sender: TObject; FName: String; Count: Integer; Var
         Extract: Boolean);
      Procedure ArcOnCompressEnd(Sender: TObject; FName: String; CRC_PASS: Boolean);
      Procedure ArcOnCompressFileExists(Sender: TObject; FileName: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure ArcOnError(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure ArcOnGetPassword(Sender: TObject; FName: String;
         Var Password: String; Var TryAgain: Boolean);
      Procedure ArcOnProgress(Sender: TObject; ProgressByFile,
         ProgressByArchive: Byte);
      Procedure ArcOnRenameDupeFile(Sender: TObject; OldFilename: String;
         Var NewFileName: String; Var Rename: Boolean);
      Procedure ArcOnReplaceFile(Sender: TObject; FileName, NewFileName:
         AnsiString; Date, NewDate: TDateTime; FileSize, NewFileSize:
         Int64; Attr, NewAttr: Integer; Var Replace: Boolean);
   End;

   TForm1 = Class(TForm)
      pnlStatus: TPanel;
      pbxLed: TPaintBox;
      StatusBar1: TStatusBar;
      ProgressBar1: TProgressBar;
      ProgressBar2: TProgressBar;
      SaveDialog1: TSaveDialog;
      FontDialog1: TFontDialog;
      ZipTV1: TZipTV;
      MainMenu1: TMainMenu;
      mnuFile1: TMenuItem;
      ScreenFont1: TMenuItem;
      PrintFont1: TMenuItem;
      Print1: TMenuItem;
      N2: TMenuItem;
      Exit1: TMenuItem;
      mnuView1: TMenuItem;
      FullPath1: TMenuItem;
      MSDOSName1: TMenuItem;
      Size1: TMenuItem;
      CreationDate1: TMenuItem;
      ModifiedDate1: TMenuItem;
      AccessedDate1: TMenuItem;
      A1: TMenuItem;
      CRC1: TMenuItem;
      Encrypted1: TMenuItem;
      Folder1: TMenuItem;
      FileType1: TMenuItem;
      FileOffset1: TMenuItem;
      OpenDialog1: TOpenDialog;
      ImageList1: TImageList;
      BitBtn1: TBitBtn;
      Edit1: TEdit;
      Edit2: TEdit;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      Panel1: TPanel;
      Panel2: TPanel;
      Panel3: TPanel;
      imgLed: TImage;
      ComboBox1: TComboBox;
      ComboBox2: TComboBox;
      ComboBox3: TComboBox;
      ComboBox4: TComboBox;
      CheckBox1: TCheckBox;
      Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
      Procedure FormCreate(Sender: TObject);
      Procedure FormDestroy(Sender: TObject);
      Procedure ZipTreeView1Click(Sender: TObject);
      Procedure ScreenFont1Click(Sender: TObject);
      Procedure PrintFont1Click(Sender: TObject);
      Procedure ColumnsUpdate;
      Procedure ColumnsCreate;
      Procedure SaveColumnWidths;
      Procedure ToggleChecked(Sender: TObject);
      Procedure ZipTV1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
      Procedure ZipTV1Read(Sender: TObject; Offset, Filenum: Integer);
      Procedure ZipTV1Totals(Sender: TObject; UnpackSize, PackSize: Double;
         Ratio, NumFiles: Integer);
      Procedure Exit1Click(Sender: TObject);
      Procedure ReadIni;
      Procedure WriteIni;
      Procedure CalcBuffer;
      Procedure CopyList(dest: TDest);
      Procedure MakeBuffer;
      Procedure BitBtn1Click(Sender: TObject);
      Procedure pbxLedClick(Sender: TObject);
      Procedure pbxLedPaint(Sender: TObject);
      Procedure SetLedColor(lColor: TColor);
      Procedure FormActivate(Sender: TObject);
   Private
      Buffer: Pchar;
      FieldLen: Array[0..MaxColumn] Of Integer;
      PrintName: String;
      PrintSize: Integer;
      PrintStyle: TFontStyles;
      CommaDelimited: Boolean;
      DragDropListView: TDragDropListView;
      //ColumnLists: Array[1..MaxColumn] Of TStringList;
      ColumnWidths: Array[0..MaxColumn] Of Integer;
      //procedure WMDROPFiles(var Msg: TWMDROPFILES); message WM_DROPFILES;
      Busy: Boolean;
      BufferSize: Longint;
   Public
   End;

Var
   Form1: TForm1;
   FilenameList: TStrings;
   fCompBase: TCompBASE;

Implementation

{$R *.DFM}

Var
   InternalPasteMessage: Cardinal;      //integer;

   //-------------------------------------------------------------

Procedure TDragDropListView.DefaultHandler(Var Message);
Var
   DroppedFilesCnt: Integer;
   DropIndex: Integer;
   FileName: String;
   Buffer: Pchar;
   BufferSize: Integer;
   //ImageIndex       : integer;
   //TS               : TSearchRec;
   //DTFormat         : String;
   //TSF              : TSHFileInfo;
   FilesCompressed: Integer;
   CB_EventHandlers: TCompBase_EventHandlers;
Begin
   Inherited DefaultHandler(Message);

   With TMessage(Message) Do
      If (Msg = WM_DROPFILES) Or
         (Msg = InternalPasteMessage) Then
      Begin
         If FileExists(Form1.Edit1.Text) Then
         Begin
            If MessageDlg(Form1.Edit1.Text + ' already exists, overwrite?',
               mtConfirmation, [mbYes, mbNo], 0) = mrNo Then
               Exit;

            If Not DeleteFile(Form1.Edit1.Text) Then
            Begin
               ShowMessage('Unable to delete archive.');
               Exit;
            End;
         End;

         Form1.DragDropListView.Cursor := crHourGlass;
         Form1.DragDropListView.Items.Clear();
         Form1.SetLedColor(clRed);
         Form1.ProgressBar1.Position := 0;
         Form1.ProgressBar2.Position := 0;
         Form1.ProgressBar1.Visible := True;
         Form1.ProgressBar2.Visible := True;

         Try
            DroppedFilesCnt := DragQueryFile(wParam, $FFFFFFFF, Pchar(0), 0);
            If DroppedFilesCnt > 0 Then
            Begin
               For DropIndex := 0 To DroppedFilesCnt - 1 Do
               Begin
                  BufferSize := DragQueryFile(wParam, DropIndex, Pchar(0), 0);
                  GetMem(Buffer, BufferSize + 1);
                  Try
                     DragQueryFile(wParam, DropIndex, Buffer, BufferSize + 1);
                     FileName := StrPas(Buffer);
                     If DirExists(FileName) Then
                        FileName := AppendDirTail(FileName) + '*.*';

                     FilenameList.Add(FileName);
                  Finally
                     FreeMem(Buffer);
                  End;
               End;
            End;

            Case Form1.ComboBox2.ItemIndex Of
               0:
                  Begin
                     fCompBase := TBlakHole.Create(Nil);
                     fCompBase.CompressMethod := cmFuse;
                  End;
               1:
                  Begin
                     fCompBase := TMakeCab.Create(Nil);
                     fCompBase.CompressMethod := cmMsZip;
                  End;
               2:
                  Begin
                     fCompBase := TGZip.Create(Nil);
                     fCompBase.CompressMethod := cmDeflate;
                  End;
               3:
                  Begin
                     fCompBase := TJar.Create(Nil);
                     fCompBase.CompressMethod := cmDeflate;
                  End;
               4:
                  Begin
                     fCompBase := TLha.Create(Nil);
                     fCompBase.CompressMethod := cmFrozen6;
                  End;
               5:
                  Begin
                     fCompBase := TTar.Create(Nil);
                     fCompBase.CompressMethod := cmTarred;
                  End;
               6:
                  Begin
                     fCompBase := TZip.Create(Nil);
                     fCompBase.CompressMethod := cmDeflate;
                     fCompBase.EncryptHeaders := False;
                  End;
            End;

            If fCompBase <> Nil Then
            Try
               (* Define FCompBase prior to call to		*)
               (* ConvertDate so variable ArchiveDate 	*)
               (* contains the correct date value 		*)
               fCompBase.ArchiveFile := Form1.Edit1.Text;
               fCompBase.DateAttribute := TDateAttribute(Form1.ComboBox4.ItemIndex);
               fCompBase.ExcludeSpec.Clear();
               fCompBase.FileSpec.Clear();
               fCompBase.FileSpec.Assign(FilenameList);
               fCompBase.RecurseDirs := False; //Form1.CheckBox1.Checked;
               fCompBase.CompressionMethod :=
                  TCompressionMethod(Form1.ComboBox3.ItemIndex);
               fCompBase.StoreEmptySubDirs := False;
               fCompBase.StoredDirNames := TStoredDirNames(Form1.ComboBox1.ItemIndex);
               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;
                  End;

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

                  With Form1.ZipTV1 Do
                  Begin
                     ArchiveFile := fCompBase.ArchiveFile;
                     FileSpec.Clear();
                     FileSpec.Add('*.*');
                     Activate();
                  End;

                  ShowMessage('Files compressed: ' + IntToStr(FilesCompressed));

               Finally
                  CB_EventHandlers.Destroy();
               End;

            Finally
               fCompBase.Free();
            End;

         Finally
            If Msg = WM_DROPFILES Then
               DragFinish(wParam);

            Form1.DragDropListView.Cursor := crDefault;
            Form1.SetLedColor(clGreen);
            Form1.ProgressBar1.Position := 0;
            Form1.ProgressBar2.Position := 0;
            Form1.ProgressBar1.Visible := False;
            Form1.ProgressBar2.Visible := False;
         End;

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

Procedure TForm1.SaveColumnWidths;