D7zTool是一个基于7-zip库开发的解压缩示例程序,除了应用程序本身,仅包含一个7z.dll
主要界面:
D7zTool示例程序demo的pas源码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
D7zUtils,
Dialogs, ComCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
Edit1: TEdit;
OpenDialog1: TOpenDialog;
ListView1: TListView;
btnOpenFile: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
SaveDialog1: TSaveDialog;
procedure btnOpenFileClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FD7zipFile: TD7zipFile;
procedure ShowPathItems(sPath: WideString);
end;
var
Form1: TForm1;
implementation
uses
sevenzip;
{$R *.dfm}
procedure TForm1.btnOpenFileClick(Sender: TObject);
begin
if not OpenDialog1.Execute() then Exit;
if not FD7zipFile.LoadFromFile(OpenDialog1.FileName) then
begin
ShowMessage('打开失败');
Exit;
end;
ShowPathItems('\\');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FD7zipFile:=TD7zipFile.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FD7zipFile.Free;
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
sPath: WideString;
begin
if ListView1.ItemFocused<>nil then
if Pos('2_', ListView1.ItemFocused.SubItems.Strings[1])=1 then
begin
sPath := ListView1.ItemFocused.Caption;
if (sPath<>'.') and (sPath<>'..') and (FD7zipFile.CurrentItemPath<>'\\') then
sPath := FD7zipFile.CurrentItemPath+sPath;
ShowPathItems(sPath);
end;
end;
procedure TForm1.ShowPathItems(sPath: WideString);
var
I: Integer;
sList: TStrings;
begin
ListView1.Clear;
//加文件夹
sList := FD7zipFile.GetItems(sPath, 2);
for I:=0 to sList.Count-1 do
with ListView1.Items.Add do
begin
Caption := ExtractFileName(sList.Strings[I]);
SubItems.Add('');
SubItems.Add('2_文件夹');
end;
sList.Free;
//加文件
if sPath<>'' then
sPath := FD7zipFile.CurrentItemPath;//转换为当前目录
sList := FD7zipFile.GetItems(sPath, 1);
for I:=0 to sList.Count-1 do
if (sList.Strings[I]<>'.') and (sList.Strings[I]<>'..') then
with ListView1.Items.Add do
begin
Caption := ExtractFileName(sList.Strings[I]);
SubItems.Add('');
SubItems.Add('1_文件');
end;
sList.Free;
Edit1.Text := FD7zipFile.CurrentItemPath;
end;
procedure TForm1.N1Click(Sender: TObject);
var
sFileName: WideString;
begin
if ListView1.ItemFocused=nil then Exit;
if Pos('1_', ListView1.ItemFocused.SubItems.Strings[1])<>1 then Exit;
if not SaveDialog1.Execute then Exit;
sFileName := ListView1.ItemFocused.Caption;
if (FD7zipFile.CurrentItemPath<>'\\') then
sFileName := FD7zipFile.CurrentItemPath+sFileName;
FD7zipFile.ExtractItemToFile(sFileName, SaveDialog1.FileName);
end;
end.
对应的dfm文件
object Form1: TForm1
Left = 539
Top = 114
Width = 689
Height = 412
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Edit1: TEdit
Left = 40
Top = 48
Width = 616
Height = 21
TabOrder = 0
end
object ListView1: TListView
Left = 40
Top = 80
Width = 616
Height = 281
Columns = <
item
Caption = '文件名'
Width = 200
end
item
Caption = '大小'
Width = 100
end
item
Caption = '类型'
Width = 100
end
item
Caption = '修改时间'
Width = 100
end
item
Caption = '属性'
Width = 100
end>
RowSelect = True
PopupMenu = PopupMenu1
TabOrder = 1
ViewStyle = vsReport
OnDblClick = ListView1DblClick
end
object btnOpenFile: TButton
Left = 40
Top = 8
Width = 75
Height = 25
Caption = '打开文件'
TabOrder = 2
OnClick = btnOpenFileClick
end
object OpenDialog1: TOpenDialog
Left = 592
Top = 48
end
object PopupMenu1: TPopupMenu
Left = 328
Top = 184
object N1: TMenuItem
Caption = '解压'
OnClick = N1Click
end
end
object SaveDialog1: TSaveDialog
Left = 456
Top = 136
end
end