登录 用户中心() [退出] 后台管理 注册
   
您的位置: 首页 >> SoftHub关联区 >> 主题: [lazarus/delphi]lazarus 如何操纵zip文件? [未测试]     [回主站]     [分站链接]
[lazarus/delphi]lazarus 如何操纵zip文件? [未测试]
clq
浏览(375) - 2020-05-27 12:34:56 发表 编辑

关键字: lazarus

[2025-02-20 01:09:13 最后更新]
[lazarus/delphi]lazarus 如何操纵zip文件? [未测试]

另,可参考
https://wiki.freepascal.org/paszlib

//--------------------------------------------------------
//已知问题:
1.对字节超过的情况会直接报错。兼容性不如 winrar 。
2.对中文文件名不兼容。解决办法未知。

//--------------------------------------------------------

lazarus 操纵zip文件
banwuban5765 2012-04-11 16:18:00 30


源代码 在 http://wiki.freepascal.org/paszlib 页面中。



uses zipper;

procedure TForm1.Button5Click(Sender: TObject);
var
Zipper: TZipper;
i:integer;
begin
//http://wiki.freepascal.org/paszlib
try
Zipper := TZipper.Create;
Zipper.FileName := 'E:\20120411\zip\zip.zip';
Zipper.Entries.AddFileEntry('E:\20120411\ABCD\zipper.txt','ABCD\zipper1.txt');
Zipper.ZipAllFiles;
showmessage('ok');
finally
Zipper.Free;
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
UnZipper: TUnZipper;
begin
//http://wiki.freepascal.org/paszlib
UnZipper := TUnZipper.Create;
try
UnZipper.FileName := 'E:\20120411\zip\zip.zip';
UnZipper.OutputPath := 'E:\20120411\zip\a';

UnZipper.UnZipAllFiles; //unzip
finally
UnZipper.Free;
end;

end;

转载于:https://www.cnblogs.com/lukisy/archive/2012/04/11/2442550.html

clq  2020-05-27 12:35:21 发表 编辑

paszlib

Deutsch (de) | English (en) | 한국어 (ko) | polski (pl)

paszlib is a Pascal conversion of the standard zlib library: you don't need any external dependencies. It was implemented by Jacques Nomssi Nzali (his old homepage is dead, see a continuation of the project here). It is used in the FCL to implement the TCompressionStream class.

This class lets you compress and decompress .zip files.

The main unit of this package is paszlib. There are other, auxiliary units, but the only unit that needs to be included in a typical program is this one.
Contents

1 TZipper
1.1 Documentation
1.2 Examples
1.2.1 Zip files
1.2.2 Unzip files
1.2.3 Zip files with encoding filenames
1.2.4 Unzip files with encoding filenames
1.2.5 Unzip file to a stream
1.2.6 Zipping a whole directory tree
1.2.7 Zipping a whole directory tree storing only a relative path
1.3 See also

TZipper

TZipper implements support for compressing and decompressing .zip files, but does not support all zip compression methods.
Documentation

See official FPC documentation for Zipper
Examples
Zip files

Create a zip file named as parameter 1. Treats all other parameters as filenames to add, so you can specify e.g.

zipper newzip.zip autoexec.bat config.sys

uses
Zipper;
var
OurZipper: TZipper;
I: Integer;
begin
OurZipper := TZipper.Create;
try
OurZipper.FileName := ParamStr(1);
for I := 2 to ParamCount do
OurZipper.Entries.AddFileEntry(ParamStr(I), ParamStr(I));
OurZipper.ZipAllFiles;
finally
OurZipper.Free;
end;
end.

Unzip files

Unzip all files in archive c:\test.zip into directory c:\windows\temp\

uses
Zipper;
var
UnZipper: TUnZipper;
begin
UnZipper := TUnZipper.Create;
try
UnZipper.FileName := 'c:\test.zip';
UnZipper.OutputPath := 'c:\windows\temp';
UnZipper.Examine;
UnZipper.UnZipAllFiles;
finally
UnZipper.Free;
end;
end.

Zip files with encoding filenames

For some contry you need change names of file.

uses
Zipper, LConvEncoding;

