7-Zip Delphi API
Source demo.
Unit1.pas
------------
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDlg: TOpenDialog;
progress1: TProgressBar;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses SevenZip;
{$R *.dfm}
function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
begin
if total then
Form1.progress1.Max := value else
Form1.progress1.Position := value;
Result := S_OK;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
path: string;
filename: string;
begin
with CreateInArchive(CLSID_CFormatZip) do
begin
OpenFile(Edit1.text);
SetProgressCallback(nil, ProgressCallback);
if not DirectoryExists(Edit2.text) then begin
path:= ExtractFilePath(Edit1.Text);
filename := ExtractFileName(Edit1.text);
filename := StringReplace(filename,format('%s',[ExtractFileExt(Edit1.text)]),'',[rfReplaceAll]);
Edit2.text := path + filename;
ExtractTo(Edit2.text);
end
else
ExtractTo(Edit2.text);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDlg.Execute then
Edit1.text:= OpenDlg.FileName;
end;
end.
Unit1.dfm
-------------
object Form1: TForm1
Left = 201
Top = 190
Width = 797
Height = 364
Caption = '7-ZIP DELPHI API '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 40
Top = 24
Width = 52
Height = 13
Caption = 'Archive file'
end
object Label2: TLabel
Left = 40
Top = 112
Width = 82
Height = 13
Caption = 'Destination folder'
end
object Button1: TButton
Left = 624
Top = 136
Width = 75
Height = 25
Caption = 'Extract all'
TabOrder = 0
OnClick = Button1Click
end
object progress1: TProgressBar
Left = 40
Top = 88
Width = 705
Height = 17
TabOrder = 1
TabStop = True
end
object Edit1: TEdit
Left = 40
Top = 48
Width = 585
Height = 21
TabOrder = 2
end
object Edit2: TEdit
Left = 40
Top = 136
Width = 577
Height = 21
TabOrder = 3
Text = 'C:\Temp\xx'
end
object Button2: TButton
Left = 632
Top = 48
Width = 113
Height = 25
Caption = 'Browse archive file'
TabOrder = 4
OnClick = Button2Click
end
object OpenDlg: TOpenDialog
DefaultExt = '*.zip'
Filter = 'All archives (Zip, 7z)|*.zip; *.7z'
Left = 472
Top = 65528
end
end
Comments
Post a Comment