unit1.pas

ZIP压缩算法 delphi组件 含代码

Unit Unit1;

Interface

Uses
   Windows,
   Messages,
   SysUtils,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   StdCtrls,
   Buttons,
   ExtCtrls,
   ComCtrls,

   ztvRegister,
   ztvBase,
   ztvGbls,
   ztvZipSplitGlue,
   ztvZipCheck;

Type
   TfrmMain = Class(TForm)
      Panel1: TPanel;
      Panel2: TPanel;
      Edit1: TEdit;
      Edit2: TEdit;
      Label1: TLabel;
      Label2: TLabel;
      BitBtn1: TBitBtn;
      Button1: TButton;
      Button2: TButton;
      Memo1: TMemo;
      ZipSplitGlue1: TZipSplitGlue;
      OpenDialog1: TOpenDialog;
      Procedure BitBtn1Click(Sender: TObject);
      Procedure Button1Click(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
      Procedure Edit1Change(Sender: TObject);
      Procedure ZipSplitGlue1FileExists(Sender: TObject; FileName: String;
         FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
      Procedure ZipSplitGlue1NextVolume(Sender: TObject; Var VolumeName:
      	String; VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
      Procedure ZipSplitGlue1Error(Sender: TObject; FileName, ExtendedMsg,
         VolumeID: String; ECode: Integer);
    	Procedure ZipSplitGlue1GetFileCount(Sender: TObject; TotalFileCount: Integer);
   Private
      { Private declarations }
   Public
      { Public declarations }
   End;

Var
   frmMain: TfrmMain;

Implementation

Uses
   Unit2,
   Unit3 {error messages};


Var
	TotalFileCnt: Integer;

{$R *.DFM}

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

Procedure TfrmMain.Button1Click(Sender: TObject);
Var
	FilesCopied: Integer;
Begin
   frmErrorMsgs.ListView1.Items.Clear();
   Button2.Enabled := False;

   If Edit2.Text <> '' Then
   Begin

      // Assign the ArchiveFile property the value of Edit1.Text
      ZipSplitGlue1.ArchiveFile := Edit1.Text;

      // The ArcType property is assigned internally when the ArchiveFile
      // property is assigned the value of an existing archive.  Check the
      // ArcType property to ensure the archive selected is a supported type
      // for this process.
      If ZipSplitGlue1.IsArcSplitable(ZipSplitGlue1.ArcType) Then
      Begin

         // Assign the OutArchiveFile property
         ZipSplitGlue1.OutArchiveFile := Edit2.Text;

         // ============================================
         // Apply the glue - call the GlueArchive method
         // ============================================
         FilesCopied := ZipSplitGlue1.GlueArchive();
         // ============================================

         ShowMessage(
                  'Total file count: ' + IntToStr(TotalFileCnt) + #13 +
                  '    Files copied: ' + IntToStr(FilesCopied));

         Button2.Enabled := FileExists(ZipSplitGlue1.OutArchiveFile);

         If frmErrorMsgs.ListView1.Items.Count > 0 Then
            frmErrorMsgs.ListView1.Show();
      End Else
      	ShowMessage(ZipSplitGlue1.ArchiveFile + ' is not a supported ' +
           'archive for this process');
   End
   Else
      ShowMessage('No OutArchiveFile');

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

Procedure TfrmMain.Edit1Change(Sender: TObject);
Begin
   If Edit1.Text <> '' Then
      Edit2.Text :=
         ExtractFilePath(Edit1.Text) +
         ExtractFileNameOnly(Edit1.Text) +
         '_out' +
         ExtractFileExt(Edit1.Text)
   Else
      Edit2.Text := '';

   If FileExists(Edit1.Text) Then
   Begin
   	// assign the ArchiveFile property
      ZipSplitGlue1.ArchiveFile := Edit1.Text;
      Button1.Enabled := ZipSplitGlue1.ArcType = atZipMV;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmMain.ZipSplitGlue1FileExists(Sender: TObject; FileName: String;
   FileDate: TDateTime; Var OverwriteMode: TOverwriteMode);
Begin
   If MessageDlg(FileName + #13#13 +
      'File already exists...'#13#13 + 'Overwrite this file?',
      mtConfirmation, [mbYes, mbNo], 0) = mrNo Then
      OverwriteMode := omSkip;
End;
//-------------------------------------------------------------

Procedure TfrmMain.ZipSplitGlue1NextVolume(Sender: TObject; Var VolumeName:
	String; VolumeID: Integer; FExists: Boolean; Var Cancel: Boolean);
Var
   NewFile, Prompt, Caption: String;
Begin
   If Not FExists Then                  (* FExists = FileExists *)
   Begin
      Caption := ExtractFilename(VolumeName);
      Prompt := 'Volume ID: ' + IntToStr(VolumeID);
      NewFile := VolumeName;

      If Not InputQuery(Caption, Prompt, NewFile) Then
         Cancel := True
      Else
         VolumeName := NewFile;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmMain.ZipSplitGlue1Error(Sender: TObject; FileName, ExtendedMsg,
   VolumeID: String; ECode: Integer);
Var
   NewItem: TListItem;
Begin
   If frmErrorMsgs {unit2} <> Nil Then         // has form been created?
   Begin
      NewItem := frmErrorMsgs.ListView1.Items.Insert(0); (* Create a new row *)
      With NewItem Do
      Begin
         Caption := LowerCase(Sender.Classname);
         With SubItems Do
         Begin
            Add(LowerCase(TZipCommon(Sender).ArchiveFile)); // archive FileName
            Add(LowerCase(ExtractFilename(FileName))); // FileName
            Add(IntToStr(ECode));       // convert error number to a string
            Add(LoadStr(ECode)); // Load error string from err_msgs.rc & err_msgs.pas
            Add(ExtendedMsg);           // Extended message such as required event params
         End;
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TfrmMain.BitBtn1Click(Sender: TObject);
Begin
   OpenDialog1.FileName := Edit1.Text;
   OpenDialog1.Title := 'Open ''Multi-volume zip archive...';
   OpenDialog1.Filter := 'Zip arhives (*.zip)|*.zip';
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
   If OpenDialog1.Execute() Then
      Edit1.Text := OpenDialog1.FileName
End;
//-------------------------------------------------------------

Procedure TfrmMain.Button2Click(Sender: TObject);
Begin
   Edit1.SetFocus();
   frmTest.ZipCheck1.ArchiveFile := Edit2.Text;

   If frmTest.ZipCheck1.IsArcValid(frmTest.ZipCheck1.ArcType) Then
      frmTest.ShowModal()
   Else
      Button2.Enabled := False;

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

Procedure TfrmMain.ZipSplitGlue1GetFileCount(Sender: TObject;
  TotalFileCount: Integer);
Begin
	TotalFileCnt := TotalFileCount;
End;
//-------------------------------------------------------------

End.