unit1.pas

ziptv为delphi控件

      {$IFDEF USE_LISTVIEW}
      ListView1.Items.Clear();
      {$ELSE}
      ZipView1.Items.Clear();
      {$ENDIF}
      (* ------------------------------------------------------------- *)
      (* Assign ZipSearch component property values from form controls *)
      (* ------------------------------------------------------------- *)

      ZipSearch1.SearchType := [];      // start with a blank value
      // if CheckBox[x].Checked, the st[xxx] member will be included into
      // the value of the SearchType property, else will be
      // excluded.
      ZipSearch1.SetSearchType(stDecompress, CheckBox1.Checked);
      ZipSearch1.SetSearchType(stNonArchive, CheckBox2.Checked);
      //
      ZipSearch1.RecurseDirs := CheckBox3.Checked;
      ZipSearch1.CaseSensitive := CheckBox4.Checked;
      ZipSearch1.SearchFind := TztvSearchFind(RadioGroup1.ItemIndex);
      ZipSearch1.SearchMode := TztvSearchMode(ComboBox1.ItemIndex);

      (* Assign ZipSearch component property values... activate search *)
      ZipSearch1.SearchText := Edit2.Text;
      ZipSearch1.FileSpec.Clear();
      If Edit3.Text <> '' Then
         ZipSearch1.FileSpec.Add(Edit3.Text);

      (* Assign the archive filename.                                      *)
      (* In ZipSearch, always assign all properties prior to assigning the *)
      (* filename.                                                         *)
      ZipSearch1.ArchiveFile := Edit1.Text;
      ZipSearch1.Search();

   Finally
      Busy := False;
      btnOK.Enabled := True;
      If Form3.Dump.Lines.Count > 0 Then
         Form3.ShowModal;
   End;
End;
//-------------------------------------------------------------
(* Close Button - Menu: 'Exit' also uses this procedure *)

//-------------------------------------------------------------
(* Cancel Button *)

Procedure TForm1.btnCancelClick(Sender: TObject);
Begin
   ZipSearch1.Cancel := True;
End;
//-------------------------------------------------------------
       (* Form controls - Edit controls *)
//-------------------------------------------------------------
(* Assign OffsetBegin property *)

Procedure TForm1.Edit4Change(Sender: TObject);
Var
   i: Integer;
Begin
   If Edit4.Text = '' Then
      i := 0
   Else
      i := StrToInt(Edit4.Text);

   ZipSearch1.OffsetBegin := i;
End;
//-------------------------------------------------------------
(* Assign OffsetEnd property *)

Procedure TForm1.Edit5Change(Sender: TObject);
Var
   i: Integer;
Begin
   If Edit5.Text = '' Then
      i := 0
   Else
      i := StrToInt(Edit5.Text);

   ZipSearch1.OffsetEnd := i;
End;
//-------------------------------------------------------------
(* Enable/Disable OK button *)

Procedure TForm1.Edit2Change(Sender: TObject);
Begin
   btnOK.Enabled := (Edit2.Text <> '') And (Edit1.Text <> '');
End;
//-------------------------------------------------------------
(* Extract the currently selected file *)

Function TForm1.ExtractForViewing: Boolean;
Begin
   Result := False;

   {$IFDEF USE_LISTVIEW}
   If (ListView1.Items.Count = 0) Or (ZipSearch1.fArchiveFile = '') Then
      {$ELSE}
   If (ZipView1.Items.Count = 0) And (ZipSearch1.fArchiveFile = '') Then
      {$ENDIF}
      Exit;

   (* Create the object for the proper decompression component  *)
   ZipSearch1.DecompressObj := ZipSearch1.CreateUnBase(ZipTV1.ArcType);
   If ZipSearch1.DecompressObj <> Nil Then
   Try
      ZipSearch1.DecompressObj.ArchiveFile := ZipTV1.ArchiveFile;
      ZipSearch1.DecompressObj.Passwords.Clear();
      ZipSearch1.DecompressObj.FileSpec.Clear();
      {$IFDEF USE_LISTVIEW}
      ZipSearch1.DecompressObj.FileSpec.Add(ListView1.Selected.Caption);
      {$ELSE}
      ZipSearch1.DecompressObj.FileSpec.Add(ZipView1.Column[ZipView1.ItemIndex,
         COLUMN_FILENAME]);
      {$ENDIF}
      ZipSearch1.DecompressObj.ExtractDir := GetTempPathStr;
      ZipSearch1.DecompressObj.UseStoredDirs := True;
      ZipSearch1.DecompressObj.RestoreFileAttr := False;
      ZipSearch1.DecompressObj.ConfirmOverwrites := False;

      Result := ZipSearch1.DecompressObj.Extract() > 0;
      If Result Then
         {$IFDEF USE_LISTVIEW}
         ExtractedFileList.Add(GetTempPathStr + ListView1.Selected.Caption);
      {$ELSE}
         With ZipView1 Do
            ExtractedFileList.Add(GetTempPathStr + Column[ItemIndex, COLUMN_FILENAME]);
      {$ENDIF}
   Finally
      ZipSearch1.DecompressObj.Free();
   End;
