const
WM_SYNC_ARCHIVE_PROGRESS = WM_USER + 153;
procedure TForm1.WMSyncArchiveProgress(
var Message: TMessage);
begin
ProgressBar1.Max :=
Message.LParam;
ProgressBar1.Position :=
Message.WParam;
end;
procedure TForm1.JclCompressionArchiveProgress(Sender: TObject;
const Value, MaxValue: Int64);
var
MyValue, MyMaxValue: Int64;
begin
MyValue := Value;
MyMaxValue := MaxValue;
while MyMaxValue > High(Byte)
do
begin
MyMaxValue := MyMaxValue
shr 8;
MyValue := MyValue
shr 8;
end;
PostMessage(
Handle, WM_SYNC_ARCHIVE_PROGRESS, MyValue, MyMaxValue);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
aFile:
string;
aCompressArchive: TJclCompressionArchive;
aCompressFormat: TJclCompressArchiveClass;
begin
TThread.CreateAnonymousThread(
procedure
begin
aFile := ExtractFilePath(Application.ExeName) + Edit1.Text;
// Edit1 z.B. "Test.7z" oder "Test.zip"
aCompressFormat := GetArchiveFormats.FindUpdateFormat(aFile);
if aCompressFormat <>
nil then
begin
Caption := '
Compressing ...';
aCompressArchive := aCompressFormat.Create(aFile);
try
aCompressArchive.OnProgress := JclCompressionArchiveProgress;
aCompressArchive.Password := '
123456';
(aCompressArchive
as TJclCompressArchive).AddFile('
249MB.123', '
E:\7ztest\249MB.123');
(aCompressArchive
as TJclCompressArchive).AddFile('
456.txt', '
E:\7ztest\123\456.txt');
(aCompressArchive
as TJclCompressArchive).AddFile('
456', '
E:\7ztest\456');
if (aCompressArchive.ClassType = JCLCompression.TJcl7zCompressArchive)
or (aCompressArchive.ClassType = JCLCompression.TJcl7zUpdateArchive)
then
begin
ShowMessage('
7z');
// - SetEncryptionMethod for 7z not available
(aCompressArchive
as TJcl7zUpdateArchive).SetCompressionLevel(6);
// 0 .. 9
(aCompressArchive
as TJcl7zUpdateArchive).SetCompressHeader(True);
if aCompressArchive.Password <> '
'
then
(aCompressArchive
as TJcl7zUpdateArchive).SetEncryptHeader(True);
end
else if (aCompressArchive.ClassType = JCLCompression.TJclZIPCompressArchive)
or (aCompressArchive.ClassType = JCLCompression.TJclZipUpdateArchive)
then
begin
ShowMessage('
zip');
// - SetEncryptHeader/SetCompressHeader for zip not available
(aCompressArchive
as TJclZipUpdateArchive).SetNumberOfPasses(3);
(aCompressArchive
as TJclZipUpdateArchive).SetCompressionLevel(7);
// 0 .. 9
(aCompressArchive
as TJclZipUpdateArchive).SetCompressionMethod(TJclCompressionMethod.cmDeflate);
if aCompressArchive.Password <> '
'
then
(aCompressArchive
as TJclZipUpdateArchive).SetEncryptionMethod(emAES256);
// emNone, emAES128, emAES192, emAES256, emZipCrypto
end
else if (aCompressArchive.ClassType = JCLCompression.TJclGZipCompressArchive)
or (aCompressArchive.ClassType = JCLCompression.TJclGZipUpdateArchive)
then
begin
ShowMessage('
Gzip');
(aCompressArchive
as TJclGZipUpdateArchive).SetCompressionLevel(7);
// 0 .. 9
(aCompressArchive
as TJclGZipUpdateArchive).SetNumberOfPasses(3);
end
else
FreeAndNil(aCompressArchive);
if aCompressArchive <>
nil then
(aCompressArchive
as TJclCompressArchive).Compress;
// Funktioniert bei Gzip noch nicht
finally
FreeAndNil(aCompressArchive);
Caption := '
Done';
end;
end;
end).Start;
end;