【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（一）
==============================
关键词：压缩文件、压缩包、7zip、SevenZip、RAR、内存读取、内存解压、TAR、GZIP、ZIP
==============================
基于安全软件考虑，有时候为了不在本地生成临时文件，应用程序需要直接在内存打开加载各种类型的文件。
目前比较困难的文件类型是EXE、PDF、压缩文件、音频视频文件等。
其中EXE网络上有部分PELoader的实现源码，当对系统兼容性并不是很好，希望有这方面开发的朋友可以提供相关源码，多谢。
本文涉及内容相对较为简单，但却比较实用。
文件压缩/解压实现原理相对比较复杂，本文也不会讨论压缩算法方面的知识（实在是力不能及）。
对于一般应用程序，要实现从内存直接加载/读取/解析/解压压缩包，使用现有的压缩类库是最好的方案。
在比较各种压缩包开发库后，选择出使用7zip（sevenZip）的库读取各种类型的压缩包，网络上已有封装好7z.dll中各个API的delphi版sevenzip.pas。
本文也可以作为基于7ZIP自主开发解压软件的示例。
使用注意：
1）7z.dll：直接安装7-zip后在安装目录下就有。
2）sevenzip.pas：在本文最后附上
以下是对sevenzip.pas二次封装，实现下面功能：
1）实现LoadFromFile、LoadFromStream函数，对于熟悉VCL的这2个方法会比较亲切
2）实现按多层目录（目录树）获取文件列表的函数GetItems（只是简单实现，方便命令行程序开发）
3）实现解压指定文件函数：ExtractItemToStream、ExtractItemToFile
示例程序：
【Delphi】从内存直接读取加载或解压压缩文件（RAR、ZIP、TAR、GZIP）等（二）
sevenzip.pas源码：
【Delphi】从内存直接读取加载或解压压缩文件（RAR、ZIP、TAR、GZIP）等（三）
源码：
unit D7zUtils;
interface
uses
SysUtils, Classes, Sevenzip;
type
TD7zFileType = (dftZip, dftBZ2, dftRar, dftArj, dftZ, dftLzh, dft7z, dftCab, dftNsis, dftLzma,
dftPe, dftElf, dftMacho, dftUdf, dftXar, dftMub, dftHfs, dftDmg, dftCompound,
dftWim, dftIso, dftBkf, dftChm, dftSplit, dftRpm, dftDeb, dftCpio, dftTar,
dftGZip);
TD7zFileTypes = set of TD7zFileType;
TD7zipStrings = TStrings;
TD7zipStringList = class(TStringList)
public
constructor Create();virtual;
end;
TOnPassword = procedure (Sender: TObject; var sPassword: WideString; var bContinue:Boolean) of object;
TOnProgress = procedure (Sender: TObject; bIsTotal: boolean; iValue: Int64; var bContinue:Boolean) of object;
TD7zipFile = class
private
FInArchive: I7zInArchive;
FItems: TD7zipStrings;
FTmpStream: TStream;
private
FCurrentItemPath: WideString;
FOnPassword: TOnPassword;
FOnProgress: TOnProgress;
private
FPasswordCallback: T7zPasswordCallback;
FProgressCallback: T7zProgressCallback;
function DoOnPassword(var sPassword: WideString): HRESULT;
function DoOnProgress(bIsTotal: boolean; iValue: Int64): HRESULT;
public
constructor Create();virtual;
destructor Destroy;override;
function LoadFromFile(AFileName: WideString):Boolean;
function LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]):Boolean;overload;
function LoadFromStream(AStream: TStream; AFileType: TD7zFileType):Boolean;overload;
public
function GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;//iFilter： 0-All 1-File 2 Dir ; sPath-暂不支持通配符
public
function ExtractItemToStream(sFileName: WideString; AStream: TStream):Boolean; //解压/获取单个文件
function ExtractItemToFile(sFileName: WideString; sToFile: WideString):Boolean;//解压/获取单个文件
public
property CurrentItemPath: WideString read FCurrentItemPath;
public
//fileSystem functions
function FileExists(sFileName: WideString):Boolean;
function DirectoryExists(sDirName: WideString):Boolean;
function GetCurrentDir(): WideString;
public
property OnPassword: TOnPassword read FOnPassword write FOnPassword;
property OnProgress: TOnProgress read FOnProgress write FOnProgress;
end;
implementation
function FUNC_PasswordCallback(sender: Pointer; var password: UnicodeString): HRESULT; stdcall;
begin
// call a dialog box ...
//password := 'password';
//Result := S_OK;
Result := S_FALSE;
if sender=nil then Exit;
Result := TD7zipFile(sender).DoOnPassword(password);
end;
function FUNC_ProgressCallback(sender: Pointer; total: boolean;
value: Int64): HRESULT; stdcall;
begin
Result := S_FALSE;
if sender=nil then Exit;
Result := TD7zipFile(sender).DoOnProgress(total, value);
end;
{ TD7zipFile }
constructor TD7zipFile.Create;
begin
FItems:=TD7zipStringList.Create;
FPasswordCallback := FUNC_PasswordCallback;
FProgressCallback := FUNC_ProgressCallback;
end;
destructor TD7zipFile.Destroy;
begin
FItems.Free;
FreeAndNil(FTmpStream);
inherited;
end;
function TD7zipFile.DirectoryExists(sDirName: WideString): Boolean;
var
iIndex:Integer;
begin
Result := False;
if FInArchive=nil then Exit;
if sDirName<>'' then
if sDirName[Length(sDirName)]<>'\' then
sDirName := sDirName +'\';
iIndex := Self.FItems.IndexOf(sDirName);
if iIndex=-1 then Exit;
Result := FInArchive.ItemIsFolder[iIndex];
end;
function TD7zipFile.DoOnPassword(var sPassword: WideString): HRESULT;
var
bContinue: Boolean;
begin
bContinue := True;
if Assigned(FOnPassword) then FOnPassword(Self, sPassword, bContinue);
if bContinue then Result := S_OK else Result := S_FALSE;
end;
function TD7zipFile.DoOnProgress(bIsTotal: boolean;
iValue: Int64): HRESULT;
var
bContinue: Boolean;
begin
bContinue := True;
if Assigned(FOnProgress) then FOnProgress(Self, bIsTotal, iValue, bContinue);
if bContinue then Result := S_OK else Result := S_FALSE;
end;
function TD7zipFile.ExtractItemToFile(sFileName: WideString;
sToFile: WideString): Boolean;
var
AStream: TStream;
begin
AStream:=TFileStream.Create(sToFile, fmCreate);
try
Result := ExtractItemToStream(sFileName, AStream);
finally
AStream.Free;
end;
end;
function TD7zipFile.ExtractItemToStream(sFileName: WideString;
AStream: TStream): Boolean;
var
iIndex: Integer;
begin
Result := False;
if FInArchive=nil then Exit;
iIndex := FItems.IndexOf(sFileName);
if iIndex=-1 then Exit;
try
FInArchive.ExtractItem(iIndex, AStream, False);
Result := True;
except
end;
end;
function TD7zipFile.FileExists(sFileName: WideString): Boolean;
var
iIndex:Integer;
begin
Result := False;
if FInArchive=nil then Exit;
if sFileName<>'' then
if sFileName[Length(sFileName)]<>'\' then
sFileName := sFileName +'\';
iIndex := Self.FItems.IndexOf(sFileName);
if iIndex=-1 then Exit;
Result := not FInArchive.ItemIsFolder[iIndex];
end;
function TD7zipFile.GetCurrentDir: WideString;
begin
Result := FCurrentItemPath;
end;
function TD7zipFile.GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;
function IsItemChild(sParent, sChild: WideString):Boolean;
//var
// sTmp: WideString;
begin
if (sParent='') then //获取全部
Result := True
else if (sParent='\\') then //根目录
Result := Pos('\', sChild)=0
else
begin
Result := (Pos(sParent, sChild)=1) and
(Pos('\', Copy(sChild, Length(sParent)+1, Length(sChild)))=0);
end;
end;
var
I: Integer;
sTmp: WideString;
bDir: Boolean;
begin
Result := TD7zipStringList.Create;
if (sPath='.') then //当前目录
begin
sPath := FCurrentItemPath;
end
else if (sPath='..') then //上一层目录
begin
if (FCurrentItemPath='') then FCurrentItemPath := '\\';
if FCurrentItemPath<>'\\' then
begin
sPath := FCurrentItemPath;
if sPath[Length(sPath)]='\' then
sPath := Copy(sPath, 1, Length(sPath)-1);
sPath := ExtractFilePath(sPath);
end
else
sPath := FCurrentItemPath;
if (sPath='') then sPath := '\\';
end;
if sPath<>'' then
begin
if sPath[Length(sPath)]<>'\' then sPath := sPath +'\';
FCurrentItemPath := sPath;
end;
if (sPath<>'') and (sPath<>'\\') then
begin
Result.Add('.');
Result.Add('..');
end;
for I:=0 to FItems.Count-1 do
begin
bDir := False;
sTmp := FItems.Strings[I];
if sTmp<>'' then
if sTmp[Length(sTmp)]='\' then
begin
sTmp := Copy(sTmp, 1, Length(sTmp)-1);
bDir := True;
end;
if not IsItemChild(sPath, sTmp) then Continue;
if (iFilter=0)
or ((iFilter=1) and (not bDir))
or ((iFilter=2) and (bDir)) then
Result.Add(sTmp);
end;
end;
function TD7zipFile.LoadFromFile(AFileName: WideString): Boolean;
function FileExtToFileTypes(sExt: WideString): TD7zFileTypes;
begin
Result := [];
if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') then
Include(Result, dftZip)
else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') then
Include(Result, dftBZ2)
else if (sExt='.RAR') or (sExt='.R00') then
Include(Result, dftRar)
else if (sExt='.ARJ') then
Include(Result, dftArj)
else if (sExt='.Z') or (sExt='.TAZ') then
Include(Result, dftZ)
else if (sExt='.LZH') or (sExt='.LHA') then
Include(Result, dftLzh)
else if (sExt='.7Z') then
Include(Result, dft7z)
else if (sExt='.CAB') then
Include(Result, dftCab)
else if (sExt='.NSIS') then
Include(Result, dftNsis) //安装包工具
else if (sExt='.LZMA') or (sExt='.LZMA86') then
Include(Result, dftLzma)
else if (sExt='.EXE') then
begin
Include(Result, dftPe);
Include(Result, dftNsis);
end
else if (sExt='.PE') or (sExt='.DLL') or (sExt='.SYS') then
Include(Result, dftPe)
else if (sExt='.ELF') then
Include(Result, dftElf)
else if (sExt='.MACHO') then
Include(Result, dftMacho)
else if (sExt='.UDF') then
Include(Result, dftUdf)
else if (sExt='.XAR') then
Include(Result, dftXar)
else if (sExt='.MUB') then
Include(Result, dftMub)
else if (sExt='.HFS') or (sExt='.CD') then
Include(Result, dftHfs)
else if (sExt='.DMG') then
Include(Result, dftDmg)
else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') then
Include(Result, dftCompound)
else if (sExt='.WIM') or (sExt='.SWM') then
Include(Result, dftWim)
else if (sExt='.ISO') then
begin
Include(Result, dftIso);
Include(Result, dftUdf);
end
else if (sExt='.BKF') then
Include(Result, dftBkf)
else if (sExt='.CHM') or (sExt='.CHI') or (sExt='.CHQ') or (sExt='.CHW')
or (sExt='.HXS') or (sExt='.HXI') or (sExt='.HXR') or (sExt='.HXQ')
or (sExt='.HXW') or (sExt='.LIT') then
Include(Result, dftChm)
else if (sExt='.001') then
Include(Result, dftSplit)
else if (sExt='.RPM') then
Include(Result, dftRpm)
else if (sExt='.DEB') then
Include(Result, dftDeb)
else if (sExt='.CPIO') then
Include(Result, dftCpio)
else if (sExt='.TAR') then
Include(Result, dftTar)
else if (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') then
Include(Result, dftGZip);
end;
begin
Result := False;
FreeAndNil(FTmpStream);
FTmpStream:=TFileStream.Create(AFileName, fmOpenRead);
try
Result := LoadFromStream(FTmpStream, FileExtToFileTypes(UpperCase(ExtractFileExt(AFileName))));
finally
if not Result then FreeAndNil(FTmpStream);
end;
end;
function TD7zipFile.LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]): Boolean;
var
bUnknowType:Boolean;
AFileType: TD7zFileType;
begin
FInArchive := nil;
Result := False;
try
bUnknowType := AFileTypes=[];
AFileType := Low(TD7zFileType);
while AFileType<High(TD7zFileType) do
begin
if (not Result) and (bUnknowType or (AFileType in AFileTypes)) then
Result := LoadFromStream(AStream, AFileType);
if Result then Break;
Inc(AFileType);
end;
(*
if (not Result) and (bUnknowType or (dftZip in AFileTypes)) then
Result := LoadFromStream(AStream, dftZip);
if (not Result) and (bUnknowType or (dftBZ2 in AFileTypes)) then
Result := LoadFromStream(AStream, dftBZ2);
if (not Result) and (bUnknowType or (dftRar in AFileTypes)) then
Result := LoadFromStream(AStream, dftRar);
if (not Result) and (bUnknowType or (dftArj in AFileTypes)) then
Result := LoadFromStream(AStream, dftArj);
if (not Result) and (bUnknowType or (dftZ in AFileTypes)) then
Result := LoadFromStream(AStream, dftZ);
if (not Result) and (bUnknowType or (dftLzh in AFileTypes)) then
Result := LoadFromStream(AStream, dftLzh);
if (not Result) and (bUnknowType or (dft7z in AFileTypes)) then
Result := LoadFromStream(AStream, dft7z);
if (not Result) and (bUnknowType or (dftCab in AFileTypes)) then
Result := LoadFromStream(AStream, dftCab);
if (not Result) and (bUnknowType or (dftNsis in AFileTypes)) then
Result := LoadFromStream(AStream, dftNsis);
if (not Result) and (bUnknowType or (dftLzma in AFileTypes)) then
Result := LoadFromStream(AStream, dftLzma);
if (not Result) and (bUnknowType or (dftPe in AFileTypes)) then
Result := LoadFromStream(AStream, dftPe);
if (not Result) and (bUnknowType or (dftElf in AFileTypes)) then
Result := LoadFromStream(AStream, dftElf);
if (not Result) and (bUnknowType or (dftMacho in AFileTypes)) then
Result := LoadFromStream(AStream, dftMacho);
if (not Result) and (bUnknowType or (dftUdf in AFileTypes)) then
Result := LoadFromStream(AStream, dftUdf);
if (not Result) and (bUnknowType or (dftXar in AFileTypes)) then
Result := LoadFromStream(AStream, dftXar);
if (not Result) and (bUnknowType or (dftMub in AFileTypes)) then
Result := LoadFromStream(AStream, dftMub);
if (not Result) and (bUnknowType or (dftHfs in AFileTypes)) then
Result := LoadFromStream(AStream, dftHfs);
if (not Result) and (bUnknowType or (dftDmg in AFileTypes)) then
Result := LoadFromStream(AStream, dftDmg);
if (not Result) and (bUnknowType or (dftCompound in AFileTypes)) then
Result := LoadFromStream(AStream, dftCompound);
if (not Result) and (bUnknowType or (dftWim in AFileTypes)) then
Result := LoadFromStream(AStream, dftWim);
if (not Result) and (bUnknowType or (dftIso in AFileTypes)) then
Result := LoadFromStream(AStream, dftIso);
if (not Result) and (bUnknowType or (dftBkf in AFileTypes)) then
Result := LoadFromStream(AStream, dftBkf);
if (not Result) and (bUnknowType or (dftChm in AFileTypes)) then
Result := LoadFromStream(AStream, dftChm);
if (not Result) and (bUnknowType or (dftSplit in AFileTypes)) then
Result := LoadFromStream(AStream, dftSplit);
if (not Result) and (bUnknowType or (dftRpm in AFileTypes)) then
Result := LoadFromStream(AStream, dftRpm);
if (not Result) and (bUnknowType or (dftDeb in AFileTypes)) then
Result := LoadFromStream(AStream, dftDeb);
if (not Result) and (bUnknowType or (dftCpio in AFileTypes)) then
Result := LoadFromStream(AStream, dftCpio);
if (not Result) and (bUnknowType or (dftTar in AFileTypes)) then
Result := LoadFromStream(AStream, dftTar);
if (not Result) and (bUnknowType or (dftGZip in AFileTypes)) then
Result := LoadFromStream(AStream, dftGZip);
*)
except
FInArchive := nil;
end;
end;
function TD7zipFile.LoadFromStream(AStream: TStream;
AFileType: TD7zFileType): Boolean;
var
iIndex, I: Integer;
zStream: IInStream;//T7zStream;
sTmp, sTmpDir: WideString;
iPos: Int64;
sTmpDirListAdd, sTmpDirList: TD7zipStrings;
begin
Result := False;
FInArchive := nil;
FCurrentItemPath := '\\';
FItems.Clear;
iPos := AStream.Position;
case AFileType of
dftZip : FInArchive:= CreateInArchive(CLSID_CFormatZip);
dftBZ2 : FInArchive:= CreateInArchive(CLSID_CFormatBZ2);
dftRar : FInArchive:= CreateInArchive(CLSID_CFormatRar);
dftArj : FInArchive:= CreateInArchive(CLSID_CFormatArj);
dftZ : FInArchive:= CreateInArchive(CLSID_CFormatZ);
dftLzh : FInArchive:= CreateInArchive(CLSID_CFormatLzh);
dft7z : FInArchive:= CreateInArchive(CLSID_CFormat7z);
dftCab : FInArchive:= CreateInArchive(CLSID_CFormatCab);
dftNsis : FInArchive:= CreateInArchive(CLSID_CFormatNsis);
dftLzma : FInArchive:= CreateInArchive(CLSID_CFormatLzma);
dftPe : FInArchive:= CreateInArchive(CLSID_CFormatPe);
dftElf : FInArchive:= CreateInArchive(CLSID_CFormatElf);
dftMacho : FInArchive:= CreateInArchive(CLSID_CFormatMacho);
dftUdf : FInArchive:= CreateInArchive(CLSID_CFormatUdf);
dftXar : FInArchive:= CreateInArchive(CLSID_CFormatXar);
dftMub : FInArchive:= CreateInArchive(CLSID_CFormatMub);
dftHfs : FInArchive:= CreateInArchive(CLSID_CFormatHfs);
dftDmg : FInArchive:= CreateInArchive(CLSID_CFormatDmg);
dftCompound : FInArchive:= CreateInArchive(CLSID_CFormatCompound);
dftWim : FInArchive:= CreateInArchive(CLSID_CFormatWim);
dftIso : FInArchive:= CreateInArchive(CLSID_CFormatIso);
dftBkf : FInArchive:= CreateInArchive(CLSID_CFormatBkf);
dftChm : FInArchive:= CreateInArchive(CLSID_CFormatChm);
dftSplit : FInArchive:= CreateInArchive(CLSID_CFormatSplit);
dftRpm : FInArchive:= CreateInArchive(CLSID_CFormatRpm);
dftDeb : FInArchive:= CreateInArchive(CLSID_CFormatDeb);
dftCpio : FInArchive:= CreateInArchive(CLSID_CFormatCpio);
dftTar : FInArchive:= CreateInArchive(CLSID_CFormatTar);
dftGZip : FInArchive:= CreateInArchive(CLSID_CFormatGZip);
else
Exit;
end;
zStream := T7zStream.Create(AStream);
try
FInArchive.OpenStream(zStream);
FInArchive.SetPasswordCallback(Self, FPasswordCallback);
FInArchive.SetProgressCallback(Self, FProgressCallback);
sTmpDirListAdd := TD7zipStringList.Create;
sTmpDirList := TD7zipStringList.Create;
try
for I:=0 to FInArchive.NumberOfItems-1 do
begin
sTmp := FInArchive.ItemPath[I];
if FInArchive.ItemIsFolder[I] then
begin
if (sTmp<>'') and (sTmp[Length(sTmp)]<>'\') then
sTmp := sTmp+'\';
if sTmpDirList.IndexOf(sTmp)=-1 then
sTmpDirList.Add(sTmp);
//else //已添加到临时列表则需要删除
begin
iIndex := sTmpDirListAdd.IndexOf(sTmp);
if iIndex>-1 then
sTmpDirListAdd.Delete(iIndex);
end;
end
else
begin
sTmpDir := ExtractFilePath(sTmp);
if sTmpDirList.IndexOf(sTmpDir)=-1 then
begin //未添加的文件夹需要添加到临时列表里
if sTmpDirListAdd.IndexOf(sTmpDir)=-1 then
sTmpDirListAdd.Add(sTmpDir);
end;
end;
FItems.Add(sTmp);
end;
FItems.AddStrings(sTmpDirListAdd);
finally
sTmpDirList.Free;
sTmpDirListAdd.Free;
zStream := nil;
end;
Result := True;
except
zStream := nil;
FInArchive := nil;
AStream.Position := iPos;
end;
end;
{ TD7zipStringList }
constructor TD7zipStringList.Create;
begin
Self.CaseSensitive := False;//忽略大小写
end;
end.
