unit1.pas

ziptv为delphi控件

   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;
//-------------------------------------------------------------
(* OnRemoveTempfile - Event *)

Procedure TForm1.Arc2Arc1RemoveTempfile(Sender: TObject; FileName: String);
Var
   LocalFileName: String;
Begin
   LocalFileName :=
      MinimizeName('Removing: ' + FileName, StatusBar1.Canvas, StatusBar1.Width);

   StatusBar1.SimpleText := LocalFileName;
   StatusBar1.Update();
   ListBox1.Items.Add('Removed: ' + FileName);
End;
//-------------------------------------------------------------
(* OnFileExists - Event *)

Procedure TForm1.Arc2Arc1FileExists(Sender: TObject; FileName: String;
   Var OverwriteMode: TOverwriteMode);
Var
   Msg: String;
Begin
   Msg := 'Filename: ' + FileName + #13#13 + 'File already exists, ';

   If Arc2Arc1.OutArcMethod = amCreateNew Then
      Msg := Msg + 'overwrite?'
   Else
      Msg := Msg + 'add files?';

   If MessageDlg(Msg, mtInformation, [mbYes, mbNo], 0) = mrNo Then
      OverwriteMode := omSkip
   Else
      OverwriteMode := omOverwrite;

End;
//-------------------------------------------------------------
(* OnIntegrityActivate - Event *)

Procedure TForm1.Arc2Arc1IntegrityActivate(Sender: TObject);
Begin
   ListBox1.Items.Add('Verifying --> ' + Arc2Arc1.NewArchive);
End;
//-------------------------------------------------------------
(* OnIntegrityBegin - Event *)

Procedure TForm1.Arc2Arc1IntegrityBegin(Sender: TObject; FileName: String);
Begin
   StatusBar1.SimpleText := 'Verifying:  ' + FileName;
   StatusBar1.Update();
End;
//-------------------------------------------------------------
(* OnIntegrityStatus - Event *)

Procedure TForm1.Arc2Arc1IntegrityStatus(Sender: TObject; FileName: String;
   PassFail: Boolean);
Var
   s: String;
Begin
   (* Optain the RecNum value from the active component *)
   s := '(' + IntToStr(TZipCommon(Sender).Count) + ') ';

   If PassFail Then
      s := s + FileName + ' ...Ok'
   Else
      s := s + FileName + ' ...Failed';

   ListBox1.Items.Add(s);
End;
//-------------------------------------------------------------
(* OnIntegrityDeactivate - Event *)

Procedure TForm1.Arc2Arc1IntegrityDeactivate(Sender: TObject);
Begin
   ListBox1.Items.Add('--> FINISHED <--');
End;
//-------------------------------------------------------------

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

Procedure TForm1.btnOKClick(Sender: TObject);
Begin
   ApplicationBusy();
   ListBox1.Clear();
   Arc2Arc1.ArchiveFile := Edit1.Text;
   Arc2Arc1.FileSpec.Clear();
   Arc2Arc1.FileSpec.Add('*.*');        // include all files
   Arc2Arc1.NewArchive := Edit2.Text;
   Arc2Arc1.OutArcType := TOutArcType(RadioGroup1.ItemIndex);
   Arc2Arc1.OutArcMethod := TOutArcMethod(RadioGroup2.ItemIndex);
   Arc2Arc1.IntegrityCheck := CheckBox1.Enabled And CheckBox1.Checked;
   Arc2Arc1.DateAttribute := TDateAttribute(ComboBox1.ItemIndex);
   Arc2Arc1.Activate();                 (* Activate the conversion 			*)
   ApplicationWaiting();
End;
//-------------------------------------------------------------

Procedure TForm1.EditChange(Sender: TObject);
Begin
   btnOK.Enabled := (Edit1.Text <> '') And (Edit2.Text <> '');
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;
//-------------------------------------------------------------
(* Little light in right corner of form *)

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;
//-------------------------------------------------------------

Procedure TForm1.ApplicationBusy;
Begin
   With ProgressBar1 Do
   Begin
      Position := 0;
      Update();
      Visible := True;
   End;

   With ProgressBar2 Do
   Begin
      Position := 0;
      Update();
      Visible := True;
   End;

   SetLedColor(clRed);
   StatusBar1.SimpleText := '';
End;
//-------------------------------------------------------------

Procedure TForm1.ApplicationWaiting;
Begin
   ProgressBar1.Visible := False;
   ProgressBar1.Position := 0;
   ProgressBar2.Visible := False;
   ProgressBar2.Position := 0;
   SetLedColor(clGreen);
   If Arc2Arc1.Cancel Then
      StatusBar1.SimpleText := 'User canceled...'
   Else
      StatusBar1.SimpleText := 'Done...';
End;
//-------------------------------------------------------------

Procedure TForm1.pbxLedClick(Sender: TObject);
Begin
   StatusBar1.SimpleText := 'Aborting...';
   StatusBar1.Update();
   Arc2Arc1.Cancel := True;
End;
//-------------------------------------------------------------

Procedure TForm1.btnSelectDirClick(Sender: TObject);
Var
   Dir: String;
Begin
   If Edit2.Text <> '' Then
      If SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], -1) Then
         Edit2.Text := AppendDirTail(Dir) + ExtractFilename(Edit2.Text);
End;
//-------------------------------------------------------------

Procedure TForm1.Open1Click(Sender: TObject);
Begin
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
   OpenDialog1.Title := 'Select existing archive...';

   (* F_TZIPTV comes from err_msgs.pas *)
   OpenDialog1.Filter := LoadStr(F_TZIPTV);

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

{$ifndef debug_proj}
      Edit2.Text := ChangeFileExt(Edit1.Text, FileExt[RadioGroup1.ItemIndex]);
{$else}
      Edit2.Text := 'd:\hold1\' + ExtractFileName(ChangeFileExt(Edit1.Text, FileExt[RadioGroup1.ItemIndex]));
{$endif debug_proj}
   End;
End;
//-------------------------------------------------------------

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

Procedure TForm1.RadioGroup1Click(Sender: TObject);
Begin
   (* Validity checks (TZipCheck component) 	*)
                     (* doesn't support cabinet files 			*)
   CheckBox1.Enabled := RadioGroup1.ItemIndex <> 1;

   (* Can't add files to a cabinet file...	*)
   (* create only                          	*)
   If RadioGroup1.ItemIndex = 1 Then
      RadioGroup2.ItemIndex := 0;
   RadioGroup2.Enabled := RadioGroup1.ItemIndex <> 1;

   (* Change the extension of the outfile 	*)
   If Edit2.Text <> '' Then
      Edit2.Text := ChangeFileExt(Edit1.Text, FileExt[RadioGroup1.ItemIndex]);
End;
//-------------------------------------------------------------

Procedure TForm1.Arc2Arc1ElaspedTime(Sender: TObject; ElaspedTime: Real);
Var
   s: ShortString;
Begin
   s := Format('Seconds: %g', [ElaspedTime]);
   ShowMessage(s + #13#13'OnElaspedTime event');
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
	Edit1.Text := '';
   Edit2.Text := '';
   ComboBox1.ItemIndex := 0;
End;
//-------------------------------------------------------------

End.