【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（二）

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