2019 lines
61 KiB
Plaintext
2019 lines
61 KiB
Plaintext
unit main;
|
|
{-------------------------------------------------------------------------------
|
|
Main Form
|
|
---------
|
|
the main interface.
|
|
|
|
---------------------------------------------
|
|
reSource v2.6
|
|
Copyright (C) 1998-2001 Victor Kasenda / gruv
|
|
http://go.to/gruv
|
|
email: vickas@singnet.com.sg
|
|
---------------------------------------------
|
|
|
|
|
|
IMPORTANT:
|
|
To learn how to use the component TResource, open the unit ResourceCompUnit.
|
|
There is a detailed description of how to perform Archive Actions.
|
|
This unit, main, implements the descriptions in a full featured archiver.
|
|
|
|
Desc:
|
|
This is the interface portion to ArchiveManager.
|
|
The MainForm show a file list, speed buttons, a status/hint bar and a main menu.
|
|
The user
|
|
- 'sees' the archive from here - what is inside the archive and the file
|
|
properties.
|
|
- performs operations on the archive - add, delete or extract files. File
|
|
properties can also be changed (right click on the FileList)
|
|
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
|
|
(**) interface (**)
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Gauges, ComCtrls, ExtCtrls, Menus, Buttons, ToolWin, ShellApi,
|
|
CommCtrl, ActnList, activex, FileCtrl, Contnrs,
|
|
// engine - include in your app to access TCentralFileHeader etc.
|
|
// your search path must contain the dir the units are located in.
|
|
ResourceCompUnit,
|
|
ArchiveHeadersUnit, ErrorUnit, EDosUnit, ArchiveManagerUnit, StructsUnit;
|
|
|
|
|
|
|
|
|
|
procedure CentreFormToMain(form: TForm);
|
|
|
|
const
|
|
LogLinesLimit = 10000;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
OpenDialog2: TOpenDialog;
|
|
File1: TMenuItem;
|
|
MIExit: TMenuItem;
|
|
N2: TMenuItem;
|
|
MIOpen: TMenuItem;
|
|
MIClose: TMenuItem;
|
|
Help1: TMenuItem;
|
|
MIAbout: TMenuItem;
|
|
View1: TMenuItem;
|
|
MIConfiguration: TMenuItem;
|
|
FileListPopup: TPopupMenu;
|
|
MIProperties: TMenuItem;
|
|
Actions1: TMenuItem;
|
|
MISelectAll: TMenuItem;
|
|
N1: TMenuItem;
|
|
MIAdd: TMenuItem;
|
|
MIExtract: TMenuItem;
|
|
MIDelete: TMenuItem;
|
|
MICompressionStats: TMenuItem;
|
|
miProgStats: TMenuItem;
|
|
StatusBar: TStatusBar;
|
|
MainMenu: TPopupMenu;
|
|
ActionList: TActionList;
|
|
SelectAllAct: TAction;
|
|
OpenDialog: TOpenDialog;
|
|
AddSelectFilesAct: TAction;
|
|
ExtractSelFilesAct: TAction;
|
|
DelSelFilesAct: TAction;
|
|
SetPropertyAct: TAction;
|
|
Properties1: TMenuItem;
|
|
OpenAct: TAction;
|
|
CreateNewAct: TAction;
|
|
CloseAct: TAction;
|
|
CreateNew1: TMenuItem;
|
|
ControlBar1: TControlBar;
|
|
ToolBarPanel: TPanel;
|
|
OpenBtn: TSpeedButton;
|
|
AddBtn: TSpeedButton;
|
|
ExtractBtn: TSpeedButton;
|
|
DeleteBtn: TSpeedButton;
|
|
SpeedButton1: TSpeedButton;
|
|
SpeedButton2: TSpeedButton;
|
|
CompressBtn: TButton;
|
|
DecompressBtn: TButton;
|
|
MenuToolBar: TToolBar;
|
|
ToolButton1: TToolButton;
|
|
ToolButton2: TToolButton;
|
|
ToolButton3: TToolButton;
|
|
ToolButton4: TToolButton;
|
|
FileList: TListView;
|
|
Splitter1: TSplitter;
|
|
RichEdit: TRichEdit;
|
|
Resource1: TResource;
|
|
procedure CompressBtnClick(Sender: TObject);
|
|
procedure DecompressBtnClick(Sender: TObject);
|
|
procedure ExitBtnClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FileListChange(Sender: TObject; Item: TListItem;
|
|
Change: TItemChange);
|
|
procedure MIAboutClick(Sender: TObject);
|
|
procedure MIConfigurationClick(Sender: TObject);
|
|
procedure MIPropertiesClick(Sender: TObject);
|
|
procedure FileListDblClick(Sender: TObject);
|
|
procedure MIDeleteClick(Sender: TObject);
|
|
procedure MISelectAllClick(Sender: TObject);
|
|
procedure MIDeselectAllClick(Sender: TObject);
|
|
procedure FileListColumnClick(Sender: TObject; Column: TListColumn);
|
|
procedure FileListPopupPopup(Sender: TObject);
|
|
procedure MIExitClick(Sender: TObject);
|
|
procedure MICompressionStatsClick(Sender: TObject);
|
|
procedure miProgStatsClick(Sender: TObject);
|
|
procedure Chart1Click(Sender: TObject);
|
|
procedure FileListSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
{procedure FileListMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);}
|
|
{procedure FileListData(Sender: TObject; Item: TListItem);
|
|
procedure FileListDataHint(Sender: TObject; StartIndex,
|
|
EndIndex: Integer);}
|
|
procedure Test(Sender: TObject);
|
|
procedure SelectAllActExecute(Sender: TObject);
|
|
procedure SpeedButton1Click(Sender: TObject);
|
|
procedure Resource1CentralDirChange(Sender: TObject);
|
|
procedure AddSelectFilesActExecute(Sender: TObject);
|
|
procedure ExtractSelFilesActExecute(Sender: TObject);
|
|
procedure DelSelFilesActExecute(Sender: TObject);
|
|
procedure SetPropertyActExecute(Sender: TObject);
|
|
procedure SetPropertyActUpdate(Sender: TObject);
|
|
procedure OpenActExecute(Sender: TObject);
|
|
procedure CreateNewActExecute(Sender: TObject);
|
|
procedure CloseActExecute(Sender: TObject);
|
|
procedure DelSelFilesActUpdate(Sender: TObject);
|
|
procedure SelectAllActUpdate(Sender: TObject);
|
|
procedure Resource1AddLog(Sender: TObject; s: String);
|
|
procedure Button1Click(Sender: TObject);
|
|
private
|
|
TotalSelFileSize: integer; // calculation of selected file size
|
|
ColMan: TObjectList; // manages the columns for FileList
|
|
|
|
{DropSource: TDropFileSource;}
|
|
|
|
// message handlers
|
|
procedure WMMove(var m: TMessage); message WM_MOVE;
|
|
procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
|
|
|
|
procedure EnableArchiveActions(const Enable: boolean);
|
|
procedure EnableFileListSensitiveItems(const Enable: boolean);
|
|
|
|
// event handlers
|
|
{procedure DropSourceDrop(Sender: TObject; DragType: TDragType;
|
|
var ContinueDrop: Boolean);}
|
|
|
|
|
|
// wrapper functions of ArchiveManager
|
|
procedure OpenArchive(const filename: string; const create_new_prompt: boolean);
|
|
procedure CloseArchive;
|
|
|
|
// misc
|
|
//procedure DisplayHint(Sender: TObject);
|
|
procedure GenerateColumns;
|
|
function IsSortedAscending(Column: TListColumn): boolean;
|
|
|
|
// filelist
|
|
procedure GetSelFilesList(list: TList);
|
|
//procedure CacheFileInfo(const startindex, endindex: integer);
|
|
|
|
public
|
|
procedure AddLog(s: string; Color: TColor = clWindowText; Style: TFontStyles = []);
|
|
|
|
// status support (status bar, progress bar)
|
|
procedure ShowStatusMessage(const s: string);
|
|
function GetNumFilesStr(const num: integer): string;
|
|
procedure ShowProgress(const num: integer);
|
|
|
|
// application status. involves the screen cursor
|
|
procedure ShowBusy;
|
|
procedure ShowReady;
|
|
|
|
procedure AddSelectFiles;
|
|
procedure DoAddFiles(FileList: TStrings; const folder: string);
|
|
procedure ExtractFiles;
|
|
procedure DeleteFiles;
|
|
end;
|
|
|
|
{TMyCentralFileHeader = class(TCentralFileHeader)
|
|
private
|
|
function GetShellSmallIconIndex: integer;
|
|
function GetShellTypeName: string;
|
|
protected
|
|
FShellSmallIconIndex: integer;
|
|
FShellTypeName: string;
|
|
procedure FillShellInfo;
|
|
public
|
|
property ShellSmallIconIndex: integer read GetShellSmallIconIndex;
|
|
property ShellTypeName: string read GetShellTypeName;
|
|
constructor Create;
|
|
end;}
|
|
|
|
{Compression stats related functions}
|
|
function GetCompressionRatio(compressed, uncompressed: integer): integer;
|
|
function GetBitsPerByte(compressed, uncompressed: integer): Extended;
|
|
function GetBitsPerByteStr(compressed, uncompressed: integer): string;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
|
|
(**) implementation (**)
|
|
uses DebugFormUnit, ExtractOptionsDlgUnit, AddOptionsDlgUnit, AboutDlgUnit,
|
|
ConfigDlgUnit, FileAttrDlgUnit, ConfigUnit,
|
|
CompressionStatsDlgUnit, ProgStatsDlgUnit;
|
|
|
|
{$R *.DFM}
|
|
|
|
|
|
const
|
|
CreateNewMsg = 'Use Open to Open or Create a new archive';
|
|
|
|
|
|
(*******************************************************************************
|
|
Misc functions
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CentreFormToMain
|
|
----------------
|
|
Places the form in the middle of the main form.
|
|
If it becomes out of the screen, then it is shifted in.
|
|
-------------------------------------------------------------------------------}
|
|
procedure CentreFormToMain(form: TForm);
|
|
var
|
|
NewTop, NewLeft: integer;
|
|
begin
|
|
NewTop := MainForm.Top - ((form.Height - MainForm.Height) div 2);
|
|
NewLeft := MainForm.Left - ((form.Width - MainForm.Width) div 2);
|
|
// check if the form is out of the screen
|
|
// Full screen x and y are used because CYSCREEN does not account for the
|
|
// task bar.
|
|
// the system metrics are always gotten because the user may change resolution
|
|
// while using the program.
|
|
if (NewLeft + form.Width) > Screen.Width then
|
|
NewLeft := GetSystemMetrics(SM_CXFULLSCREEN) - form.Width
|
|
else if (NewLeft < 0) then NewLeft := 0;
|
|
|
|
if (NewTop + form.Height) > Screen.Height then
|
|
NewTop := GetSystemMetrics(SM_CYFULLSCREEN) - form.Height
|
|
else if (NewTop < 0) then NewTop := 0;
|
|
|
|
form.Left := NewLeft;
|
|
form.Top := NewTop;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
GetCompressionRatio
|
|
-------------------
|
|
Returns the compression ratio calculate from compressed and uncompresse
|
|
Notes: The compression ratio is a percentage describing the ratio the file
|
|
has shrunk by i.e. if the compression ratio is 30%, the file is 70% of its
|
|
original size.
|
|
This form of description is used Winzip, Arj and other major archivers.
|
|
-------------------------------------------------------------------------------}
|
|
function GetCompressionRatio(compressed, uncompressed: integer): integer;
|
|
begin
|
|
if Uncompressed > 0 then
|
|
result := 100 - (compressed * 100 div uncompressed)
|
|
else
|
|
result := 0;
|
|
{try
|
|
except
|
|
on EDivByZero do
|
|
result := 0;
|
|
end;}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
GetBitsPerByte
|
|
--------------
|
|
Gives an approximation of the bits per byte for a file.
|
|
The number of bits is rounded to next 8 bits because the exact value is
|
|
not known. It is calculated by multiplying compressed by 8.
|
|
-------------------------------------------------------------------------------}
|
|
function GetBitsPerByte(compressed, uncompressed: integer): extended;
|
|
begin
|
|
try
|
|
if Uncompressed > 0 then
|
|
result := compressed / uncompressed * 8
|
|
else
|
|
result := 0;
|
|
except
|
|
on EInvalidOp do // Div by zero
|
|
result := 0;
|
|
end;
|
|
end;
|
|
|
|
function GetBitsPerByteStr(compressed, uncompressed: integer): string;
|
|
var
|
|
bpb: extended; // bits per byte
|
|
s: string; // result string
|
|
begin
|
|
bpb := GetBitsPerByte(compressed, uncompressed);
|
|
Str(bpb:5:3, s);
|
|
result := s;
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
Column Sort support
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
InverseCompare
|
|
--------------
|
|
Compares Item1 and Item2, and returns the inverse of the result.
|
|
Uses the actual comparison function pointed to by InverseCompareActual to
|
|
do the actual comparison. Then internally reverses the result.
|
|
-------------------------------------------------------------------------------}
|
|
var
|
|
InverseCompareActual: TListSortCompare;
|
|
|
|
function InverseCompare(Item1, Item2: Pointer): Integer;
|
|
var
|
|
d: integer;
|
|
begin
|
|
d := InverseCompareActual(Item1, Item2);
|
|
if (d > 0) then d := -1
|
|
else if (d < 0) then d := 1;
|
|
result := d;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CompareInt
|
|
----------
|
|
Compares two integers a and b.
|
|
Returns:
|
|
1 : a > b
|
|
-1 : a < b
|
|
0 : a = b
|
|
-------------------------------------------------------------------------------}
|
|
function CompareInt(a, b: integer): integer;
|
|
begin
|
|
if a > b then
|
|
result := 1
|
|
else if a < b then
|
|
result := -1
|
|
else
|
|
result := 0;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Various comparison functions
|
|
|
|
Notes:
|
|
The variuos compare function compares a field in Item1 and Item2. Depending
|
|
on the data type of the fields, a different comparison method is used.
|
|
CompareStr: to compare strings
|
|
CompareInt: to compare integers
|
|
-------------------------------------------------------------------------------}
|
|
function NameCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
result := CompareStr(TCentralFileHeader(Item1).filename, TCentralFileHeader(Item2).filename);
|
|
end;
|
|
|
|
function SizeCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
result := CompareInt(TCentralFileHeader(Item1).uncompressed_size, TCentralFileHeader(Item2).uncompressed_size);
|
|
end;
|
|
|
|
function PackedCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
result := CompareInt(TCentralFileHeader(Item1).compressed_size, TCentralFileHeader(Item2).compressed_size);
|
|
end;
|
|
|
|
function RatioCompare(Item1, Item2: Pointer): Integer;
|
|
var
|
|
r1, r2: integer;
|
|
begin
|
|
r1 := GetCompressionRatio(TCentralFileHeader(Item1).compressed_size, TCentralFileHeader(Item1).uncompressed_size);
|
|
r2 := GetCompressionRatio(TCentralFileHeader(Item2).compressed_size, TCentralFileHeader(Item2).uncompressed_size);
|
|
result := CompareInt(r1, r2);
|
|
end;
|
|
|
|
function TimeCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
result := CompareInt(TCentralFileHeader(Item1).Time, TCentralFileHeader(Item2).Time);
|
|
end;
|
|
|
|
function TypeNameCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
{use TMyCentralFileHeader, derived from TCentralFileHeader.
|
|
it adds on ShellTypeName}
|
|
result := CompareStr(TCentralFileHeader(Item1).ShellTypeName, TCentralFileHeader(Item2).ShellTypeName);
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
Column Data Extractor types
|
|
|
|
Desc:
|
|
Each column in the FileList is represented by a class derived from TColDataExtr.
|
|
This makes each column capable of extracting its own data, info (header width,
|
|
header), and sort itself (ListSortCompare).
|
|
|
|
Each child of TColDataExtr
|
|
- assigns its own header, width and ListSortCompare in the Create procedure.
|
|
- overrides the Extract procedure to return the data it exposes in a string
|
|
|
|
To add a new column:
|
|
Derive a new column from TColDataExtr
|
|
Override Create:
|
|
- call the inherited create to give a header title and a width
|
|
- assign a pointer to the compare procedure if any
|
|
Override Extract to return a string for the data
|
|
*******************************************************************************)
|
|
|
|
type
|
|
TColDataExtr = class
|
|
protected
|
|
fheader: string;
|
|
fwidth: integer;
|
|
FListSortCompare: TListSortCompare;
|
|
public
|
|
property header: string read fheader;
|
|
property width: integer read fwidth;
|
|
property ListSortCompare: TListSortCompare read FListSortCompare;
|
|
constructor Create(aheader: string; awidth: integer);
|
|
function Extract(CFH: TCentralFileHeader): string; virtual; abstract;
|
|
end;
|
|
|
|
TNameColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TSizeColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TPackedColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TTimeColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TRatioColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TTypeNameColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TNumBlocksColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
TDataOffsetColDataExtr = class(TColDataExtr)
|
|
public
|
|
constructor Create;
|
|
function Extract(CFH: TCentralFileHeader): string; override;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Column Data Extractors
|
|
-------------------------------------------------------------------------------}
|
|
constructor TColDataExtr.Create;
|
|
begin
|
|
inherited Create;
|
|
fheader := aheader;
|
|
fwidth := awidth;
|
|
FListSortCompare := nil;
|
|
end;
|
|
|
|
constructor TNameColDataExtr.Create;
|
|
begin
|
|
inherited Create('Name', 140);
|
|
FListSortCompare := NameCompare;
|
|
end;
|
|
|
|
function TNameColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := CFH.filename;
|
|
end;
|
|
|
|
constructor TSizeColDataExtr.Create;
|
|
begin
|
|
inherited Create('Size', 100);
|
|
FListSortCompare := SizeCompare;
|
|
end;
|
|
|
|
function TSizeColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := IntToStr(CFH.uncompressed_size);
|
|
end;
|
|
|
|
constructor TPackedColDataExtr.Create;
|
|
begin
|
|
inherited Create('Packed', 100);
|
|
FListSortCompare := PackedCompare;
|
|
end;
|
|
|
|
function TPackedColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := IntToStr(CFH.compressed_size);
|
|
end;
|
|
|
|
constructor TTimeColDataExtr.Create;
|
|
begin
|
|
inherited Create('Time', 120);
|
|
FListSortCompare := TimeCompare;
|
|
end;
|
|
|
|
function TTimeColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := CFH.TimeStr; // info cached
|
|
end;
|
|
|
|
constructor TRatioColDataExtr.Create;
|
|
begin
|
|
inherited Create('Ratio', 50);
|
|
FListSortCompare := RatioCompare;
|
|
end;
|
|
|
|
constructor TTypeNameColDataExtr.Create;
|
|
begin
|
|
inherited Create('Type', 130);
|
|
FListSortCompare := TypeNameCompare;
|
|
end;
|
|
|
|
function TTypeNameColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := CFH.ShellTypeName;
|
|
end;
|
|
|
|
function TRatioColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := IntToStr(GetCompressionRatio(CFH.compressed_size, CFH.uncompressed_size)) + '%';
|
|
end;
|
|
|
|
constructor TNumBlocksColDataExtr.Create;
|
|
begin
|
|
inherited Create('Blocks', 50);
|
|
end;
|
|
|
|
function TNumBlocksColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := IntToStr(CFH.num_blocks);
|
|
end;
|
|
|
|
constructor TDataOffsetColDataExtr.Create;
|
|
begin
|
|
inherited Create('Data', 50);
|
|
end;
|
|
|
|
function TDataOffsetColDataExtr.Extract(CFH: TCentralFileHeader): string;
|
|
begin
|
|
result := IntToStr(CFH.data_offset);
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
TMainForm
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Create/Destroy
|
|
-------------------------------------------------------------------------------}
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
var
|
|
FileInfo: TSHFileInfo;
|
|
ImageListHandle: THandle;
|
|
begin
|
|
{-- IMPORTANT!!! Set parameters for Resource1.ArchiveMan --}
|
|
Resource1.ArchiveMan.TempDir := ConfigMan.temp_dir;
|
|
|
|
{----------------------------------------------------------}
|
|
|
|
// accept dragged files
|
|
DragAcceptFiles(handle, true);
|
|
|
|
Caption := Application.Title;
|
|
//Application.OnHint := DisplayHint;
|
|
ColMan := TObjectList.Create;
|
|
|
|
ImageListHandle := SHGetFileInfo('C:\',
|
|
0,
|
|
FileInfo,
|
|
SizeOf(FileInfo),
|
|
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
|
|
// we only get the handle, so we must assign it manually
|
|
SendMessage(FileList.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, longint(ImageListHandle));
|
|
|
|
{ImageListHandle := SHGetFileInfo('C:\',
|
|
0,
|
|
FileInfo,
|
|
SizeOf(FileInfo),
|
|
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
|
|
SendMessage(FileList.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);}
|
|
|
|
|
|
|
|
{List view}
|
|
ColMan.Add(TNameColDataExtr.Create);
|
|
ColMan.Add(TSizeColDataExtr.Create);
|
|
ColMan.Add(TTypeNameColDataExtr.Create);
|
|
ColMan.Add(TRatioColDataExtr.Create);
|
|
ColMan.Add(TPackedColDataExtr.Create);
|
|
ColMan.Add(TTimeColDataExtr.Create);
|
|
ColMan.Add(TNumBlocksColDataExtr.Create);
|
|
{$IFDEF DEBUG}
|
|
// debug columns
|
|
ColMan.Add(TDataOffsetColDataExtr.Create);
|
|
|
|
{$ENDIF}
|
|
GenerateColumns;
|
|
|
|
// disable archive action buttons in case nothing is opened
|
|
EnableArchiveActions(false);
|
|
EnableFileListSensitiveItems(false);
|
|
|
|
{$IFDEF DEBUG}
|
|
// open an archive by default in debug mode
|
|
// not necessary because can open from param line
|
|
{OpenArchive('c:\ctest\a.rs', true);}
|
|
{$ENDIF}
|
|
|
|
// if the user passed an archive name in the command line, open it.
|
|
if (ParamCount > 0) then
|
|
OpenArchive(ParamStr(1), true);
|
|
end;
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
DragAcceptFiles(handle, false);
|
|
ColMan.Free;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
DisplayHint
|
|
-----------
|
|
Displays the hint in the status bar.
|
|
This is an event handler.
|
|
-------------------------------------------------------------------------------}
|
|
{procedure TMainForm.DisplayHint(Sender: TObject);
|
|
begin
|
|
ShowStatusMessage(Application.Hint);
|
|
end;}
|
|
|
|
{-------------------------------------------------------------------------------
|
|
GenerateColumns
|
|
---------------
|
|
Takes the columns in ColMan and shows it in the FileList
|
|
Desc:
|
|
Creates the various columns (header + width) in the FileList
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.GenerateColumns;
|
|
var
|
|
i: integer;
|
|
ColDataExtr: TColDataExtr;
|
|
begin
|
|
FileList.Columns.Clear;
|
|
for i := 0 to ColMan.Count-1 do
|
|
begin
|
|
ColDataExtr := ColMan[i] as TColDataExtr;
|
|
with FileList.Columns.Add do begin
|
|
Caption := ColDataExtr.header;
|
|
Width := ColDataExtr.Width;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Application Status
|
|
------------------
|
|
|
|
ShowBusy: Shows a 'busy' cursor
|
|
ShowReady: Shows a default cursor, usually an arrow.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.ShowBusy;
|
|
begin
|
|
Screen.Cursor := crHourGlass;
|
|
// allow time to redraw the cursor
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TMainForm.ShowReady;
|
|
begin
|
|
Screen.Cursor := crDefault;
|
|
// allow time to redraw the cursor
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
|
|
(*******************************************************************************
|
|
Button Handler
|
|
--------------
|
|
|
|
Event handlers that handle a button or menu click
|
|
*******************************************************************************)
|
|
|
|
{CompressBtn and DecompressBtn are used during debugging to simplify adding files.
|
|
The buttons are not visible in the release version}
|
|
procedure TMainForm.CompressBtnClick(Sender: TObject);
|
|
var
|
|
FileList: TStringList;
|
|
begin
|
|
Screen.Cursor := crHourGlass;
|
|
|
|
FileList := TStringList.Create;
|
|
FileList.Add('c:\windows\network.txt');
|
|
Resource1.ArchiveMan.AddFiles(FileList, 'c:\ctest\');
|
|
FileList.Free;
|
|
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
|
|
procedure TMainForm.DecompressBtnClick(Sender: TObject);
|
|
begin
|
|
{Screen.Cursor := crHourGlass;
|
|
ArchiveManager.dest_dir := 'c:\ctestout\';
|
|
ArchiveManager.ExtractFile(0);
|
|
Screen.Cursor := crDefault;}
|
|
end;
|
|
|
|
procedure TMainForm.ExitBtnClick(Sender: TObject);
|
|
begin
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Menu Item Handler
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.MICompressionStatsClick(Sender: TObject);
|
|
begin
|
|
CompressionStatsDlg.ShowModal;
|
|
end;
|
|
|
|
procedure TMainForm.MIExitClick(Sender: TObject);
|
|
begin
|
|
CloseArchive;
|
|
Application.Terminate;
|
|
end;
|
|
|
|
procedure TMainForm.MIDeleteClick(Sender: TObject);
|
|
begin
|
|
DeleteFiles;
|
|
end;
|
|
|
|
procedure TMainForm.MISelectAllClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
ListItem: TListItem;
|
|
begin
|
|
for i := 0 to FileList.Items.Count-1 do
|
|
begin
|
|
ListItem := FileList.Items[i];
|
|
ListItem.Selected := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.MIDeselectAllClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
ListItem: TListItem;
|
|
begin
|
|
for i := 0 to FileList.Items.Count-1 do
|
|
begin
|
|
ListItem := FileList.Items[i];
|
|
ListItem.Selected := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.MIConfigurationClick(Sender: TObject);
|
|
begin
|
|
ConfigDlg.ShowModal;
|
|
end;
|
|
|
|
procedure TMainForm.MIAboutClick(Sender: TObject);
|
|
begin
|
|
AboutDlg.ShowModal;
|
|
end;
|
|
|
|
procedure TMainForm.MIPropertiesClick(Sender: TObject);
|
|
begin
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
Message Handling
|
|
*******************************************************************************)
|
|
|
|
procedure TMainForm.WMMove(var m: TMessage);
|
|
begin
|
|
if ConfigMan.ShowDebugForm and ConfigMan.ClipDebugFormToMainForm then
|
|
begin
|
|
DebugForm.Left := Left + Width;
|
|
DebugForm.Top := Top;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
WMDropFiles
|
|
-----------
|
|
Handles the dropping of files into resource
|
|
Creates the file list and passes it to DoAddFiles.
|
|
|
|
If only one file is dropped and this file is a resource archive, then
|
|
it is opened instead of being added. To add reSource archives, use Add.
|
|
|
|
If the archive is not opened, the user will be prompted to open an archive.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.WMDropFiles(var msg : TMessage);
|
|
const
|
|
FNAME_SIZE = 30 * 1024;
|
|
var
|
|
i, n : integer;
|
|
size : integer;
|
|
fname : PChar;
|
|
hdrop : THandle;
|
|
FileList: TStringList;
|
|
begin
|
|
FileList := TStringList.Create;
|
|
// fname must handle long file name and paths
|
|
fname := StrAlloc(FNAME_SIZE);
|
|
// get the drop handle
|
|
hdrop := msg.WParam;
|
|
// find out how many files were dropped by passing $ffff in arg #2
|
|
n := DragQueryFile(hdrop, $FFFFFFFF, nil, 0);
|
|
// loop through, reading in the filenames (w/full paths).
|
|
for i := 0 to (n - 1) do
|
|
begin
|
|
// get the size of the filename string by passing 0 in arg #4
|
|
size := DragQueryFile(hdrop, i, nil, 0);
|
|
// make sure it won't overflow our string (255 char. limit)
|
|
if size < FNAME_SIZE then
|
|
begin
|
|
// get the dropped filename.
|
|
DragQueryFile(hdrop, i, fname, size + 1);
|
|
// add the filename to the file list
|
|
FileList.Add(string(fname));
|
|
end
|
|
else
|
|
ShowError('File name in drag drop too long.');
|
|
end;
|
|
|
|
// if only one file is dropped and this file is a reSource archive, then
|
|
// it is opened instead of being added. To add reSource archives, use Add.
|
|
if (FileList.Count = 1) and
|
|
(UpperCase(ExtractFileExt(FileList[0])) = '.' + Sresource_EXT) then
|
|
OpenArchive(FileList[0], true)
|
|
else
|
|
// pass a nil in folder because all the folder names are included in FileList
|
|
DoAddFiles(FileList, '');
|
|
|
|
|
|
// return zero
|
|
msg.Result := 0;
|
|
// let the inherited message handler (if there is one) go at it
|
|
inherited;
|
|
// free memory
|
|
StrDispose(fname);
|
|
FileList.Free;
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
Support/Wrapper functions
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ShowStatusMessage
|
|
-----------------
|
|
simple wrapper to write a short message to the status bar
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.ShowStatusMessage(const s: string);
|
|
begin
|
|
AddLog(s, clRed);
|
|
StatusBar.SimpleText := s;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
GetNumFilesStr
|
|
--------------
|
|
returns a string containing x + 'file' + 's'|''
|
|
The x could be 'no' or the number of files
|
|
an 's' will be appended if the number of files is greater than 1
|
|
|
|
Notes:
|
|
This is for easy reading on the user's part.
|
|
-------------------------------------------------------------------------------}
|
|
function TMainForm.GetNumFilesStr(const num: integer): string;
|
|
var
|
|
s: string;
|
|
begin
|
|
if (num = 0) then
|
|
s := 'no'
|
|
else
|
|
s := IntToStr(num);
|
|
s := s + ' file';
|
|
if (num <> 1) then
|
|
s := s + 's';
|
|
result := s;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ShowProgress
|
|
------------
|
|
updates the progress bar to reflect the new progress
|
|
|
|
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.ShowProgress(const num: integer);
|
|
begin
|
|
{FileProgressBar.Progress := num;
|
|
Application.ProcessMessages;}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
EnableArchiveActions
|
|
--------------------
|
|
enables items that can only be performed if an archive is opened
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.EnableArchiveActions(const Enable: boolean);
|
|
begin
|
|
CloseAct.Enabled := Enable;
|
|
AddSelectFilesAct.Enabled := Enable;
|
|
MICompressionStats.Enabled := Enable;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
EnableFileListSensitiveItems
|
|
----------------------------
|
|
enable/disable FileList sensitive items
|
|
|
|
Notes:
|
|
These buttons or menu items should only be available if the file list has
|
|
entries
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.EnableFileListSensitiveItems(const Enable: boolean);
|
|
begin
|
|
ExtractSelFilesAct.Enabled := Enable;
|
|
SelectAllAct.Enabled := Enable;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
OpenArchive
|
|
-----------
|
|
enables action items, displays file stats in status bar and opens the archive
|
|
|
|
Notes:
|
|
if file is not opened, the process cleans up and returns to the 'nothing is
|
|
opened' state.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.OpenArchive(const filename: string; const create_new_prompt: boolean);
|
|
begin
|
|
// reset variables for new archive
|
|
TotalSelFileSize := 0;
|
|
|
|
// archive manager
|
|
// close archive if it is currently open
|
|
//if Assigned(Resource1.ArchiveMan) then CloseArchive;
|
|
//ArchiveManager := TArchiveManager.Create;
|
|
//ArchiveManager.OnCentralDirChange := ArchiveManOnCentralDirChange;
|
|
|
|
try
|
|
Resource1.ArchiveMan.OpenArchive(filename, create_new_prompt);
|
|
EnableArchiveActions(true);
|
|
Caption := 'resource - ' + Resource1.ArchiveMan.archive_file_full_path;
|
|
Application.Title := Caption;
|
|
|
|
if (Resource1.ArchiveMan.ArchiveFile.CentralDir.Count = 0) then
|
|
ShowStatusMessage('Archive is empty. Use ''Add'' to add files to the archive.')
|
|
else
|
|
ShowStatusMessage('Archive contains ' + GetNumFilesStr(Resource1.ArchiveMan.ArchiveFile.CentralDir.Count));
|
|
|
|
except
|
|
on EArchiveOpenError do
|
|
begin
|
|
ShowStatusMessage(CreateNewMsg);
|
|
end;
|
|
|
|
on EUserCancel do
|
|
begin
|
|
ShowStatusMessage(CreateNewMsg);
|
|
end;
|
|
|
|
on ESignatureWrong do
|
|
begin
|
|
// the message is already inside. use default exception handler to display
|
|
// the message
|
|
raise ESignatureWrong.Create;
|
|
end;
|
|
|
|
else
|
|
ShowStatusMessage(CreateNewMsg);
|
|
ShowMessage('File cannot be opened.');
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CloseArchive
|
|
------------
|
|
disables action items, clears the status bar and closes the archive
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.CloseArchive;
|
|
begin
|
|
// clear the filename in caption
|
|
Caption := 'Resource';
|
|
Application.Title := Caption;
|
|
// clear the archive file list
|
|
FileList.Items.BeginUpdate;
|
|
FileList.Items.Clear;
|
|
FileLIst.Items.EndUpdate;
|
|
|
|
// disable archive buttons
|
|
EnableArchiveActions(false);
|
|
EnableFileListSensitiveItems(false);
|
|
|
|
Resource1.ArchiveMan.CloseArchive;
|
|
ShowStatusMessage('');
|
|
end;
|
|
|
|
|
|
(*******************************************************************************
|
|
Event handlers
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FormResize
|
|
----------
|
|
Move the DebugForm around with the main form.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FormResize(Sender: TObject);
|
|
begin
|
|
if ConfigMan.ShowDebugForm and ConfigMan.ClipDebugFormToMainForm then
|
|
begin
|
|
DebugForm.Left := Left + Width;
|
|
DebugForm.Top := Top;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FormClose
|
|
---------
|
|
Closes the archive and form.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
CloseArchive;
|
|
Action := caFree;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FileListColumnClick
|
|
-------------------
|
|
Called when a column is clicked
|
|
The colum is sorted. If it is already in ascending order, it is sorted in
|
|
descending order and vice versa.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FileListColumnClick(Sender: TObject;
|
|
Column: TListColumn);
|
|
var
|
|
ListSortCompare: TListSortCompare; // comparison function
|
|
ColDataExtr: TColDataExtr; // entry in ColMan
|
|
sorted_msg: string; // the msg to disp. in the status bar about the sort done.
|
|
begin
|
|
if not Resource1.ArchiveMan.IsArchiveOpen then exit;
|
|
|
|
{Check for Archive File Opened!}
|
|
|
|
// sort the central dir, then update the filelist
|
|
// get the sort function from ColMan
|
|
ColDataExtr := TColDataExtr(ColMan[Column.Index]);
|
|
ListSortCompare := ColDataExtr.ListSortCompare;
|
|
if Assigned(ListSortCompare) then
|
|
begin
|
|
ShowBusy;
|
|
sorted_msg := 'List sorted according to ' + ColDataExtr.header;
|
|
if IsSortedAscending(Column) then
|
|
begin
|
|
// sort inversed
|
|
InverseCompareActual := ListSortCompare;
|
|
ListSortCompare := InverseCompare;
|
|
sorted_msg := sorted_msg + ' inversed';
|
|
end;
|
|
|
|
Resource1.ArchiveMan.ArchiveFile.CentralDir.Sort(ListSortCompare);
|
|
Resource1CentralDirChange(self);
|
|
ShowStatusMessage(sorted_msg);
|
|
ShowReady;
|
|
end
|
|
else
|
|
Application.MessageBox('A sort algorithm is not available for this column', 'Sorry', 0);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FileListPopupPopup
|
|
------------------
|
|
Called when the context sensitive menu for the FileList is called
|
|
Desc:
|
|
Enables the properties menu item depending on whether anything is selected.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FileListPopupPopup(Sender: TObject);
|
|
begin
|
|
// check if the menu items are applicable in the current context
|
|
// if no files are selected, then no file property can be changed
|
|
MIProperties.Enabled := Assigned(FileList.Selected);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FileListChange
|
|
--------------
|
|
event handler. called when certain properties of the file list changes.
|
|
|
|
Desc:
|
|
We capture the change in selected items to calculate the total size of
|
|
the items selected.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FileListChange(Sender: TObject; Item: TListItem;
|
|
Change: TItemChange);
|
|
{var
|
|
ListItem: TListItem;
|
|
CentralFileHeader: TCentralFileHeader;
|
|
TotalSelFileSize: integer;}
|
|
begin
|
|
(* if (Change = ctState) {and (FileList.SelCount <> ns)} then
|
|
begin
|
|
// total up the file size for the items selected
|
|
TotalSelFileSize := 0;
|
|
ListItem := FileList.Selected;
|
|
while (ListItem <> nil) do
|
|
begin
|
|
CentralFileHeader := TCentralFileHeader(ArchiveManager.ArchiveFile.CentralDir[ListItem.Index]);
|
|
inc(TotalSelFileSize, CentralFileHeader.uncompressed_size);
|
|
ListItem := FileList.GetNextItem(ListItem, sdAll, [isSelected]);
|
|
end;
|
|
|
|
ToggleOnSelEnableBtns;
|
|
ShowStatusMessage(GetNumFilesStr(FileList.SelCount) + ' selected. (' + IntToStr(TotalSelFileSize) + ' bytes)');
|
|
end; *)
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FileListDblClick
|
|
----------------
|
|
extracts the selected file
|
|
|
|
Desc:
|
|
When the user double clicks on the file, it is selected and this event
|
|
is called.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.FileListDblClick(Sender: TObject);
|
|
begin
|
|
// extract selected file
|
|
// same as selecting the file then pressing extract
|
|
if Assigned(FileList.Selected) then
|
|
begin
|
|
ExtractSelFilesActExecute(Self);
|
|
end;
|
|
end;
|
|
|
|
|
|
(*******************************************************************************
|
|
Common procedures of Buttons and Menus
|
|
--------------------------------------
|
|
The buttons and menus may have similar entries like 'add', 'delete' and 'extract'.
|
|
They will therefore perform the same function so a common procedure for the
|
|
action is used.
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
AddSelFiles
|
|
-----------
|
|
Shows the AddOptionsDlg to allow user to select files to add. If OK, then
|
|
adds the selected files to the archive.
|
|
|
|
Desc:
|
|
Shows the progress bar, calculates stats.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.AddSelectFiles;
|
|
var
|
|
i: integer; // counter
|
|
SelFiles: TStringList; // list of files to add
|
|
folder: string; // folder of the files to add
|
|
begin
|
|
// show the AddOptionsDlg to select files to add then add it
|
|
AddOptionsDlg.archive_file_folder := Resource1.ArchiveMan.archive_file_folder;
|
|
AddOptionsDlg.archive_file_name := Resource1.ArchiveMan.archive_file_name;
|
|
if (AddOptionsDlg.ShowModal = mrOK) then
|
|
begin
|
|
// this code is for TFileListBox (win 3.1)
|
|
// create the list of selected files by scanning through the items in
|
|
// FileListBox. If the item is selected, then add it to SelFiles.
|
|
ShowBusy;
|
|
SelFiles := TStringList.Create;
|
|
try
|
|
with AddOptionsDlg.FileListBox do
|
|
begin
|
|
// folder of files to add
|
|
folder := AddOptionsDlg.FileListBox.Directory;
|
|
EDos.AddSlash(folder);
|
|
|
|
// build list of selected files
|
|
for i := 0 to Items.Count-1 do
|
|
if Selected[i] then
|
|
SelFiles.Add(Items[i]);
|
|
end;
|
|
|
|
DoAddFiles(SelFiles, folder);
|
|
finally
|
|
// free up any allocated memory
|
|
SelFiles.Free;
|
|
ShowReady;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
DoAddFiles
|
|
----------
|
|
Wrapper for ArchiveManager AddFiles. Used by Drag drop handler and AddSelFiles.
|
|
Handles the showing and hiding of the file progress bar.
|
|
|
|
Checks if an archive is open and opens one. User may drag drop without
|
|
checking that an archive is open.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.DoAddFiles(FileList: TStrings; const folder: string);
|
|
var
|
|
files_added: integer;
|
|
begin
|
|
//PageControl.ActivePageIndex := 1; // focus the log page
|
|
AddLog('--ADD FILES', clRed);
|
|
|
|
// if archive is not opened, open one
|
|
{if (ArchiveManager = nil) then
|
|
begin
|
|
Application.MessageBox('You have not opened an archive. Please open one first.', 'Error', 0);
|
|
MIOpenClick(Self); // help user click the open menu item
|
|
end;}
|
|
|
|
// call ArchiveManager to do the actual addition of files
|
|
// result it the number of files added
|
|
files_added := 0;
|
|
//FileProgressBar.Visible := true;
|
|
try
|
|
files_added := Resource1.ArchiveMan.AddFiles(FileList, folder);
|
|
finally
|
|
//FileProgressBar.Visible := false;
|
|
ShowStatusMessage(GetNumFilesStr(files_added) + ' added');
|
|
end;
|
|
{end
|
|
else
|
|
ShowStatusMessage('No archive open.');}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ExtractFiles
|
|
------------
|
|
Desc:
|
|
Shows the extract dialog and extracts files.
|
|
User can select:
|
|
- destination dir
|
|
- files to extract. all/selected
|
|
|
|
Shows the progress bar, calculates stats.
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.ExtractFiles;
|
|
var
|
|
i, // counter
|
|
files_extracted, // number of files extracted
|
|
extracted_size: integer; // total size of files extracted
|
|
//indexlist: TIndexList;
|
|
List: TList; // list of files to extract
|
|
begin
|
|
//PageControl.ActivePageIndex := 1;
|
|
|
|
// Show the ExtractOptionsDlg
|
|
// set default options:
|
|
// - extract selected files if files are selected
|
|
// then let user change options.
|
|
with ExtractOptionsDlg do
|
|
begin
|
|
if (FileList.SelCount = 0) then
|
|
begin
|
|
RBExtractAllFiles.Checked := true;
|
|
RBExtractSelectedFiles.Enabled := false;
|
|
end
|
|
else
|
|
begin
|
|
RBExtractSelectedFiles.Enabled := true;
|
|
RBExtractSelectedFiles.Checked := true;
|
|
end;
|
|
end;
|
|
|
|
if (ExtractOptionsDlg.ShowModal = mrOK) then
|
|
begin
|
|
AddLog('--EXTRACT', clRed);
|
|
// make progress bar visible
|
|
//FileProgressBar.Visible := true;
|
|
|
|
with Resource1.ArchiveMan, ExtractOptionsDlg do
|
|
begin
|
|
// get the destination directory from the extract options dialog
|
|
dest_dir := ExtractOptionsDlg.ExtractDir;
|
|
// ensure the directory can be used
|
|
EDos.AddSlash(dest_dir);
|
|
// use_folder_names is not supported because the interface has not been
|
|
// implemented
|
|
use_folder_names := false;
|
|
end;
|
|
|
|
// build list of files to extract in ExtractList
|
|
List := TList.Create;
|
|
if (ExtractOptionsDlg.RBExtractAllFiles.Checked) then // extract all files?
|
|
begin
|
|
// the user wants to extract all files, transfer all file indexes into
|
|
// indexlist
|
|
{SetLength(indexlist, FileList.Items.Count);
|
|
for i := 0 to FileList.Items.Count-1 do
|
|
indexlist[i] := i;}
|
|
for i := 0 to FileList.Items.Count-1 do
|
|
List.Add(Resource1.ArchiveMan.ArchiveFile.CentralDir[i]);
|
|
end
|
|
else
|
|
begin
|
|
// user wants to extract selected files
|
|
//GetSelFilesIndexes(indexlist);
|
|
GetSelFilesList(List);
|
|
end;
|
|
|
|
// call archivemanager to do the extraction
|
|
ShowBusy;
|
|
files_extracted := 0;
|
|
extracted_size := 0;
|
|
try
|
|
//ArchiveManager.ExtractIndexes(indexlist, files_extracted, extracted_size);
|
|
Resource1.ArchiveMan.ExtractList(List, files_extracted, extracted_size);
|
|
finally
|
|
List.Free;
|
|
//indexlist := nil;
|
|
// hide progress bar
|
|
//FileProgressBar.Visible := false;
|
|
// display the done message in status bar
|
|
ShowStatusMessage('Extracted ' + GetNumFilesStr(files_extracted) + ' (' + IntToStr(extracted_size) + ' bytes)');
|
|
ShowReady;
|
|
end;
|
|
|
|
end; {ExtractOptionsDlg mrOK}
|
|
end;
|
|
|
|
(*
|
|
{-------------------------------------------------
|
|
ExtractFile
|
|
Wrapper function for ArchiveManager.ExtractFile
|
|
Does additional stats collection
|
|
--------------------------------------------------}
|
|
procedure ExtractFile(idx: integer);
|
|
var
|
|
CentralFileHeader: TCentralFileHeader;
|
|
begin
|
|
CentralFileHeader := TCentralFileHeader(ArchiveManager.ArchiveFile.CentralDir[idx]);
|
|
|
|
try
|
|
ArchiveManager.ExtractFile(idx);
|
|
inc(files_extracted);
|
|
inc(total_size, CentralFileHeader.uncompressed_size);
|
|
except
|
|
on EFileNotExtracted do begin {nothing} end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
// set options for ExtractOptionsDlg
|
|
// extract selected files if files are selected
|
|
with ExtractOptionsDlg do
|
|
begin
|
|
if (FileList.SelCount = 0) then
|
|
begin
|
|
RBExtractAllFiles.Checked := true;
|
|
RBExtractSelectedFiles.Enabled := false;
|
|
end
|
|
else
|
|
begin
|
|
RBExtractSelectedFiles.Enabled := true;
|
|
RBExtractSelectedFiles.Checked := true;
|
|
end;
|
|
end;
|
|
|
|
if (ExtractOptionsDlg.ShowModal = mrOK) then
|
|
begin
|
|
// make progress bar visible
|
|
FileProgressBar.Visible := true;
|
|
|
|
with ArchiveManager, ExtractOptionsDlg do
|
|
begin
|
|
// get the destination directory from the extract options dialog
|
|
dest_dir := ExtractOptionsDlg.ExtractDir;
|
|
// ensure the directory can be used
|
|
EDos.AddBackSlash(dest_dir);
|
|
// use_folder_names is not supported because the interface has not been
|
|
// implemented
|
|
use_folder_names := false;
|
|
end;
|
|
|
|
files_extracted := 0;
|
|
total_size := 0;
|
|
|
|
ShowBusy;
|
|
try
|
|
try
|
|
if (ExtractOptionsDlg.RBExtractAllFiles.Checked) then
|
|
begin
|
|
// extract all files
|
|
for i := 0 to FileList.Items.Count - 1 do
|
|
ExtractFile(i);
|
|
end
|
|
else
|
|
begin
|
|
// extract selected files
|
|
ListItem := FileList.Selected;
|
|
while (ListItem <> nil) do
|
|
begin
|
|
ExtractFile(ListItem.Index);
|
|
ListItem := FileList.GetNextItem(ListItem, sdAll, [isSelected]);
|
|
end;
|
|
end;
|
|
|
|
except
|
|
on EUserCancel do begin {nothing} end;
|
|
end;
|
|
finally
|
|
// hide progress bar
|
|
FileProgressBar.Visible := false;
|
|
// display the done message in status bar
|
|
ShowStatusMessage('Extracted ' + GetNumFilesStr(files_extracted) + ' (' + IntToStr(total_size) + ' bytes)');
|
|
ShowReady;
|
|
end;
|
|
|
|
end; {ExtractOptionsDlg mrOK}
|
|
end;
|
|
*)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
DeleteFiles
|
|
-----------
|
|
Deletes selected files from the archive
|
|
|
|
Desc:
|
|
Flags selected items to be deleted then calls ArchiveManager to actually
|
|
delete them.
|
|
|
|
Algo:
|
|
set deleted flag for selected files
|
|
call ArchiveManager.DeleteFiles
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.DeleteFiles;
|
|
var
|
|
ListItem: TListItem;
|
|
CentralFileHeader: TCentralFileHeader;
|
|
files_deleted: integer; // num of files deleted
|
|
r: integer;
|
|
begin
|
|
//PageControl.ActivePageIndex := 1;
|
|
AddLog('--DELETE', clRed);
|
|
|
|
ShowBusy;
|
|
files_deleted := 0;
|
|
try
|
|
ListItem := FileList.Selected;
|
|
while (ListItem <> nil) do
|
|
begin
|
|
CentralFileHeader := TCentralFileHeader(Resource1.ArchiveMan.ArchiveFile.CentralDir[ListItem.Index]);
|
|
// ask for confirmation to delete the file
|
|
if (ConfigMan.confirm_on_delete) then
|
|
begin
|
|
r := Application.MessageBox(PChar('Are you sure you want to delete the file ''' + CentralFileHeader.filename + ''' ?'),
|
|
'Confirm', MB_YESNOCANCEL);
|
|
case (r) of
|
|
IDYES:
|
|
begin
|
|
{delete the file once we exit the if}
|
|
end;
|
|
IDNO:
|
|
begin
|
|
ListItem := FileList.GetNextItem(ListItem, sdAll, [isSelected]);
|
|
Continue;
|
|
end;
|
|
IDCANCEL:
|
|
begin
|
|
// do not delete anything
|
|
files_deleted := 0;
|
|
break;
|
|
end;
|
|
end;
|
|
end; // if confirm_on_delete
|
|
CentralFileHeader.Deleted := true;
|
|
inc(files_deleted);
|
|
ListItem := FileList.GetNextItem(ListItem, sdAll, [isSelected]);
|
|
end; // while
|
|
FileList.Selected := nil;
|
|
if (files_deleted > 0) then
|
|
Resource1.ArchiveMan.DeleteFiles;
|
|
finally
|
|
ShowStatusMessage('Deleted ' + GetNumFilesStr(files_deleted));
|
|
ShowReady;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
IsSortedAscending
|
|
-----------------
|
|
Returns true if Column is sorted in ascending order
|
|
|
|
Desc:
|
|
Runs through the items in FileList and determines if they are in ascending
|
|
order.
|
|
-------------------------------------------------------------------------------}
|
|
function TMainForm.IsSortedAscending(Column: TListColumn): boolean;
|
|
var
|
|
i, // counter
|
|
d: integer; // difference
|
|
ListSortCompare: TListSortCompare; // the comparison function for the column
|
|
begin
|
|
ListSortCompare := TColDataExtr(ColMan[Column.Index]).ListSortCompare;
|
|
if (FileList.Items.Count > 1) then
|
|
begin
|
|
for i := 1 to FileList.Items.Count-1 do
|
|
begin
|
|
with Resource1.ArchiveMan.ArchiveFile.CentralDir do
|
|
|
|
d := ListSortCompare(Items[i-1], Items[i]);
|
|
if (d > 0) then
|
|
begin
|
|
result := false;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
result := true;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.GetSelFilesList(List: TList);
|
|
var
|
|
ListItem: TListItem;
|
|
begin
|
|
ListItem := FileList.Selected;
|
|
while (ListItem <> nil) do
|
|
begin
|
|
List.Add(Resource1.ArchiveMan.ArchiveFile.CentralDir[ListItem.Index]);
|
|
ListItem := FileList.GetNextItem(ListItem, sdAll, [isSelected]);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.miProgStatsClick(Sender: TObject);
|
|
begin
|
|
ProgStatsDlg.ShowModal;
|
|
end;
|
|
|
|
procedure TMainForm.Chart1Click(Sender: TObject);
|
|
begin
|
|
//MTFChartForm.ShowModal;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.FileListSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
{var
|
|
CentralFileHeader: TCentralFileHeader;}
|
|
begin
|
|
{CentralFileHeader := TCentralFileHeader(ArchiveManager.ArchiveFile.CentralDir[Item.Index]);
|
|
if Selected then
|
|
inc(TotalSelFileSize, CentralFileHeader.uncompressed_size)
|
|
else
|
|
dec(TotalSelFileSize, CentralFileHeader.uncompressed_size);
|
|
|
|
ToggleOnSelEnableBtns;
|
|
ShowStatusMessage(GetNumFilesStr(FileList.SelCount) + ' selected. (' + IntToStr(TotalSelFileSize) + ' bytes)');}
|
|
end;
|
|
|
|
(*procedure TMainForm.DropSourceDrop(Sender: TObject; DragType: TDragType;
|
|
var ContinueDrop: Boolean);
|
|
var
|
|
//indexlist: TIndexList;
|
|
files_extracted, extract_size: integer;
|
|
temp_dir: string;
|
|
i: integer;
|
|
CFH: TCentralFileHeader;
|
|
List: TList;
|
|
begin
|
|
// Notes:
|
|
// ReleaseCapture must be called to allow user to respond with the mouse
|
|
|
|
// Extract the selected files to a temporary directory
|
|
|
|
//Releases mouse from drag op to enable user to respond to Messagebox
|
|
ReleaseCapture;
|
|
ContinueDrop := true;
|
|
List := TList.Create;
|
|
try
|
|
// extract selected files to a temp dir
|
|
GetSelFilesList(List);
|
|
try
|
|
ArchiveManager.ExtractListToTemp(List, files_extracted, extract_size, temp_dir);
|
|
|
|
// add the files to move
|
|
DropSource.Files.Clear;
|
|
|
|
//DropSource.Files.Add('c:\temp\ofile.dcu'); // move dummy file
|
|
DropSource.Files.Add(temp_dir + '*.*'); // move all files
|
|
|
|
{for i := 0 to List.Count-1 do
|
|
begin
|
|
CFH := TCentralFileHeader(List[i]);
|
|
DropSource.Files.Add(temp_dir + CFH.filename);
|
|
end;}
|
|
|
|
except
|
|
on exception do
|
|
begin
|
|
// exceptions may interfere with the drag/drop operation so we capture
|
|
// here and just abandon the drag drop
|
|
ContinueDrop := false;
|
|
end;
|
|
end;
|
|
finally
|
|
List.Free;
|
|
end;
|
|
|
|
|
|
{
|
|
Application.MessageBox('Are you sure', 'Confirm', 0);}
|
|
end;
|
|
*)
|
|
|
|
(*procedure TMainForm.FileListMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
drag_result: TDragResult;
|
|
s: string;
|
|
begin
|
|
// left mouse button down and move is a drag
|
|
if (Shift = [ssLeft]) then
|
|
begin
|
|
DropSource := TDropFileSource.Create(Self);
|
|
DropSource.Files.Clear;
|
|
DropSource.Files.Add('c:\temp\dummy file.dcu'); // actual files added onDrop
|
|
|
|
DropSource.DragTypes := [dtMove];
|
|
DropSource.OnDrop := DropSourceDrop;
|
|
|
|
drag_result := DropSource.Execute;
|
|
|
|
// remove the temp directory
|
|
// WARNING: DEBUG USING DEST_DIR WHICH MAY NOT BE CORRECT
|
|
//Sleep(1000);
|
|
{s := ArchiveManager.dest_dir;
|
|
EDos.DelSlash(s);
|
|
EDos.DelTree(s);}
|
|
|
|
case drag_result of
|
|
drCancel, drDropMove:
|
|
begin
|
|
{nothing}
|
|
end;
|
|
|
|
else
|
|
ShowMessage('Error: Unknown drag result');
|
|
end;
|
|
|
|
DropSource.Free;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
(*
|
|
procedure TMainForm.CacheFileInfo(const startindex, endindex: integer);
|
|
var
|
|
CFH: TCentralFileHeader;
|
|
i: integer;
|
|
FileInfo: TSHFileInfo;
|
|
DateTime: TDateTime;
|
|
DateTimeStr: string;
|
|
begin
|
|
{Checks that shell info and other file info is available for the central file headers
|
|
from startindex to endindex.
|
|
if not, will add them}
|
|
for i := startindex to endindex do
|
|
begin
|
|
CFH := TCentralFileHeader(Resource1.ArchiveMan.ArchiveFile.CentralDir[i]);
|
|
with CFH do
|
|
begin
|
|
if not info_cached then
|
|
begin
|
|
// shell info
|
|
SHGetFileInfo(PChar(CFH.filename),
|
|
0,
|
|
FileInfo,
|
|
SizeOf(FileInfo),
|
|
SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
|
|
shell_small_icon_index := FileInfo.iIcon;
|
|
shell_type_name := FileInfo.szTypeName;
|
|
|
|
// cache other info as string
|
|
DateTime := FileDateToDateTime(CFH.time);
|
|
DateTimeToString(DateTimeStr, 'd/m/yy h:nn AM/PM', DateTime);
|
|
time_string := DateTimeStr;
|
|
|
|
info_cached := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
(*
|
|
procedure TMainForm.FileListData(Sender: TObject; Item: TListItem);
|
|
var
|
|
CFH: TCentralFileHeader;
|
|
j: integer;
|
|
begin
|
|
{Update data for current item
|
|
Get the data from ArchiveManager.ArchiveFile.CentralDir}
|
|
{We must check if the Archive is opened, otherwise the CentralDir cannot
|
|
be read}
|
|
if not Resource1.ArchiveMan.IsArchiveOpen then exit;
|
|
|
|
with Resource1.ArchiveMan.ArchiveFile do
|
|
begin
|
|
Assert(CentralDir <> nil);
|
|
|
|
if (Item = nil) or (Item.Index >= CentralDir.Count) {or
|
|
(Item.Caption <> '')} then exit;
|
|
|
|
{Get Shell info if not available yet}
|
|
//CacheFileInfo(Item.Index, Item.Index);
|
|
|
|
if (ColMan.Count > 0) then
|
|
begin
|
|
CFH := TCentralFileHeader(CentralDir[Item.Index]);
|
|
// icon and column 0 (caption) have to be assigned manually
|
|
// the rest we let ColDataExtr extract and assign
|
|
|
|
// icon index
|
|
Item.ImageIndex := CFH.ShellSmallIconIndex;
|
|
// column 0 is caption
|
|
Item.Caption := TColDataExtr(ColMan[0]).Extract(CFH);
|
|
|
|
// the rest of the columns are subitems
|
|
for j := 1 to ColMan.Count-1 do
|
|
Item.SubItems.Add(TColDataExtr(ColMan[j]).Extract(CFH));
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
(*
|
|
procedure TMainForm.FileListDataHint(Sender: TObject; StartIndex,
|
|
EndIndex: Integer);
|
|
begin
|
|
{This one is for quick updating of items in a range.
|
|
Not necessary since OnData is already called for each item}
|
|
end;
|
|
*)
|
|
|
|
procedure TMainForm.Test(Sender: TObject);
|
|
{var
|
|
SHFileOpStruct: TSHFileOpStruct;}
|
|
begin
|
|
{with SHFileOpStruct do
|
|
begin
|
|
wnd := Self.Handle;
|
|
wFunc := FO_DELETE;
|
|
pTo := PChar('');
|
|
pFrom := PChar('c:\ctestout\*.*');
|
|
fFlags := 0;
|
|
hNameMappings := nil;
|
|
end;
|
|
SHFileOperation(SHFileOpStruct);}
|
|
try
|
|
//EDos.ForceDirectories('c:\rubbish dir\yea\very long long');
|
|
EDos.DelTree('c:\temp\no such dir');
|
|
except
|
|
{on EInOutError do
|
|
begin
|
|
ShowMessage('Error. Drive not ready');
|
|
end;}
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.SelectAllActExecute(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
ListItem: TListItem;
|
|
begin
|
|
FileList.SetFocus;
|
|
for i := 0 to FileList.Items.Count-1 do
|
|
begin
|
|
ListItem := FileList.Items[i];
|
|
ListItem.Selected := true;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.SpeedButton1Click(Sender: TObject);
|
|
begin
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ArchiveManOnCentralDirChange
|
|
----------------------------
|
|
Event Handler. Called when the central directory changes.
|
|
Updates the filelist to reflect the CentralDir.
|
|
|
|
Desc:
|
|
Uses ColMan to extract the data from the various columns
|
|
-------------------------------------------------------------------------------}
|
|
procedure TMainForm.Resource1CentralDirChange(Sender: TObject);
|
|
var
|
|
CFH: TCentralFileHeader; // entry in CentralDir
|
|
i, j: integer; // counters
|
|
ListItem: TListItem; // entry in the filelist
|
|
|
|
begin
|
|
// debug: print out block size
|
|
{BlockSizeLabel.Caption := IntToStr(ArchiveManager.CentralDir.block_size);}
|
|
|
|
// update the file list to reflect the new main dir
|
|
// call BeginUpdate to prevent the screen from refreshing while we update
|
|
FileList.Items.BeginUpdate;
|
|
FileList.Items.Clear;
|
|
with Resource1.ArchiveMan.ArchiveFile do
|
|
begin
|
|
if (ColMan.Count > 0) then
|
|
begin
|
|
for i := 0 to CentralDir.Count-1 do
|
|
begin
|
|
CFH := TCentralFileHeader(CentralDir[i]);
|
|
ListItem := FileList.Items.Add;
|
|
ListItem.ImageIndex := CFH.ShellSmallIconIndex;
|
|
// column 0 is caption
|
|
ListItem.Caption := TColDataExtr(ColMan[0]).Extract(CFH);
|
|
// the rest of the columns are subitems
|
|
for j := 1 to ColMan.Count-1 do
|
|
ListItem.SubItems.Add(TColDataExtr(ColMan[j]).Extract(CFH));
|
|
end;
|
|
end;
|
|
|
|
// enable/disable buttons
|
|
EnableFileListSensitiveItems(not (CentralDir.Count = 0));
|
|
end;
|
|
FileList.Items.EndUpdate;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.AddSelectFilesActExecute(Sender: TObject);
|
|
begin
|
|
AddSelectFiles;
|
|
end;
|
|
|
|
procedure TMainForm.ExtractSelFilesActExecute(Sender: TObject);
|
|
begin
|
|
ExtractFiles;
|
|
end;
|
|
|
|
procedure TMainForm.DelSelFilesActExecute(Sender: TObject);
|
|
begin
|
|
DeleteFiles;
|
|
end;
|
|
|
|
procedure TMainForm.SetPropertyActExecute(Sender: TObject);
|
|
var
|
|
CentralFileHeader: TCentralFileHeader;
|
|
begin
|
|
//PageControl.ActivePageIndex := 1; // focus the log page
|
|
|
|
{To modify property, a link to the CentralFileHeader entry is gotten from ArchiveFile.
|
|
This entry is modified, then rewritten using ArchiveMan.WriteCentralDir}
|
|
CentralFileHeader := TCentralFileHeader(Resource1.ArchiveMan.ArchiveFile.CentralDir[FileList.Selected.Index]);
|
|
if (FileAttrDlg.Execute(CentralFileHeader) = mrOK) then
|
|
begin
|
|
AddLog('--SET PROPERTY', clRed);
|
|
ShowBusy;
|
|
// store config into Central Dir
|
|
FileAttrDlg.GetCentralFileHeader(CentralFileHeader);
|
|
// rewrite central dir with the new CentralFileHeader
|
|
Resource1.ArchiveMan.WriteCentralDir;
|
|
ShowReady;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.SetPropertyActUpdate(Sender: TObject);
|
|
begin
|
|
SetPropertyAct.Enabled := FileList.Selected <> nil;
|
|
end;
|
|
|
|
procedure TMainForm.DelSelFilesActUpdate(Sender: TObject);
|
|
begin
|
|
DelSelFilesAct.Enabled := FileList.Selected <> nil;
|
|
end;
|
|
|
|
procedure TMainForm.SelectAllActUpdate(Sender: TObject);
|
|
begin
|
|
SelectAllAct.Enabled := FileList.Items.Count > 0;
|
|
end;
|
|
|
|
procedure TMainForm.OpenActExecute(Sender: TObject);
|
|
begin
|
|
// open an existing archive
|
|
OpenDialog.FileName := '';
|
|
if (OpenDialog.Execute) then OpenArchive(OpenDialog.FileName, false);
|
|
end;
|
|
|
|
procedure TMainForm.CreateNewActExecute(Sender: TObject);
|
|
begin
|
|
// open an existing archive
|
|
OpenDialog2.FileName := '';
|
|
if (OpenDialog2.Execute) then OpenArchive(OpenDialog2.FileName, false);
|
|
end;
|
|
|
|
procedure TMainForm.CloseActExecute(Sender: TObject);
|
|
begin
|
|
CloseArchive;
|
|
end;
|
|
|
|
procedure TMainForm.AddLog(s: string; Color: TColor = clWindowText; Style: TFontStyles = []);
|
|
begin
|
|
{ check log limit }
|
|
if (RichEdit.Lines.Count > LogLinesLimit) then
|
|
RichEdit.Lines.Delete(0);
|
|
RichEdit.SelAttributes.Color := Color;
|
|
RichEdit.SelAttributes.Style := Style;
|
|
RichEdit.Lines.Add(s);
|
|
RichEdit.SelStart := length(RichEdit.Text);
|
|
//RichEdit.SelLength := 5;
|
|
SendMessage(RichEdit.Handle, SB_BOTTOM, 0, 0);
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.Resource1AddLog(Sender: TObject; s: String);
|
|
begin
|
|
AddLog(s);
|
|
end;
|
|
|
|
procedure TMainForm.Button1Click(Sender: TObject);
|
|
begin
|
|
{Test the Stream Compression}
|
|
end;
|
|
|
|
{ TMyCentralFileHeader }
|
|
{
|
|
constructor TMyCentralFileHeader.Create;
|
|
begin
|
|
FShellSmallIconIndex := -1; // only retrieve these data when they are needed
|
|
FShellTypeName := '?';
|
|
end;
|
|
|
|
procedure TMyCentralFileHeader.FillShellInfo;
|
|
var
|
|
FileInfo: TSHFileInfo;
|
|
begin
|
|
SHGetFileInfo(PChar(filename),
|
|
0,
|
|
FileInfo,
|
|
SizeOf(FileInfo),
|
|
SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
|
|
FShellSmallIconIndex; := FileInfo.iIcon;
|
|
FShellTypeName := FileInfo.szTypeName;
|
|
end;
|
|
|
|
function TMyCentralFileHeader.GetShellSmallIconIndex: integer;
|
|
begin
|
|
if FShellSmallIconIndex = -1 then
|
|
FillShellInfo;
|
|
result := FShellSmallIconIndex;
|
|
end;
|
|
|
|
function TMyCentralFileHeader.GetShellTypeName: string;
|
|
begin
|
|
if FShellTypeName = '?' then
|
|
FillShellInfo;
|
|
result := FShellTypeName;
|
|
end;
|
|
}
|
|
|
|
end.
|