546 lines
17 KiB
ObjectPascal
546 lines
17 KiB
ObjectPascal
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower Abbrevia
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1997-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
unit QZipView1;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
AbArcTyp, AbUtils,
|
|
QForms,
|
|
AbZipper, AbZipKit, AbZipTyp, AbZBrows, AbMeter,
|
|
AbDlgDir, AbView, AbZView, AbBrowse, AbBase, AbQMeter, QMenus, QDialogs,
|
|
QTypes, QControls, QStdCtrls, QExtCtrls, QGrids, AbQView, AbQZView,
|
|
Classes;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
OpenDialog1: TOpenDialog;
|
|
Panel1: TPanel;
|
|
FontDialog1: TFontDialog;
|
|
MainMenu1: TMainMenu;
|
|
File1: TMenuItem;
|
|
Open1: TMenuItem;
|
|
Close1: TMenuItem;
|
|
N1: TMenuItem;
|
|
Print1: TMenuItem;
|
|
Exit1: TMenuItem;
|
|
ColorDialog1: TColorDialog;
|
|
ZipView1: TMenuItem;
|
|
Attributes1: TMenuItem;
|
|
Itemname1: TMenuItem;
|
|
Packed1: TMenuItem;
|
|
Method1: TMenuItem;
|
|
Ratio1: TMenuItem;
|
|
CRC1: TMenuItem;
|
|
Fileattributes1: TMenuItem;
|
|
Filetype1: TMenuItem;
|
|
Encryption1: TMenuItem;
|
|
Timestamp1: TMenuItem;
|
|
Filesize1: TMenuItem;
|
|
Versionmade1: TMenuItem;
|
|
Versionneeded1: TMenuItem;
|
|
Path1: TMenuItem;
|
|
Display1: TMenuItem;
|
|
Columnlines1: TMenuItem;
|
|
Columnmoving1: TMenuItem;
|
|
Columnresizing1: TMenuItem;
|
|
MultiSelect1: TMenuItem;
|
|
Rowlines1: TMenuItem;
|
|
Thumbtracking1: TMenuItem;
|
|
Trackactiverow1: TMenuItem;
|
|
Sort1: TMenuItem;
|
|
Itemname2: TMenuItem;
|
|
Packed2: TMenuItem;
|
|
Ratio2: TMenuItem;
|
|
Timestamp2: TMenuItem;
|
|
Filesize2: TMenuItem;
|
|
Select1: TMenuItem;
|
|
SelectAll1: TMenuItem;
|
|
ClearSelections1: TMenuItem;
|
|
Rows1: TMenuItem;
|
|
Rowheight1: TMenuItem;
|
|
Headerheight1: TMenuItem;
|
|
Font1: TMenuItem;
|
|
Alternatecolors1: TMenuItem;
|
|
Action1: TMenuItem;
|
|
Add1: TMenuItem;
|
|
Delete1: TMenuItem;
|
|
Extract1: TMenuItem;
|
|
Freshen1: TMenuItem;
|
|
AbZipView1: TAbZipView;
|
|
AbZipKit1: TAbZipKit;
|
|
ZipKit1: TMenuItem;
|
|
Compress1: TMenuItem;
|
|
N2: TMenuItem;
|
|
Store1: TMenuItem;
|
|
Stored1: TMenuItem;
|
|
Deflated1: TMenuItem;
|
|
Best1: TMenuItem;
|
|
Deflation1: TMenuItem;
|
|
Normal1: TMenuItem;
|
|
Maximum1: TMenuItem;
|
|
Fast1: TMenuItem;
|
|
SuperFast1: TMenuItem;
|
|
CreateDirs1: TMenuItem;
|
|
RestorePath1: TMenuItem;
|
|
StripPath1: TMenuItem;
|
|
RemoveDots1: TMenuItem;
|
|
Recurse1: TMenuItem;
|
|
ShowIcons1: TMenuItem;
|
|
Colors1: TMenuItem;
|
|
Selectedcolor: TMenuItem;
|
|
Selectedtextcolor: TMenuItem;
|
|
AlternateColor1: TMenuItem;
|
|
AlternateTextColor1: TMenuItem;
|
|
Freshen2: TMenuItem;
|
|
Panel2: TPanel;
|
|
AbMeter1: TAbMeter;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Moveselecteditem1: TMenuItem;
|
|
Replace1: TMenuItem;
|
|
PopupMenu1: TPopupMenu;
|
|
Delete2: TMenuItem;
|
|
Extract2: TMenuItem;
|
|
Freshen3: TMenuItem;
|
|
Move1: TMenuItem;
|
|
AbMeter2: TAbMeter;
|
|
Save1: TMenuItem;
|
|
Testselecteditems1: TMenuItem;
|
|
Logging1: TMenuItem;
|
|
DeletedColor1: TMenuItem;
|
|
DeletedTextColor1: TMenuItem;
|
|
AutomaticTar: TMenuItem;
|
|
ViewasTar1: TMenuItem;
|
|
procedure AbZipView1Click(Sender: TObject);
|
|
procedure AttributeClick(Sender: TObject);
|
|
procedure DisplayOptionClick(Sender: TObject);
|
|
procedure SortAttributeClick(Sender: TObject);
|
|
procedure Open1Click(Sender: TObject);
|
|
procedure Close1Click(Sender: TObject);
|
|
procedure SelectAll1Click(Sender: TObject);
|
|
procedure ClearSelections1Click(Sender: TObject);
|
|
procedure Font1Click(Sender: TObject);
|
|
procedure Exit1Click(Sender: TObject);
|
|
procedure Selected1Click(Sender: TObject);
|
|
procedure Selectedtext1Click(Sender: TObject);
|
|
procedure Rowheight1Click(Sender: TObject);
|
|
procedure Headerheight1Click(Sender: TObject);
|
|
procedure Add1Click(Sender: TObject);
|
|
procedure Delete1Click(Sender: TObject);
|
|
procedure Extract1Click(Sender: TObject);
|
|
procedure ExtractOptionClick(Sender: TObject);
|
|
procedure StoreOptionClick(Sender: TObject);
|
|
procedure MethodClick(Sender: TObject);
|
|
procedure DeflationOptionClick(Sender: TObject);
|
|
procedure AbZipKit1ConfirmProcessItem(Sender: TObject;
|
|
Item: TAbArchiveItem; ProcessType: TAbProcessType;
|
|
var Confirm: Boolean);
|
|
procedure AbZipView1Change(Sender: TObject);
|
|
procedure AlternateColor1Click(Sender: TObject);
|
|
procedure AlternateTextColor1Click(Sender: TObject);
|
|
procedure Freshen1Click(Sender: TObject);
|
|
procedure Moveselecteditem1Click(Sender: TObject);
|
|
procedure AbZipKit1Save(Sender: TObject);
|
|
procedure Save1Click(Sender: TObject);
|
|
procedure Testselecteditems1Click(Sender: TObject);
|
|
procedure Logging1Click(Sender: TObject);
|
|
procedure DeletedColor1Click(Sender: TObject);
|
|
procedure DeletedTextColor1Click(Sender: TObject);
|
|
procedure AutomaticTarClick(Sender: TObject);
|
|
procedure ViewasTar1Click(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.xfm}
|
|
|
|
const
|
|
MainCaption = ' TAbZipView example';
|
|
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AbZipView1Click(Sender: TObject);
|
|
begin
|
|
Panel1.Caption := AbZipView1.Items[AbZipView1.ActiveRow].Filename;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Open1Click(Sender: TObject);
|
|
begin
|
|
OpenDialog1.Filename := '*.zip';
|
|
if OpenDialog1.Execute then begin
|
|
AbZipKit1.Filename := OpenDialog1.Filename;
|
|
Caption := AbZipKit1.Filename +
|
|
' ' + IntToStr(AbZipView1.Count) + ' items';
|
|
Action1.Enabled := True;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Close1Click(Sender: TObject);
|
|
begin
|
|
AbZipKit1.Filename := '';
|
|
Caption := MainCaption;
|
|
Panel1.Caption := '';
|
|
Action1.Enabled := False;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AttributeClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := not Checked;
|
|
if Checked then
|
|
AbZipView1.Attributes := AbZipView1.Attributes + [TAbViewAttribute(Tag)]
|
|
else
|
|
AbZipView1.Attributes := AbZipView1.Attributes - [TAbViewAttribute(Tag)];
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.DisplayOptionClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := not Checked;
|
|
if Checked then
|
|
AbZipView1.DisplayOptions := AbZipView1.DisplayOptions +
|
|
[TAbDisplayOption(Tag)]
|
|
else
|
|
AbZipView1.DisplayOptions := AbZipView1.DisplayOptions -
|
|
[TAbDisplayOption(Tag)]
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.SortAttributeClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := not Checked;
|
|
if Checked then
|
|
AbZipView1.SortAttributes := AbZipView1.SortAttributes +
|
|
[TAbSortAttribute(Tag)]
|
|
else
|
|
AbZipView1.SortAttributes := AbZipView1.SortAttributes -
|
|
[TAbSortAttribute(Tag)]
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.StoreOptionClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := not Checked;
|
|
if Checked then
|
|
AbZipKit1.StoreOptions := AbZipKit1.StoreOptions +
|
|
[TAbStoreOption(Tag)]
|
|
else
|
|
AbZipKit1.StoreOptions := AbZipKit1.StoreOptions -
|
|
[TAbStoreOption(Tag)]
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.ExtractOptionClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := not Checked;
|
|
if Checked then
|
|
AbZipKit1.ExtractOptions := AbZipKit1.ExtractOptions +
|
|
[TAbExtractOption(Tag)]
|
|
else
|
|
AbZipKit1.ExtractOptions := AbZipKit1.ExtractOptions -
|
|
[TAbExtractOption(Tag)]
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.MethodClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := true;
|
|
AbZipKit1.CompressionMethodToUse := TAbZipSupportedMethod(Tag);
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.DeflationOptionClick(Sender: TObject);
|
|
begin
|
|
with TMenuItem(Sender) do begin
|
|
Checked := true;
|
|
AbZipKit1.DeflationOption := TAbZipDeflationOption(Tag);
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.SelectAll1Click(Sender: TObject);
|
|
begin
|
|
AbZipView1.SelectAll;
|
|
AbZipView1Click(nil);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.ClearSelections1Click(Sender: TObject);
|
|
begin
|
|
AbZipView1.ClearSelections;
|
|
AbZipView1Click(nil);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Font1Click(Sender: TObject);
|
|
begin
|
|
FontDialog1.Font := AbZipView1.Font;
|
|
if FontDialog1.Execute then
|
|
AbZipView1.Font := FontDialog1.Font;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Exit1Click(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.DeletedColor1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.Deleted := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.DeletedTextColor1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.DeletedText := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Selected1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.Selected := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Selectedtext1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.SelectedText := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Rowheight1Click(Sender: TObject);
|
|
var
|
|
s : string;
|
|
begin
|
|
s := IntToStr(AbZipView1.DefaultRowHeight);
|
|
if InputQuery(MainCaption, 'Row Height', s) then
|
|
AbZipView1.DefaultRowHeight := StrToIntDef(s, 18);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Headerheight1Click(Sender: TObject);
|
|
var
|
|
s : string;
|
|
begin
|
|
s := IntToStr(AbZipView1.HeaderRowHeight);
|
|
if InputQuery(MainCaption, 'Header Height', s) then
|
|
AbZipView1.HeaderRowHeight := StrToIntDef(s, 18);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Add1Click(Sender: TObject);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
with OpenDialog1 do begin
|
|
Filename := '*.*';
|
|
Options := Options + [ofAllowMultiSelect];
|
|
AbZipView1.BeginUpdate;
|
|
if Execute then for i := 0 to Pred(Files.Count) do
|
|
AbZipKit1.AddFiles(Files[i], 0);
|
|
AbZipView1.EndUpdate;
|
|
Panel1.Caption := '';
|
|
Options := Options - [ofAllowMultiSelect];
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Delete1Click(Sender: TObject);
|
|
var
|
|
i : Longint;
|
|
begin
|
|
Panel1.Caption := '';
|
|
with AbZipView1 do
|
|
for i := 0 to Pred(Count) do
|
|
Items[i].Tagged := Selected[i];
|
|
AbZipKit1.DeleteTaggedItems;
|
|
Panel1.Caption := '';
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Extract1Click(Sender: TObject);
|
|
var
|
|
i : Longint;
|
|
Continue : Boolean;
|
|
begin
|
|
{$IFDEF Win32}
|
|
with TAbDirDlg.Create(Self) do begin
|
|
Caption := 'Directory';
|
|
AdditionalText := 'Select folder to extract into';
|
|
SelectedFolder := AbZipKit1.BaseDirectory;
|
|
Continue := Execute;
|
|
if Continue then
|
|
AbZipKit1.BaseDirectory := SelectedFolder;
|
|
{$ELSE}
|
|
with TDirDlg.Create(Self) do begin
|
|
SelectedFolder := AbZipKit1.BaseDirectory;
|
|
Continue := (ShowModal = mrOK);
|
|
if Continue then
|
|
AbZipKit1.BaseDirectory := SelectedFolder;
|
|
{$ENDIF}
|
|
Free;
|
|
end;
|
|
if not Continue then
|
|
Exit;
|
|
Panel1.Caption := '';
|
|
with AbZipView1 do
|
|
for i := 0 to Pred(Count) do
|
|
Items[i].Tagged := Selected[i];
|
|
AbZipKit1.ExtractTaggedItems;
|
|
AbZipView1.ClearSelections;
|
|
Panel1.Caption := '';
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Freshen1Click(Sender: TObject);
|
|
var
|
|
i : Longint;
|
|
begin
|
|
Panel1.Caption := '';
|
|
with AbZipView1 do
|
|
for i := 0 to Pred(Count) do
|
|
Items[i].Tagged := Selected[i];
|
|
AbZipKit1.FreshenTaggedItems;
|
|
AbZipKit1.Save;
|
|
AbZipView1.ClearSelections;
|
|
Panel1.Caption := '';
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.TestSelecteditems1Click(Sender: TObject);
|
|
var
|
|
i : Longint;
|
|
begin
|
|
Panel1.Caption := '';
|
|
with AbZipView1 do
|
|
for i := 0 to Pred(Count) do
|
|
Items[i].Tagged := Selected[i];
|
|
AbZipKit1.TestTaggedItems;
|
|
AbZipView1.ClearSelections;
|
|
Panel1.Caption := '';
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AbZipKit1ConfirmProcessItem(Sender: TObject;
|
|
Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);
|
|
var
|
|
s : string;
|
|
begin
|
|
case ProcessType of
|
|
ptAdd : s := 'Adding ';
|
|
ptDelete : s := 'Deleting ';
|
|
ptExtract : s := 'Extracting ';
|
|
ptFreshen : s := 'Freshening ';
|
|
else
|
|
s := '??? ';
|
|
end;
|
|
Panel1.Caption := s + Item.Filename;
|
|
Confirm := True;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AbZipView1Change(Sender: TObject);
|
|
begin
|
|
Caption := AbZipKit1.Filename +
|
|
' ' + IntToStr(AbZipView1.Count) + ' items';
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AlternateColor1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.Alternate := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AlternateTextColor1Click(Sender: TObject);
|
|
begin
|
|
if ColorDialog1.Execute then
|
|
AbZipView1.Colors.AlternateText := ColorDialog1.Color;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Moveselecteditem1Click(Sender: TObject);
|
|
var
|
|
i : Longint;
|
|
s : string;
|
|
begin
|
|
with AbZipView1 do
|
|
if (SelCount > 0) then begin
|
|
for i := 0 to Pred(Count) do
|
|
if Selected[i] then begin
|
|
s := Items[i].Filename;
|
|
if InputQuery(MainCaption, 'Rename file', s) then
|
|
AbZipKit1.Move(Items[i], s);
|
|
end;
|
|
AbZipKit1.Save;
|
|
AbZipView1.ClearSelections;
|
|
Panel1.Caption := '';
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.AbZipKit1Save(Sender: TObject);
|
|
begin
|
|
Panel1.Caption := 'Saving ' + AbZipKit1.Filename;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Save1Click(Sender: TObject);
|
|
begin
|
|
if (AbZipKit1.Filename <> '') then
|
|
AbZipKit1.Save;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TForm1.Logging1Click(Sender: TObject);
|
|
begin
|
|
Logging1.Checked := not Logging1.Checked;
|
|
if Logging1.Checked then begin
|
|
OpenDialog1.Title := 'Select log file';
|
|
if AbZipKit1.LogFile = '' then
|
|
OpenDialog1.Filename := '*.txt'
|
|
else
|
|
OpenDialog1.Filename := AbZipKit1.LogFile;
|
|
Logging1.Checked := OpenDialog1.Execute;
|
|
if Logging1.Checked then
|
|
AbZipKit1.LogFile := OpenDialog1.Filename;
|
|
end;
|
|
AbZipKit1.Logging := Logging1.Checked;
|
|
end;
|
|
|
|
procedure TForm1.AutomaticTarClick(Sender: TObject);
|
|
begin
|
|
AbZipKit1.TarAutoHandle := not AbZipKit1.TarAutoHandle;
|
|
AutomaticTar.Checked := AbZipKit1.TarAutoHandle;
|
|
end;
|
|
procedure TForm1.ViewasTar1Click(Sender: TObject);
|
|
begin
|
|
AbZipKit1.ForceType := not AbZipKit1.ForceType;
|
|
ViewasTar1.Checked := AbZipKit1.ForceType;
|
|
if AbZipKit1.ForceType then
|
|
AbZipKit1.ArchiveType := atGzippedTar;
|
|
end;
|
|
|
|
|
|
end.
|