300 lines
9.2 KiB
Plaintext
300 lines
9.2 KiB
Plaintext
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// ****************************************************************************
|
|
// * 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.
|