function PackFiles(Filename, DirectoryPath: String): Integer;
var
OurZipper :TZipper;
flist :TStringList;
I :Integer;
ADiskFileName,
AArchiveFileName :String;
begin
result:=-1;
DirectoryPath:=includeTrailingPathDelimiter(DirectoryPath);
if DirectoryExists(DirectoryPath) then
begin
OurZipper := TZipper.Create;
flist := TStringList.create;
try
OurZipper.FileName := Filename;
MyGetFileFunction(DirectoryPath,flist);//get files from directory
for I := 0 to flist.Count-1 do
begin
ADiskFileName:=flist.Strings[i];
AArchiveFileName:=StringReplace(flist.Strings[i],DirectoryPath,'',[rfReplaceall]);
AArchiveFileName:=SysToUTF8(AArchiveFileName);
AArchiveFileName:=UTF8ToCP866(AArchiveFileName);
OurZipper.Entries.AddFileEntry(ADiskFileName,AArchiveFileName);
end;
OurZipper.ZipAllFiles;
result:=1;
finally
OurZipper.Free;
flist.Free;
end;
end;
end;

Unzip files with encoding filenames

uses
Zipper, LConvEncoding;
...
function EndPathCP866ToUTF8(AText:string):string;
var
c,i:integer;
s,s1,s2,chr:string;
begin
s:='';
c:=UTF8Length(AText);
for i:=c downto 1 do
begin
chr:=UTF8Copy(AText,i,1);
if ((not(chr='/')) and (not(chr='\')))or(i=c) then
begin
s:=UTF8Copy(AText,i,1)+s;
end
else begin
s:=UTF8Copy(AText,i,1)+s;
break;
end;
end;
dec(i);
s1:=UTF8Copy(AText,1,i);
s2:=CP866ToUTF8(s);
Result:=s1+s2;
end;

function UnPackFiles(Filename, UnPackPath: String): Integer;
var
UnZipper :TUnZipper; //PasZLib
UnPackFileDir,
ADiskFileName,
ANewDiskFileName,
AArchiveFileName :String;
i :integer;
begin
Result:=-1;
if FileExists(Filename)and DirectoryExists(UnPackPath) then
begin
UnPackFileDir :=SysUtils.IncludeTrailingPathDelimiter(UnPackPath);
UnZipper :=TUnZipper.Create;
try
UnZipper.FileName := Filename;
UnZipper.OutputPath := UnPackPath;
UnZipper.Examine;
UnZipper.UnZipAllFiles;

for i:=UnZipper.Entries.Count-1 downto 0 do
begin
AArchiveFileName:=UnZipper.Entries.Entries[i].ArchiveFileName;
AArchiveFileName:=EndPathCP866ToUTF8(AArchiveFileName);
AArchiveFileName:=UTF8ToSys(AArchiveFileName);
ANewDiskFileName:=UnPackFileDir+AArchiveFileName;
ADiskFileName :=UnPackFileDir+UnZipper.Entries.Entries[i].DiskFileName;

if FileExists(ADiskFileName) then
begin
RenameFile(ADiskFileName, ANewDiskFileName);
end
else if DirectoryExists(ADiskFileName) then
begin
ADiskFileName :=SysUtils.IncludeTrailingPathDelimiter(ADiskFileName);
ANewDiskFileName :=SysUtils.IncludeTrailingPathDelimiter(ANewDiskFileName);
RenameFile(ADiskFileName, ANewDiskFileName);
end;
end;

Result:=1;
finally
UnZipper.Free;
end;
end;
end;

More examples can be found in the FPC source directory:

examples: [1]
the test program: [2]

Unzip file to a stream

In Lazarus, drop a TMemo, TButton, TEdit and TFileNameEdit on a form. Clicking the button will read the zip file in FileNameEdit, extract the file specified in the Edit box, and display the content in Memo.

uses
Zipper;

...

procedure TForm1.Button1Click(Sender: TObject);
begin
ExtractFileFromZip(FileNameEdit1.FileName,Edit1.Text);
end;

procedure TForm1.DoCreateOutZipStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry);
begin
AStream:=TMemorystream.Create;
end;

procedure TForm1.DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry);
begin
AStream.Position:=0;
Memo1.lines.LoadFromStream(Astream);
Astream.Free;
end;

procedure TForm1.ExtractFileFromZip(ZipName, FileName: string);
var
ZipFile: TUnZipper;
sl:TStringList;
begin
sl:=TStringList.Create;
sl.Add(FileName);
ZipFile := TUnZipper.Create;
try
ZipFile.FileName := ZipName;
ZipFile.OnCreateStream := @DoCreateOutZipStream;
ZipFile.OnDoneStream:=@DoDoneOutZipStream;
ZipFile.UnZipFiles(sl);
finally
ZipFile.Free;
sl.Free;
end;
end;

Zipping a whole directory tree

This will recursively add the contents of 'C:\MyFolder' to the 'myzipfile.zip'
Note that the absolute path is stored in the zipfile
Note that this requires the Lazarus fileutil unit (which you can probably work around)

Uses ...Zipper,FileUtil
var
AZipper: TZipper;
TheFileList:TStringList;
begin
MyDirectory:='C:\MyFolder';
AZipper := TZipper.Create;
AZipper.Filename := 'myzipfile.zip';
TheFileList:=TStringList.Create;
try
FindAllFiles(TheFileList, MyDirectory);
AZipper.Entries.AddFileEntries(TheFileList);
AZipper.ZipAllFiles;
finally
TheFileList.Free;
AZipper.Free;
end;
end;

Zipping a whole directory tree storing only a relative path

This is more complicated, but it can be done
Note that this requires the Lazarus fileutil unit (which you can probably work around)

Uses ...Zipper,FileUtil,strutils
var
AZipper: TZipper;
szPathEntry:String;
i:Integer;
ZEntries : TZipFileEntries;
TheFileList:TStringList;
RelativeDirectory:String;
begin
AZipper := TZipper.Create;
try
try
AZipper.Filename := 'myzipfile.zip';
RelativeDirectory:='C:\MyFolder\MyFolder\';
AZipper.Clear;
ZEntries := TZipFileEntries.Create(TZipFileEntry);
// Verify valid directory
If DirPathExists(RelativeDirectory) then
begin
// Construct the path to the directory BELOW RelativeDirectory
// If user specifies 'C:\MyFolder\Subfolder' it returns 'C:\MyFolder\'
// If user specifies 'C:\MyFolder' it returns 'C:\'
// If user specifies 'C:\' it returns 'C:\'
i:=RPos(PathDelim,ChompPathDelim(RelativeDirectory));
szPathEntry:=LeftStr(RelativeDirectory,i);

// Use the FileUtils.FindAllFiles function to get everything (files and folders) recursively
TheFileList:=TstringList.Create;
try
FindAllFiles(TheFileList, RelativeDirectory);
for i:=0 to TheFileList.Count -1 do
begin
// Make sure the RelativeDirectory files are not in the root of the ZipFile
ZEntries.AddFileEntry(TheFileList[i],CreateRelativePath(TheFileList[i],szPathEntry));
end;
finally
TheFileList.Free;
end;
end;
if (ZEntries.Count > 0) then
AZipper.ZipFiles(ZEntries);
except
On E: EZipError do
E.CreateFmt('Zipfile could not be created%sReason: %s', [LineEnding, E.Message])
end;
result := True;
finally
FreeAndNil(ZEntries);
AZipper.Free;
end;
end;

Note that this example uses an overloaded version of addfileentry() (compared to simple examples). This version allows you to specify the directory structure inside the Zip file, and, then, of course, the directory structure when its all unzipped. You can, for example, specify only the file name with no directory structure and have all files returned in one flat output directory. Even if they came for all over the place !

ZEntries.AddFileEntry(FullDiskPathToFile, FileName);

See also

official FPC documentation for Zipper
Article demonstrating handling tar, bzip2, gzip, zip files and Blowfish encryption in FreePascal/Lazarus. A good introduction even though it was written some time ago (a lot of functionality has been improved).
unzip
FreePascalArchivePackage Abbrevia archive/zip library
MIT licensed Delphi/Object Pascal library that includes zip file support.

Go back to Packages List


总数:1 页次:1/1 首页 尾页  
总数:1 页次:1/1 首页 尾页  


所在合集/目录



发表评论:
文本/html模式切换 插入图片 文本/html模式切换


附件:



NEWBT官方QQ群1: 276678893
可求档连环画,漫画;询问文本处理大师等软件使用技巧;求档softhub软件下载及使用技巧.
但不可"开车",严禁国家敏感话题,不可求档涉及版权的文档软件.
验证问题说明申请入群原因即可.

Copyright © 2005-2020 clq, All Rights Reserved
版权所有
桂ICP备15002303号-1