End;

//-------------------------------------------------------------
       (* Form controls - Menu *)
//-------------------------------------------------------------
(* File/Open menu item *)

Procedure TForm1.Open1Click(Sender: TObject);
Begin
   OpenDialog1.Options := [ofHideReadOnly, ofFileMustExist, ofPathMustExist];
   OpenDialog1.InitialDir := ExtractFilePath(Edit1.Text);

   If OpenDialog1.Execute Then
   Begin
      ZipSearch1.ArchiveFile := OpenDialog1.FileName;
      Edit1.Text := OpenDialog1.FileName;

      Edit3.Enabled := ZipSearch1.IsArcDecompressable(ZipSearch1.ArcType);
      If Edit3.Enabled Then
         Edit3.Enabled := True
      Else
         Edit3.Color := clGray;

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

Procedure TForm1.ViewFile(method: Byte);
Var
   f: File;
   Buf: Array[0..200] Of Char;
   FilePos, RRes: Integer;
   TmpS, FileName: ShortString;
   Viewer: TFrmViewer;
Begin

   {$IFDEF USE_LISTVIEW}
   If ListView1.Selected = Nil Then
      Exit;
   ZipTV1.ArchiveFile := ListView1.Selected.SubItems[COLUMN_ARCHIVE - 1];
   If ZipTV1.IsArcValid(ZipTV1.ArcType) Then
      FileName := GetTempPathStr + ListView1.Selected.Caption
   Else
      FileName := ListView1.Selected.SubItems[COLUMN_ARCHIVE - 1];
   {$ELSE}
   If ZipView1.ItemIndex < 0 Then
      Exit;
   ZipTV1.ArchiveFile := ZipView1.Column[ZipView1.ItemIndex, COLUMN_ARCHIVE];
   If ZipTV1.IsArcValid(ZipTV1.ArcType) Then
      FileName := GetTempPathStr + ZipView1.Column[ZipView1.ItemIndex, COLUMN_FILENAME]
   Else
      FileName := ZipView1.Column[ZipView1.ItemIndex, COLUMN_ARCHIVE];
   {$ENDIF}

   // if file doesn't already exist... extract it
   If Not FileExists(FileName) Then
      If ZipTV1.IsArcValid(ZipTV1.ArcType) Then
         If Not ExtractForViewing Then
            Exit;

   // Method 0 opens and reads the extracted file for display.
   // Method 1 uses LoadFromFile to read and display data.
   If method = 0 Then
   Begin
      {$I-}
      If IoResult <> 0 Then
         Exit;
      AssignFile(f, FileName);
      FileMode := 0;
      Reset(f, 1);
      FileMode := 2;
      {$IFDEF USE_LISTVIEW}
      FilePos := StrToInt(ListView1.Selected.SubItems[COLUMN_POSITION - 1]);
      {$ELSE}
      FilePos := StrToInt(ZipView1.Column[ZipView1.ItemIndex, COLUMN_POSITION]);
      {$ENDIF}
      Seek(f, FilePos);
      BlockRead(f, Buf[0], SizeOf(Buf), RRes);
      CloseFile(f);
      If IoResult = 0 Then
      Begin
         Move(Buf[0], TmpS[1], RRes);
         TmpS[0] := Chr(RRes);
      End
      Else
         TmpS := 'Fileopen-Error Or dump in Buffer not implemented here!';
      {$I+}

      Form3.Dump.Text := TmpS;
   End
   Else
   Begin
      Viewer := TFrmViewer.Create(Application);
      Try
         {$IFDEF USE_LISTVIEW}
         With ListView1.Selected Do
            {$ELSE}
         With ZipView1 Do
            {$ENDIF}
         Begin
            Viewer.RtfCode.Lines.LoadFromFile(FileName);
            Viewer.Caption := Viewer.Caption + ExtractFilename(FileName);
            {$IFDEF USE_LISTVIEW}
            Viewer.OpenAt(Length(Edit2.Text),
               StrToInt(SubItems[COLUMN_POSITION - 1]));
            {$ELSE}
            Viewer.OpenAt(Length(Edit2.Text),
               StrToInt(Column[ItemIndex, COLUMN_POSITION]));
            {$ENDIF}
         End;
      Except
         ShowMessage('Not a viewable file');
         Viewer.Free();
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ListView1Click(Sender: TObject);
Begin
   ViewFile(1);
End;
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   {$IFDEF USE_LISTVIEW}
   ListView1.Visible := True;
   {$ELSE}
   ZipView1.Visible := True;
   {$ENDIF}
   ExtractedFileList := TStringList.Create();
   DumpArchiveList := TStringList.Create();
