david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
568 lines
17 KiB
ObjectPascal
568 lines
17 KiB
ObjectPascal
unit UMain;
|
|
|
|
{$I jcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ExtCtrls, ActnList, ComCtrls, ImgList, JclCompression;
|
|
|
|
type
|
|
TFormMain = class(TForm)
|
|
ActionList1: TActionList;
|
|
ActionOpenRO: TAction;
|
|
ActionExtractSelectedRO: TAction;
|
|
ActionExtractAllRO: TAction;
|
|
ActionNewWO: TAction;
|
|
ActionAddFile: TAction;
|
|
ActionAddDirectory: TAction;
|
|
ActionSave: TAction;
|
|
ListView1: TListView;
|
|
OpenDialogArchiveRO: TOpenDialog;
|
|
SaveDialogArchiveWO: TSaveDialog;
|
|
OpenDialogFile: TOpenDialog;
|
|
ProgressBar1: TProgressBar;
|
|
PageControl1: TPageControl;
|
|
TabSheetReadOnly: TTabSheet;
|
|
TabSheetWriteOnly: TTabSheet;
|
|
TabSheetReadWrite: TTabSheet;
|
|
ButtonOpen: TButton;
|
|
ButtonExtractSelected: TButton;
|
|
ButtonExtractAll: TButton;
|
|
ButtonNew: TButton;
|
|
ButtonAddFile: TButton;
|
|
ButtonAddDirectory: TButton;
|
|
ButtonSave: TButton;
|
|
ActionDeleteRW: TAction;
|
|
ActionNewRW: TAction;
|
|
ActionOpenRW: TAction;
|
|
ButtonNewRW: TButton;
|
|
ButtonOpenRW: TButton;
|
|
ButtonDeleteRW: TButton;
|
|
ButtonAddFileRW: TButton;
|
|
ButtonAddDirectoryRW: TButton;
|
|
ButtonExtractSelectedRW: TButton;
|
|
ButtonExtractAllRW: TButton;
|
|
ButtonSaveRW: TButton;
|
|
OpenDialogArchiveRW: TOpenDialog;
|
|
SaveDialogArchiveRW: TSaveDialog;
|
|
ButtonROProperties: TButton;
|
|
ActionProperties: TAction;
|
|
ButtonPropertiesWO: TButton;
|
|
ButtonPropertiesRW: TButton;
|
|
procedure ActionAlwaysEnabled(Sender: TObject);
|
|
procedure ActionExtractSelectedROUpdate(Sender: TObject);
|
|
procedure ActionExtractAllROUpdate(Sender: TObject);
|
|
procedure ActionAddFileUpdate(Sender: TObject);
|
|
procedure ActionAddDirectoryUpdate(Sender: TObject);
|
|
procedure ActionSaveUpdate(Sender: TObject);
|
|
procedure ActionNewWOExecute(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure ActionAddFileExecute(Sender: TObject);
|
|
procedure ActionAddDirectoryExecute(Sender: TObject);
|
|
procedure ActionSaveExecute(Sender: TObject);
|
|
procedure ActionOpenROExecute(Sender: TObject);
|
|
procedure ListView1Data(Sender: TObject; Item: TListItem);
|
|
procedure ActionExtractAllROExecute(Sender: TObject);
|
|
procedure ActionExtractSelectedROExecute(Sender: TObject);
|
|
procedure ActionDeleteRWUpdate(Sender: TObject);
|
|
procedure ActionDeleteRWExecute(Sender: TObject);
|
|
procedure ActionNewRWExecute(Sender: TObject);
|
|
procedure ActionOpenRWExecute(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure ActionPropertiesUpdate(Sender: TObject);
|
|
procedure ActionPropertiesExecute(Sender: TObject);
|
|
private
|
|
FArchive: TJclCompressionArchive;
|
|
procedure CloseArchive;
|
|
procedure ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
|
|
public
|
|
end;
|
|
|
|
var
|
|
FormMain: TFormMain;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
JclAnsiStrings, Sevenzip, FileCtrl,
|
|
UProperties;
|
|
|
|
function FileTimeToString(const FileTime: TFileTime): string;
|
|
var
|
|
LocalFileTime: TFileTime;
|
|
SystemTime: TSystemTime;
|
|
begin
|
|
if FileTimeToLocalFileTime(FileTime, LocalFileTime)
|
|
and FileTimeToSystemTime(LocalFileTime, SystemTime) then
|
|
Result := DateTimeToStr(EncodeDate(SystemTime.wYear, SystemTime.wMonth, SystemTime.wDay)
|
|
+ EncodeTime(SystemTime.wHour, SystemTime.wMinute, SystemTime.wSecond, SystemTime.wMilliseconds))
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TFormMain.ActionAddDirectoryExecute(Sender: TObject);
|
|
var
|
|
Directory: string;
|
|
begin
|
|
if FileCtrl.SelectDirectory('Select directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
|
|
begin
|
|
(FArchive as TJclCompressArchive).AddDirectory(ExtractFileName(Directory), Directory, True, True);
|
|
ListView1.Items.BeginUpdate;
|
|
try
|
|
while ListView1.Items.Count < FArchive.ItemCount do
|
|
ListView1.Items.Add;
|
|
finally
|
|
ListView1.Items.EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionAddDirectoryUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := (FArchive is TJclCompressArchive) and FArchive.MultipleItemContainer;
|
|
end;
|
|
|
|
procedure TFormMain.ActionAddFileExecute(Sender: TObject);
|
|
begin
|
|
if OpenDialogFile.Execute then
|
|
begin
|
|
(FArchive as TJclCompressArchive).AddFile(ExtractFileName(OpenDialogFile.FileName), OpenDialogFile.FileName);
|
|
ListView1.Items.Add;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionAddFileUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := (FArchive is TJclCompressArchive)
|
|
and (FArchive.MultipleItemContainer or (ListView1.Items.Count = 0));
|
|
end;
|
|
|
|
procedure TFormMain.ActionAlwaysEnabled(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := True;
|
|
end;
|
|
|
|
procedure TFormMain.ActionDeleteRWExecute(Sender: TObject);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
for Index := ListView1.Items.Count - 1 downto 0 do
|
|
if ListView1.Items[Index].Selected then
|
|
begin
|
|
(FArchive as TJclUpdateArchive).DeleteItem(Index);
|
|
Break;
|
|
end;
|
|
|
|
ListView1.Items.Count := FArchive.ItemCount;
|
|
ListView1.Invalidate;
|
|
end;
|
|
|
|
procedure TFormMain.ActionDeleteRWUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := (FArchive is TJclUpdateArchive) and (ListView1.SelCount = 1);
|
|
end;
|
|
|
|
procedure TFormMain.ActionExtractAllROExecute(Sender: TObject);
|
|
var
|
|
Directory: string;
|
|
begin
|
|
if FileCtrl.SelectDirectory('Target directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
|
|
begin
|
|
if FArchive is TJclDecompressArchive then
|
|
TJclDecompressArchive(FArchive).ExtractAll(Directory, True)
|
|
else
|
|
if FArchive is TJclUpdateArchive then
|
|
TJclUpdateArchive(FArchive).ExtractAll(Directory, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionExtractAllROUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := (FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive);
|
|
end;
|
|
|
|
procedure TFormMain.ActionExtractSelectedROExecute(Sender: TObject);
|
|
var
|
|
Directory: string;
|
|
Index: Integer;
|
|
begin
|
|
if FileCtrl.SelectDirectory('Target directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
|
|
begin
|
|
for Index := 0 to ListView1.Items.Count - 1 do
|
|
FArchive.Items[Index].Selected := ListView1.Items.Item[Index].Selected;
|
|
|
|
if FArchive is TJclDecompressArchive then
|
|
TJclDecompressArchive(FArchive).ExtractSelected(Directory, True)
|
|
else
|
|
if FArchive is TJclUpdateArchive then
|
|
TJclUpdateArchive(FArchive).ExtractSelected(Directory, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionExtractSelectedROUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := ((FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive))
|
|
and (ListView1.SelCount > 0);
|
|
end;
|
|
|
|
procedure TFormMain.ActionNewWOExecute(Sender: TObject);
|
|
var
|
|
ArchiveFileName, VolumeSizeStr, Password: string;
|
|
AFormat: TJclCompressArchiveClass;
|
|
VolumeSize: Int64;
|
|
Code: Integer;
|
|
begin
|
|
if SaveDialogArchiveWO.Execute then
|
|
begin
|
|
CloseArchive;
|
|
|
|
ArchiveFileName := SaveDialogArchiveWO.FileName;
|
|
|
|
AFormat := GetArchiveFormats.FindCompressFormat(ArchiveFileName);
|
|
|
|
if AFormat <> nil then
|
|
begin
|
|
VolumeSizeStr := '0';
|
|
repeat
|
|
if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then
|
|
Val(VolumeSizeStr, VolumeSize, Code)
|
|
else
|
|
begin
|
|
VolumeSize := 0;
|
|
Code := 0;
|
|
end;
|
|
until Code = 0;
|
|
|
|
InputQuery('Archive password', 'Value', Password);
|
|
|
|
if VolumeSize <> 0 then
|
|
ArchiveFileName := ArchiveFileName + '.%.3d';
|
|
|
|
FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0);
|
|
FArchive.Password := Password;
|
|
FArchive.OnProgress := ArchiveProgress;
|
|
end
|
|
else
|
|
ShowMessage('not a supported format');
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionNewRWExecute(Sender: TObject);
|
|
var
|
|
ArchiveFileName, VolumeSizeStr, Password: string;
|
|
AFormat: TJclUpdateArchiveClass;
|
|
VolumeSize: Int64;
|
|
Code: Integer;
|
|
begin
|
|
if SaveDialogArchiveRW.Execute then
|
|
begin
|
|
CloseArchive;
|
|
|
|
ArchiveFileName := SaveDialogArchiveRW.FileName;
|
|
|
|
AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName);
|
|
|
|
if AFormat <> nil then
|
|
begin
|
|
VolumeSizeStr := '0';
|
|
repeat
|
|
if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then
|
|
Val(VolumeSizeStr, VolumeSize, Code)
|
|
else
|
|
begin
|
|
VolumeSize := 0;
|
|
Code := 0;
|
|
end;
|
|
until Code = 0;
|
|
|
|
InputQuery('Archive password', 'Value', Password);
|
|
|
|
if VolumeSize <> 0 then
|
|
ArchiveFileName := ArchiveFileName + '.%.3d';
|
|
|
|
FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0);
|
|
FArchive.Password := Password;
|
|
FArchive.OnProgress := ArchiveProgress;
|
|
end
|
|
else
|
|
ShowMessage('not a supported format');
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionOpenROExecute(Sender: TObject);
|
|
var
|
|
ArchiveFileName, Password: string;
|
|
AFormat: TJclDecompressArchiveClass;
|
|
SplitArchive: Boolean;
|
|
begin
|
|
if OpenDialogArchiveRO.Execute then
|
|
begin
|
|
CloseArchive;
|
|
|
|
ArchiveFileName := OpenDialogArchiveRO.FileName;
|
|
SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001');
|
|
if SplitArchive then
|
|
ArchiveFileName := ChangeFileExt(ArchiveFileName, '');
|
|
|
|
AFormat := GetArchiveFormats.FindDecompressFormat(ArchiveFileName);
|
|
|
|
if AFormat <> nil then
|
|
begin
|
|
if SplitArchive then
|
|
ArchiveFileName := ArchiveFileName + '.%.3d';
|
|
|
|
InputQuery('Archive password', 'Value', Password);
|
|
|
|
FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive);
|
|
FArchive.Password := Password;
|
|
FArchive.OnProgress := ArchiveProgress;
|
|
|
|
if FArchive is TJclDecompressArchive then
|
|
TJclDecompressArchive(FArchive).ListFiles
|
|
else
|
|
if FArchive is TJclUpdateArchive then
|
|
TJclUpdateArchive(FArchive).ListFiles;
|
|
|
|
ListView1.Items.BeginUpdate;
|
|
try
|
|
while ListView1.Items.Count < FArchive.ItemCount do
|
|
ListView1.Items.Add;
|
|
finally
|
|
ListView1.Items.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
ShowMessage('not a supported format');
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionOpenRWExecute(Sender: TObject);
|
|
var
|
|
ArchiveFileName, Password: string;
|
|
AFormat: TJclUpdateArchiveClass;
|
|
SplitArchive: Boolean;
|
|
begin
|
|
if OpenDialogArchiveRW.Execute then
|
|
begin
|
|
CloseArchive;
|
|
|
|
ArchiveFileName := OpenDialogArchiveRW.FileName;
|
|
SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001');
|
|
if SplitArchive then
|
|
ArchiveFileName := ChangeFileExt(ArchiveFileName, '');
|
|
|
|
AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName);
|
|
|
|
if AFormat <> nil then
|
|
begin
|
|
if SplitArchive then
|
|
ArchiveFileName := ArchiveFileName + '.%.3d';
|
|
|
|
InputQuery('Archive password', 'Value', Password);
|
|
|
|
FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive);
|
|
FArchive.Password := Password;
|
|
FArchive.OnProgress := ArchiveProgress;
|
|
|
|
if FArchive is TJclDecompressArchive then
|
|
TJclDecompressArchive(FArchive).ListFiles
|
|
else
|
|
if FArchive is TJclUpdateArchive then
|
|
TJclUpdateArchive(FArchive).ListFiles;
|
|
|
|
ListView1.Items.BeginUpdate;
|
|
try
|
|
while ListView1.Items.Count < FArchive.ItemCount do
|
|
ListView1.Items.Add;
|
|
finally
|
|
ListView1.Items.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
ShowMessage('not a supported format');
|
|
end;
|
|
end;
|
|
|
|
procedure TFormMain.ActionPropertiesExecute(Sender: TObject);
|
|
begin
|
|
TFormArchiveSettings.Execute(FArchive);
|
|
end;
|
|
|
|
procedure TFormMain.ActionPropertiesUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := Assigned(FArchive);
|
|
end;
|
|
|
|
procedure TFormMain.ActionSaveExecute(Sender: TObject);
|
|
begin
|
|
(FArchive as TJclCompressArchive).Compress;
|
|
CloseArchive;
|
|
end;
|
|
|
|
procedure TFormMain.ActionSaveUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := (FArchive is TJclCompressArchive) and (ListView1.Items.Count > 0);
|
|
end;
|
|
|
|
procedure TFormMain.ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
|
|
var
|
|
MyValue, MyMaxValue: Int64;
|
|
begin
|
|
MyValue := Value;
|
|
MyMaxValue := MaxValue;
|
|
|
|
while MyMaxValue > High(Word) do
|
|
begin
|
|
MyMaxValue := MyMaxValue shr 8;
|
|
MyValue := MyValue shr 8;
|
|
end;
|
|
ProgressBar1.Max := MyMaxValue;
|
|
ProgressBar1.Position := MyValue;
|
|
end;
|
|
|
|
procedure TFormMain.CloseArchive;
|
|
begin
|
|
FreeAndNil(FArchive);
|
|
ListView1.Items.Clear;
|
|
end;
|
|
|
|
procedure TFormMain.FormCreate(Sender: TObject);
|
|
procedure MergeFilters(var AFilter, AllExtensions: string; AFormat: TJclCompressionArchiveClass);
|
|
var
|
|
AName, AExtensions: string;
|
|
begin
|
|
AName := AFormat.ArchiveName;
|
|
AExtensions := AFormat.ArchiveExtensions;
|
|
if AFilter = '' then
|
|
AFilter := Format('%0:s (%1:s)|%1:s', [AName, AExtensions])
|
|
else
|
|
AFilter := Format('%0:s|%1:s (%2:s)|%2:s', [AFilter, AName, AExtensions]);
|
|
if AllExtensions = '' then
|
|
AllExtensions := AExtensions
|
|
else
|
|
AllExtensions := Format('%s;%s', [AllExtensions, AExtensions]);
|
|
end;
|
|
function AddStandardFilters(const AFilter, AllExtensions: string): string;
|
|
begin
|
|
if AFilter = '' then
|
|
Result := ''
|
|
else
|
|
Result := Format('All supported formats|(%0:s)|%1:s', [AllExtensions, AFilter]);
|
|
end;
|
|
var
|
|
AFilter, AllExtensions: string;
|
|
AFormats: TJclCompressionArchiveFormats;
|
|
Index: Integer;
|
|
begin
|
|
AFormats := GetArchiveFormats;
|
|
|
|
AFilter := '';
|
|
AllExtensions := '';
|
|
for Index := 0 to AFormats.CompressFormatCount - 1 do
|
|
MergeFilters(AFilter, AllExtensions, AFormats.CompressFormats[Index]);
|
|
SaveDialogArchiveWO.Filter := AFilter;
|
|
|
|
AFilter := '';
|
|
AllExtensions := '';
|
|
for Index := 0 to AFormats.UpdateFormatCount - 1 do
|
|
MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]);
|
|
SaveDialogArchiveRW.Filter := AFilter;
|
|
|
|
AFilter := '';
|
|
AllExtensions := '';
|
|
for Index := 0 to AFormats.DecompressFormatCount - 1 do
|
|
MergeFilters(AFilter, AllExtensions, AFormats.DecompressFormats[Index]);
|
|
OpenDialogArchiveRO.Filter := AddStandardFilters(AFilter, AllExtensions);
|
|
|
|
AFilter := '';
|
|
AllExtensions := '';
|
|
for Index := 0 to AFormats.UpdateFormatCount - 1 do
|
|
MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]);
|
|
OpenDialogArchiveRW.Filter := AddStandardFilters(AFilter, AllExtensions);
|
|
end;
|
|
|
|
procedure TFormMain.FormDestroy(Sender: TObject);
|
|
begin
|
|
CloseArchive;
|
|
end;
|
|
|
|
procedure TFormMain.ListView1Data(Sender: TObject; Item: TListItem);
|
|
var
|
|
CompressionItem: TJclCompressionItem;
|
|
begin
|
|
if not Assigned(FArchive) then
|
|
begin
|
|
Item.Caption := '';
|
|
Item.SubItems.Clear;
|
|
Exit;
|
|
end;
|
|
|
|
CompressionItem := FArchive.Items[Item.Index];
|
|
|
|
Item.Caption := CompressionItem.FileName;
|
|
Item.SubItems.Clear;
|
|
if ipPackedName in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.PackedName)
|
|
else
|
|
if ipPackedExtension in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add('(Extension)' + CompressionItem.PackedExtension)
|
|
else
|
|
Item.SubItems.Add('(Auto)');
|
|
if ipFileSize in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(IntToStr(CompressionItem.FileSize))
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipPackedSize in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(IntToStr(CompressionItem.PackedSize))
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipCreationTime in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(FileTimeToString(CompressionItem.CreationTime))
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipLastAccessTime in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(FileTimeToString(CompressionItem.LastAccessTime))
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipLastWriteTime in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(FileTimeToString(CompressionItem.LastWriteTime))
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipComment in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.Comment)
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipHostOS in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.HostOS)
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipHostFS in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.HostFS)
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipUser in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.User)
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipGroup in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(CompressionItem.Group)
|
|
else
|
|
Item.SubItems.Add('');
|
|
if ipCRC in CompressionItem.ValidProperties then
|
|
Item.SubItems.Add(IntToHex(CompressionItem.CRC, 8))
|
|
else
|
|
Item.SubItems.Add('');
|
|
end;
|
|
|
|
initialization
|
|
|
|
if not Load7Zip then
|
|
raise EJclCompressionError.Create('Cannot load sevenzip library');
|
|
|
|
end.
|