babaev-an/JarUnPacker
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

20230202

Browse Source
This commit is contained in:
Alexander
2023-02-02 12:02:14 +03:00
parent 703d2d5a52
commit 8e2f0fdd9c
94 changed files with 25754 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

299
prereq/fwzip/Demos/PerfomanceTest/__history/Unit1.pas;2 Normal file
View File

@@ -0,0 +1,299 @@
////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Project : FWZip - FWZipPerfomance
// * Purpose : Тестирование производительности FWZip
// * Author : Александр (Rouse_) Багель
// * Copyright : © Fangorn Wizards Lab 1998 - 2013.
// * Version : 1.0.10
// * Home Page : http://rouse.drkb.ru
// * Home Blog : http://alexander-bagel.blogspot.ru
// ****************************************************************************
// * Stable Release : http://rouse.drkb.ru/components.php#fwzip
// * Latest Source : https://github.com/AlexanderBagel/FWZip
// ****************************************************************************
//
// Используемые источники:
// ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
// http://zlib.net/zlib-1.2.5.tar.gz
// http://www.base2ti.com/
//
unit Unit1;
{$MODE Delphi}
interface
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_DEPRECATED OFF}
{$WARN UNIT_PLATFORM OFF}
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, FileCtrl, ComCtrls, FileUtil,
FWZipWriter, FWZipReader, FWZipConsts, Contnrs;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
LabeledEdit1: TLabeledEdit;
Button1: TButton;
CheckBox1: TCheckBox;
LabeledEdit2: TLabeledEdit;
Button2: TButton;
GroupBox2: TGroupBox;
LabeledEdit3: TLabeledEdit;
Button3: TButton;
CheckBox2: TCheckBox;
LabeledEdit4: TLabeledEdit;
Button4: TButton;
OpenDialog1: TOpenDialog;
GroupBox3: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ProgressBar1: TProgressBar;
ProgressBar2: TProgressBar;
Label5: TLabel;
Button5: TButton;
Button6: TButton;
Memo1: TMemo;
procedure CheckBox1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure LabeledEdit1Change(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure LabeledEdit3Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
InitialHeapSize, MaxHeapSize, AverageHeapSize: Int64;
TotalGetHeapStatusCount: Integer;
StopProcess: Boolean;
procedure OnProgress(Sender: TObject; const FileName: string;
Percent, TotalPercent: Byte; var Cancel: Boolean;
ProgressState: TProgressState);
procedure UpdateMemoryStatus;
procedure SetEnabledState(Value: Boolean);
procedure ClearZipData;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: string;
begin
if SelectDirectory('Укажите папку для сжатия', '', Dir) then
LabeledEdit1.Text := Dir;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
I: Integer;
TotalSize: Int64;
Heap: THeapStatus;
TicCount: DWORD;
Item: TFWZipWriterItem;
Writer: TFWZipWriter;
begin
Writer := TFWZipWriter.Create;
try
DeleteFileUTF8(IncludeTrailingPathDelimiter(LabeledEdit1.Text) + 'FWZipTest.zip'); { *Converted from DeleteFile* }
Writer.AddFolder('', LabeledEdit1.Text, '');
TotalSize := 0;
InitialHeapSize := 0;
for I := 0 to Writer.Count - 1 do
begin
Item := Writer[I];
Inc(TotalSize, Item.Size);
Inc(InitialHeapSize, SizeOf(TCentralDirectoryFileHeaderEx));
if LabeledEdit2.Text <> '' then
begin
Item.Password := LabeledEdit2.Text;
Item.NeedDescriptor := True;
end;
end;
Label3.Caption := 'Общее количество элементов: ' + IntToStr(Writer.Count);
Label4.Caption := 'Общий размер элементов: ' + IntToStr(TotalSize);
Writer.OnProgress := OnProgress;
SetEnabledState(False);
try
Heap := GetHeapStatus;
Inc(InitialHeapSize, Heap.Overhead + Heap.TotalAllocated);
MaxHeapSize := 0;
AverageHeapSize := 0;
TotalGetHeapStatusCount := 0;
StopProcess := False;
TicCount := GetTickCount;
Writer.BuildZip(
IncludeTrailingPathDelimiter(LabeledEdit1.Text) + 'FWZipTest.zip');
if TotalGetHeapStatusCount = 0 then
TotalGetHeapStatusCount := 1;
ShowMessage(Format(
'Пиковый расход памяти: %d байт' + sLineBreak +
'Средний расход памяти: %d байт' + sLineBreak +
'Общее время работы: %d секунд',
[MaxHeapSize, AverageHeapSize div TotalGetHeapStatusCount,
(GetTickCount - TicCount) div 1000]));
finally
SetEnabledState(True);
end;
finally
Writer.Free;
ClearZipData;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.Execute then
LabeledEdit3.Text := OpenDialog1.FileName;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
I: Integer;
TotalSize: Int64;
Heap: THeapStatus;
TicCount: DWORD;
Path: string;
Reader: TFWZipReader;
begin
SetLength(Path, MAX_PATH);
Path := LabeledEdit3.Text;
Path := ChangeFileExt(Path, '');
Reader := TFWZipReader.Create;
try
Reader.LoadFromFile(LabeledEdit3.Text);
TotalSize := 0;
for I := 0 to Reader.Count - 1 do
Inc(TotalSize, Reader[I].UncompressedSize);
Label3.Caption := 'Общее количество элементов: ' + IntToStr(Reader.Count);
Label4.Caption := 'Общий размер элементов: ' + IntToStr(TotalSize);
Reader.OnProgress := OnProgress;
if LabeledEdit4.Text <> '' then
Reader.PasswordList.Add(LabeledEdit4.Text);
SetEnabledState(False);
try
Heap := GetHeapStatus;
InitialHeapSize := Heap.Overhead + Heap.TotalAllocated;
MaxHeapSize := 0;
AverageHeapSize := 0;
TotalGetHeapStatusCount := 0;
StopProcess := False;
Memo1.Lines.Clear;
TicCount := GetTickCount;
if TButton(Sender).Tag = 0 then
Reader.ExtractAll(Path)
else
Reader.Check;
if TotalGetHeapStatusCount = 0 then
TotalGetHeapStatusCount := 1;
ShowMessage(Format(
'Пиковый расход памяти: %d байт' + sLineBreak +
'Средний расход памяти: %d байт' + sLineBreak +
'Общее время работы: %d секунд',
[MaxHeapSize, AverageHeapSize div TotalGetHeapStatusCount,
(GetTickCount - TicCount) div 1000]));
finally
SetEnabledState(True);
end;
finally
Reader.Free;
ClearZipData;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
StopProcess := True;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
LabeledEdit2.Enabled := CheckBox1.Checked;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
LabeledEdit4.Enabled := CheckBox2.Checked;
end;
procedure TForm1.ClearZipData;
begin
Label1.Caption := 'Текущий расход памяти: 0 байт';
Label2.Caption := 'Пиковый расход памяти: 0 байт';
Label3.Caption := 'Общее количество элементов: 0';
Label4.Caption := 'Общий размер элементов: 0';
Label5.Caption := '';
end;
procedure TForm1.LabeledEdit1Change(Sender: TObject);
begin
Button2.Enabled := DirectoryExistsUTF8(LabeledEdit1.Text); { *Converted from DirectoryExists* }
end;
procedure TForm1.LabeledEdit3Change(Sender: TObject);
begin
Button4.Enabled := FileExistsUTF8(LabeledEdit3.Text); { *Converted from FileExists* }
end;
procedure TForm1.OnProgress(Sender: TObject; const FileName: string; Percent,
TotalPercent: Byte; var Cancel: Boolean; ProgressState: TProgressState);
const
p: array [TProgressState] of string = ('psStart', 'psInitialization',
'psInProgress', 'psFinalization', 'psEnd', 'psException');
begin
Cancel := StopProcess;
Label5.Caption := Format('(%d) %s', [Percent, FileName]);
ProgressBar1.Position := Percent;
ProgressBar2.Position := TotalPercent;
Memo1.Lines.Add(Format('%s - %s percent %d total %d',
[FileName, P[ProgressState], Percent, TotalPercent]));
UpdateMemoryStatus;
end;
procedure TForm1.SetEnabledState(Value: Boolean);
begin
Button1.Enabled := Value;
Button2.Enabled := Value;
Button3.Enabled := Value;
Button4.Enabled := Value;
Button5.Visible := not Value;
Button6.Enabled := Value;
LabeledEdit1.Enabled := Value;
LabeledEdit2.Enabled := Value;
LabeledEdit3.Enabled := Value;
LabeledEdit4.Enabled := Value;
CheckBox1.Enabled := Value;
CheckBox2.Enabled := Value;
end;
procedure TForm1.UpdateMemoryStatus;
var
HeapStatus: THeapStatus;
HeapSize: Int64;
begin
HeapStatus := GetHeapStatus;
HeapSize := HeapStatus.Overhead + HeapStatus.TotalAllocated;
Dec(HeapSize, InitialHeapSize);
if HeapSize > MaxHeapSize then
MaxHeapSize := HeapSize;
Inc(TotalGetHeapStatusCount);
Inc(AverageHeapSize, HeapSize);
Label1.Caption := 'Текущий расход памяти: ' + IntToStr(HeapSize) + ' байт';
Label2.Caption := 'Пиковый расход памяти: ' + IntToStr(MaxHeapSize) + ' байт';
Application.ProcessMessages;
Application.ProcessMessages;
end;
end.