Delphi 7zip 示例调用7z.dll 压缩及解压.7z文件

例子中使用了开源代码d7zip,项目地址为 http://code.google.com/p/d7zip/

其中源码只包含sevenzip.pas一个单元，源码中readme.htm给出了简单示例。

主要代码如下，在Win7+Delphi XE 3 下调试通过：

unit Form_Main;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
 
type
  TFormMain = class(TForm)
    memoOutput: TMemo;
    btnAddFiles: TButton;
    btnCompress: TButton;
    btnExtract: TButton;
    OpenDialog: TOpenDialog;
    ProgressBar: TProgressBar;
    procedure btnAddFilesClick(Sender: TObject);
    procedure btnCompressClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnExtractClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  FormMain: TFormMain;
 
implementation
 
{$R *.dfm}
 
uses sevenzip;
 
function ProgressCallback(Sender: Pointer; total: boolean; value: int64)
  : HRESULT; stdcall;
begin
  if total then
    FormMain.ProgressBar.Max := value
  else
    FormMain.ProgressBar.Position := value;
  Result := S_OK;
end;
 
procedure TFormMain.btnAddFilesClick(Sender: TObject);
var
  Counter: Integer;
begin
  if OpenDialog.Execute(Handle) then
  begin
    for Counter := 0 to OpenDialog.Files.Count - 1 do
    begin
      memoOutput.Lines.Append(OpenDialog.Files[Counter]);
    end;
  end;
end;
 
procedure TFormMain.btnCompressClick(Sender: TObject);
var
  Arch: I7zOutArchive;
  Counter: Integer;
begin
  if OpenDialog.Files.Count = 0 then
  begin
    ShowMessage('请添加文件');
    Exit;
  end;
  memoOutput.Lines.Append('开始压缩');
  Arch := CreateOutArchive(CLSID_CFormat7z);
  Arch.SetProgressCallback(nil, ProgressCallback);
  for Counter := 0 to OpenDialog.Files.Count - 1 do
    Arch.AddFile(OpenDialog.Files[Counter],
      ExtractFileName(OpenDialog.Files[Counter]));
  SetCompressionLevel(Arch, 5);
  SevenZipSetCompressionMethod(Arch, T7zCompressionMethod.m7Deflate64);
  Arch.SaveToFile('.\test.7z');
  memoOutput.Lines.Append('完成压缩');
  Arch := nil;
end;
 
procedure TFormMain.btnExtractClick(Sender: TObject);
var
  Arch: I7zInArchive;
  Counter: Integer;
begin
  if not FileExists('.\test.7z') then
  begin
    ShowMessage('请先成生压缩文件');
    Exit;
  end;
  memoOutput.Lines.Append('开始解压缩');
  Arch := CreateInArchive(CLSID_CFormat7z);
  Arch.SetProgressCallback(nil, ProgressCallback);
  Arch.OpenFile('.\test.7z');
  for Counter := 0 to Arch.NumberOfItems - 1 do
  begin
    if not Arch.ItemIsFolder[Counter] then
      memoOutput.Lines.Append('包含文件：' + Arch.ItemPath[Counter]);
  end;
  if ForceDirectories('.\Extract') then
  begin
    Arch.ExtractTo('.\Extract');
    memoOutput.Lines.Append('完成解压缩');
    Arch := nil;
  end
  else
    ShowMessage('无法解压到指定目录');
end;
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
  OpenDialog.Options := [ofReadOnly, ofAllowMultiSelect];
end;
 
end.