End;
//-------------------------------------------------------------

Procedure TForm1.FormDestroy(Sender: TObject);
Var
   i: Integer;
Begin
   For i := 0 To ExtractedFileList.Count - 1 Do
      DeleteFile(ExtractedFileList.Strings[i]);

   DumpArchiveList.Free();
   ExtractedFileList.Free();
End;
//-------------------------------------------------------------
(* View popup menu item *)

Procedure TForm1.View1Click(Sender: TObject);
Begin
   ViewFile(1);
End;
//-------------------------------------------------------------

Procedure TForm1.ZipView1Click(Sender: TObject; Row, Col: Integer);
Begin
	If Busy Then Exit;
   
   If ZipView1.ItemIndex < 0 Then
      Exit;
   ListView1Click(Sender);
End;
//-------------------------------------------------------------

Procedure TForm1.btnExcludeClick(Sender: TObject);
Begin
	If Busy Then Exit;
   Form2.Show();
End;
//-------------------------------------------------------------
(* OnGetZipFirstDisk - .zip multi-volume support *)

Procedure TForm1.ZipSearch1GetZipFirstDisk(Sender: TObject; Var Cancel: Boolean);
Begin
   Application.ProcessMessages;
   Case MessageDlg('Insert FIRST disk of this archive set.', mtInformation, [mbOK,
      mbCancel], 0) Of
      mrOK: Cancel := False;
      mrCancel: ;
   End;
End;
//-------------------------------------------------------------
(* OnGetZipNextDisk - .zip multi-volume support *)

Procedure TForm1.ZipSearch1GetZipNextDisk(Sender: TObject; VolumeName: String; Var
   Cancel: Boolean);
Begin
   Application.ProcessMessages;
   Case MessageDlg('Insert disk# : ' + VolumeName, mtInformation, [mbOK, mbCancel], 0) Of
      mrOK: Cancel := False;
      mrCancel: ;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ZipSearch1GetZipLastDisk(Sender: TObject; Var Cancel: Boolean);
Begin
   Application.ProcessMessages;
   Case MessageDlg('Insert LAST disk of this archive set.', mtInformation, [mbOK,
      mbCancel], 0) Of
      mrOK: Cancel := False;
      mrCancel: ;
   End;
End;
//-------------------------------------------------------------

// Event - OnExcludeFile
// Form3 is the activity log form
//
// Note(s): when scanning multiple files/archives, the ZipSearch updates the
// ArchiveFile property with the name of the file/archive currently being
// searched.

Procedure TForm1.ZipSearch1ExcludeFile(Sender: TObject; FileName: String);
Begin
   If ZipSearch1.IsArcValid(ZipSearch1.ArcType) Then
   Begin
      // display the archive name only once
      If DumpArchiveList.IndexOf(ZipSearch1.ArchiveFile) = -1 Then
      Begin
      	// add the ArchiveFile to the errors form
         Form3.Dump.Lines.Add(ZipSearch1.ArchiveFile);
         Form3.Dump.Lines.Add(#9'*SKIPPED - included by ''FileSpec property''... excluded by ''ExcludeExt''');

         // add to this forms listbox (ZipView1)
         DumpArchiveList.Add(ZipSearch1.ArchiveFile); // add to list
      End;

      // add to errors form
      Form3.Dump.Lines.Add(#9 + FileName)
   End
   Else
   	// non archive... add to errors form
      Form3.Dump.Lines.Add('*SKIPPED - ' + FileName);
End;
//-------------------------------------------------------------

Procedure TForm1.ActivityLogClick(Sender: TObject);
Begin
   Form3.ShowModal;
End;
//-------------------------------------------------------------

// menuitem mnuDisplayElapsedTime

Procedure TForm1.mnuDisplayElapsedTime1Click(Sender: TObject);
Begin
   mnuDisplayElapsedTime1.Checked := mnuDisplayElapsedTime1.Checked Xor True;
End;
//-------------------------------------------------------------

// Event - OnChangeSearchFile

Procedure TForm1.ZipSearch1ChangeSearchFile(Sender: TObject; FileName: String);
Begin
	Label6.Caption := 'Current Archive:';
   Edit6.Text := FileName;
End;
//-------------------------------------------------------------

Procedure TForm1.ZipSearch1ChangeDir(Sender: TObject; Dir: String);
Begin
	Label6.Caption := 'Searching dir:';
   Edit6.Text := Dir;
   Edit7.Text := '';
End;
//-------------------------------------------------------------

Procedure TForm1.ZipSearch1Progress(Sender: TObject; ByFile,
  ByArchive: Byte);
Begin
   ProgressBar1.Position := ByArchive;
   ProgressBar1.Update();
End;
//-------------------------------------------------------------

End.