|
本帖最后由 2011mking 于 2014-7-30 09:50 编辑
网上找的这个单元调用7z.dll可以实现压缩与解压。
sevenzip.rar
(9.98 KB, 下载次数: 111)
调用时uses sevenzip;
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 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);
SevenZipSetCompressionMethod(Arch, 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;
只能解压、压缩,无法打包成自解压。
配合这个版本的7z.dll 没问题,其它的没测过
7zdll.rar
(273.38 KB, 下载次数: 100)
|
|