mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Load VFS list in panel

Browse source
This commit is contained in:
Alexander Koblov 2007-08-30 20:11:18 +00:00
commit 61889e3004
10 changed files with 412 additions and 325 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/uFilePanel.txt
View file

@ -1,2 +1,3 @@
$$$*** This is unit history file ***$$$ ###encoding="UTF-8"###
24.08.2007 ADD: Поддержка вложенных архивов
24.08.2007 ADD: Поддержка вложенных архивов
30.08.2007 ADD: Вывод списка VFS

106
fFindDlg.lfm
View file

@ -1,7 +1,7 @@
inherited frmFindDlg: TfrmFindDlg
Left = 0
Left = -84
Height = 476
Top = 71
Top = 176
Width = 659
HorzScrollBar.Page = 658
VertScrollBar.Page = 475
@ -43,21 +43,21 @@ inherited frmFindDlg: TfrmFindDlg
TabOrder = 0
object tsStandard: TTabSheet
Caption = 'Standard'
ClientHeight = 262
ClientWidth = 560
ClientHeight = 270
ClientWidth = 556
object lblFindPathStart: TLabel
Left = 8
Height = 17
Height = 14
Top = 50
Width = 46
Width = 30
Caption = 'FileDir'
ParentColor = False
end
object lblFindFileMask: TLabel
Left = 8
Height = 17
Height = 14
Top = 4
Width = 64
Width = 41
Caption = 'FileMask'
ParentColor = False
end
@ -68,6 +68,7 @@ inherited frmFindDlg: TfrmFindDlg
Width = 362
Anchors = [akTop, akLeft, akRight]
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
MaxLength = 0
ParentCtl3D = False
TabOrder = 0
@ -80,16 +81,16 @@ inherited frmFindDlg: TfrmFindDlg
Width = 418
Anchors = [akTop, akLeft, akRight]
Caption = 'Find Data'
ClientHeight = 124
ClientHeight = 127
ClientWidth = 414
Enabled = False
ParentCtl3D = False
TabOrder = 1
object cbCaseSens: TCheckBox
Left = 18
Height = 24
Height = 13
Top = 97
Width = 132
Width = 88
Caption = 'Case sensitive'
TabOrder = 0
end
@ -97,23 +98,23 @@ inherited frmFindDlg: TfrmFindDlg
Left = 16
Height = 24
Top = 9
Width = 278
Width = 266
Anchors = [akTop, akLeft, akRight]
TabOrder = 1
end
object cbNoThisText: TCheckBox
Left = 154
Height = 24
Height = 13
Top = 97
Width = 269
Width = 177
Caption = 'Find files NOT containing the text'
TabOrder = 2
end
object cbReplaceText: TCheckBox
Left = 16
Height = 24
Height = 13
Top = 41
Width = 118
Width = 80
Caption = 'Replace text'
OnChange = cbReplaceTextChange
TabOrder = 4
@ -129,9 +130,9 @@ inherited frmFindDlg: TfrmFindDlg
end
object cbFindInFile: TCheckBox
Left = 12
Height = 24
Height = 13
Top = 98
Width = 100
Width = 67
Caption = 'Find in file'
OnClick = cbFindInFileClick
TabOrder = 2
@ -149,8 +150,8 @@ inherited frmFindDlg: TfrmFindDlg
end
object tsAdvanced: TTabSheet
Caption = 'Advanced'
ClientHeight = 262
ClientWidth = 560
ClientHeight = 270
ClientWidth = 556
ImageIndex = 1
object deDateFrom: TDateEdit
Left = 4
@ -224,18 +225,18 @@ inherited frmFindDlg: TfrmFindDlg
end
object cbDateFrom: TCheckBox
Left = 4
Height = 24
Height = 13
Top = 22
Width = 109
Width = 72
Caption = 'Date From:'
OnChange = cbDateFromChange
TabOrder = 2
end
object cbNotOlderThan: TCheckBox
Left = 4
Height = 24
Height = 13
Top = 136
Width = 134
Width = 90
Caption = 'Not older than:'
OnChange = cbNotOlderThanChange
TabOrder = 3
@ -255,6 +256,7 @@ inherited frmFindDlg: TfrmFindDlg
Width = 110
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Enabled = False
ItemHeight = 13
ItemIndex = 2
Items.Strings = (
'Minute(s)'
@ -270,27 +272,27 @@ inherited frmFindDlg: TfrmFindDlg
end
object cbFileSizeFrom: TCheckBox
Left = 4
Height = 24
Height = 13
Top = 193
Width = 135
Width = 88
Caption = 'File Size From:'
OnChange = cbFileSizeFromChange
TabOrder = 6
end
object cbDateTo: TCheckBox
Left = 164
Height = 24
Height = 13
Top = 22
Width = 90
Width = 62
Caption = 'Date To:'
OnChange = cbDateToChange
TabOrder = 7
end
object cbFileSizeTo: TCheckBox
Left = 164
Height = 24
Height = 13
Top = 193
Width = 116
Width = 78
Caption = 'File Size To:'
OnChange = cbFileSizeToChange
TabOrder = 8
@ -318,6 +320,7 @@ inherited frmFindDlg: TfrmFindDlg
Width = 72
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Enabled = False
ItemHeight = 13
ItemIndex = 1
Items.Strings = (
'Byte'
@ -332,18 +335,18 @@ inherited frmFindDlg: TfrmFindDlg
end
object cbTimeFrom: TCheckBox
Left = 4
Height = 24
Height = 13
Top = 73
Width = 105
Width = 69
Caption = 'Time from:'
OnChange = cbTimeFromChange
TabOrder = 12
end
object cbTimeTo: TCheckBox
Left = 164
Height = 24
Height = 13
Top = 73
Width = 86
Width = 58
Caption = 'Time to:'
OnChange = cbTimeToChange
TabOrder = 13
@ -371,41 +374,45 @@ inherited frmFindDlg: TfrmFindDlg
Height = 165
Top = 41
Width = 270
ClientHeight = 144
ClientHeight = 147
ClientWidth = 266
Enabled = False
TabOrder = 16
object lblInfo: TLabel
Left = 10
Height = 37
Height = 27
Top = 110
Width = 255
Width = 172
Caption = 'Windows: ''rahs'' Unix: ''rwxrwxrwx'''#13#10'Use ''-'' to off attribute and ''?'' to any'
ParentColor = False
end
object cbDirectory: TCheckBox
Left = 10
Height = 24
Height = 13
Top = 2
Width = 91
Width = 62
AllowGrayed = True
Caption = 'Directory'
OnChange = cbDirectoryChange
State = cbGrayed
TabOrder = 0
end
object cbSymLink: TCheckBox
Left = 10
Height = 24
Height = 13
Top = 30
Width = 89
Width = 60
AllowGrayed = True
Caption = 'SymLink'
OnChange = cbSymLinkChange
State = cbGrayed
TabOrder = 1
end
object cbMore: TCheckBox
Left = 10
Height = 24
Height = 13
Top = 58
Width = 63
Width = 44
Caption = 'More'
OnChange = cbMoreChange
TabOrder = 2
@ -421,9 +428,9 @@ inherited frmFindDlg: TfrmFindDlg
end
object cbAttrib: TCheckBox
Left = 284
Height = 24
Height = 13
Top = 22
Width = 96
Width = 64
Caption = 'Attributes'
OnChange = cbAttribChange
TabOrder = 17
@ -489,9 +496,9 @@ inherited frmFindDlg: TfrmFindDlg
TabOrder = 0
object lblStatus: TLabel
Left = 8
Height = 17
Height = 13
Top = 30
Width = 63
Width = 44
Caption = 'lblStatus'
Font.Color = clBlack
Font.Height = 13
@ -502,9 +509,9 @@ inherited frmFindDlg: TfrmFindDlg
end
object lblCurrent: TLabel
Left = 8
Height = 17
Height = 13
Top = 12
Width = 70
Width = 49
Caption = 'lblCurrent'
Font.Color = clBlack
Font.Height = 13
@ -523,7 +530,6 @@ inherited frmFindDlg: TfrmFindDlg
OnDblClick = lsFoundedFilesDblClick
PopupMenu = PopupMenuFind
TabOrder = 1
TopIndex = -1
end
object Panel4: TPanel
Height = 50

37
fmain.lfm
View file

@ -1,14 +1,14 @@
inherited frmMain: TfrmMain
Left = 217
Left = 238
Height = 336
Top = 316
Top = 137
Width = 525
HorzScrollBar.Page = 524
VertScrollBar.Page = 305
VertScrollBar.Page = 316
VertScrollBar.Range = 79
ActiveControl = pnlNotebooks
Caption = 'Double Commander'
ClientHeight = 306
ClientHeight = 317
ClientWidth = 525
Font.Color = clBlack
Font.Height = 13
@ -79,7 +79,7 @@ inherited frmMain: TfrmMain
end
object pnlCommand: TPanel
Height = 62
Top = 244
Top = 255
Width = 525
Align = alBottom
Anchors = [akLeft, akRight]
@ -91,9 +91,9 @@ inherited frmMain: TfrmMain
TabOrder = 1
object lblCommandPath: TLabel
Left = 1
Height = 17
Height = 14
Top = 8
Width = 35
Width = 23
Alignment = taRightJustify
Caption = 'Path'
ParentColor = False
@ -200,6 +200,7 @@ inherited frmMain: TfrmMain
Width = 688
TabStop = False
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
MaxLength = 0
OnKeyDown = edtCommandKeyDown
OnKeyUp = edtCommandKeyUp
@ -208,18 +209,18 @@ inherited frmMain: TfrmMain
end
end
object pnlNotebooks: TPanel
Height = 195
Height = 206
Top = 49
Width = 525
Align = alClient
ClientHeight = 195
ClientHeight = 206
ClientWidth = 525
FullRepaint = False
TabOrder = 2
TabStop = True
object nbLeft: TNotebook
Left = 1
Height = 193
Height = 204
Top = 1
Width = 391
Align = alLeft
@ -229,14 +230,14 @@ inherited frmMain: TfrmMain
end
object MainSplitter: TSplitter
Left = 392
Height = 193
Height = 204
Top = 1
Width = 4
ResizeStyle = rsLine
end
object nbRight: TNotebook
Left = 396
Height = 193
Height = 204
Top = 1
Width = 128
Align = alClient
@ -373,6 +374,10 @@ inherited frmMain: TfrmMain
object miLine9: TMenuItem
Caption = '-'
end
object MenuItem1: TMenuItem
Action = actOpenVFSList
OnClick = actOpenVFSListExecute
end
object mnuCmdSwapSourceTarget: TMenuItem
Caption = 'Source &<-> Target'
Enabled = False
@ -541,7 +546,7 @@ inherited frmMain: TfrmMain
DisableIfNoHandler = True
HelpType = htKeyword
OnExecute = actSearchExecute
ShortCut = 20534
ShortCut = 32886
end
object actDirHotList: TAction
Category = 'Commands'
@ -778,6 +783,12 @@ inherited frmMain: TfrmMain
OnExecute = actExtractFilesExecute
ShortCut = 32888
end
object actOpenVFSList: TAction
Category = 'Commands'
Caption = 'Open VFS List'
DisableIfNoHandler = True
OnExecute = actOpenVFSListExecute
end
end
object pmHotList: TPopupMenu
left = 152

8
fmain.pas
View file

@ -55,12 +55,14 @@ type
actChMod: TAction;
actChown: TAction;
actExtractFiles: TAction;
actOpenVFSList: TAction;
actPackFiles: TAction;
actRemoveTab: TAction;
actNewTab: TAction;
dskLeft: TKAStoolBar;
dskRight: TKAStoolBar;
MainToolBar: TKASToolBar;
MenuItem1: TMenuItem;
mnuExtractFiles: TMenuItem;
pnlDisk: TPanel;
tbDelete: TMenuItem;
@ -177,6 +179,7 @@ type
pmToolBar: TPopupMenu;
MainSplitter: TSplitter;
procedure actExtractFilesExecute(Sender: TObject);
procedure actOpenVFSListExecute(Sender: TObject);
procedure actPackFilesExecute(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure dskRightChangeLineCount(AddSize: Integer);
@ -374,6 +377,11 @@ begin
end;
procedure TfrmMain.actOpenVFSListExecute(Sender: TObject);
begin
ActiveFrame.pnlFile.LoadVFSListInPanel;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
DebugLn('frmMain.Destroy');

55
foptions.lfm
View file

@ -1,7 +1,7 @@
inherited frmOptions: TfrmOptions
Left = 191
Left = 164
Height = 369
Top = 58
Top = 85
Width = 577
HorzScrollBar.Page = 576
VertScrollBar.Page = 368
@ -115,15 +115,15 @@ inherited frmOptions: TfrmOptions
Top = 24
Width = 454
Align = alClient
PageIndex = 1
PageIndex = 7
ShowTabs = False
TabOrder = 0
object pgLng: TPage
Caption = 'pgLng'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object lngList: TListBox
Height = 293
Height = 300
Width = 446
Align = alClient
TabOrder = 0
@ -132,7 +132,7 @@ inherited frmOptions: TfrmOptions
object pgBehav: TPage
Caption = 'pgBehav'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object lblTerm: TLabel
Left = 8
Height = 14
@ -267,13 +267,12 @@ inherited frmOptions: TfrmOptions
object pgTools: TPage
Caption = 'pgTools'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object cbExtEditor: TCheckBox
Left = 3
Height = 13
Top = 13
Width = 74
AllowGrayed = True
Caption = 'cbExtEditor'
OnClick = cbExtEditorClick
TabOrder = 0
@ -292,7 +291,6 @@ inherited frmOptions: TfrmOptions
Height = 13
Top = 78
Width = 72
AllowGrayed = True
Caption = 'cbExtDiffer'
OnClick = cbExtDifferClick
TabOrder = 2
@ -311,7 +309,6 @@ inherited frmOptions: TfrmOptions
Height = 13
Top = 143
Width = 79
AllowGrayed = True
Caption = 'cbExtViewer'
OnClick = cbExtViewerClick
TabOrder = 4
@ -329,7 +326,7 @@ inherited frmOptions: TfrmOptions
object pgFonts: TPage
Caption = 'pgFonts'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object lblMainFont: TLabel
Left = 6
Height = 14
@ -490,7 +487,7 @@ inherited frmOptions: TfrmOptions
object pgColor: TPage
Caption = 'pgColor'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object cTextLabel: TLabel
Left = 25
Height = 14
@ -815,8 +812,8 @@ inherited frmOptions: TfrmOptions
Top = 26
Width = 185
Caption = 'Example'
ClientHeight = 172
ClientWidth = 185
ClientHeight = 154
ClientWidth = 181
TabOrder = 12
object pbExample: TPaintBox
Left = 8
@ -830,20 +827,20 @@ inherited frmOptions: TfrmOptions
object pgHotKey: TPage
Caption = 'pgHotKey'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object lblActions: TLabel
Left = 6
Height = 13
Height = 14
Top = 13
Width = 43
Width = 36
Caption = 'Actions'
ParentColor = False
end
object lblHotKey: TLabel
Left = 6
Height = 13
Height = 14
Top = 68
Width = 46
Width = 39
Caption = 'Hot Key'
ParentColor = False
end
@ -895,17 +892,17 @@ inherited frmOptions: TfrmOptions
object pgPlugins: TPage
Caption = 'pgPlugins'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object pcPluginsTypes: TPageControl
Height = 293
Height = 300
Width = 446
ActivePage = tsWFX
ActivePage = tsWCX
Align = alClient
TabIndex = 1
TabIndex = 0
TabOrder = 0
object tsWCX: TTabSheet
Caption = 'Packer plugins (.WCX)'
ClientHeight = 267
ClientHeight = 274
ClientWidth = 438
OnShow = tsWCXShow
object lblAbout: TLabel
@ -994,7 +991,7 @@ inherited frmOptions: TfrmOptions
object tsWFX: TTabSheet
Caption = 'File system plugins (.WFX)'
ChildSizing.LeftRightSpacing = 239
ClientHeight = 267
ClientHeight = 274
ClientWidth = 438
OnShow = tsWFXShow
object lblInstalledPlugins: TLabel
@ -1058,15 +1055,15 @@ inherited frmOptions: TfrmOptions
object pgFileTypesColors: TPage
Caption = 'pgFileTypesColors'
ClientWidth = 446
ClientHeight = 293
ClientHeight = 300
object gbFileTypesColors: TGroupBox
Left = 10
Height = 274
Top = 2
Width = 425
Caption = 'File types colors'
ClientHeight = 274
ClientWidth = 425
ClientHeight = 256
ClientWidth = 421
TabOrder = 0
object lblCategoryName: TLabel
Left = 45
@ -1152,7 +1149,7 @@ inherited frmOptions: TfrmOptions
TabOrder = 3
end
object bbtnDeleteCategory: TBitBtn
Left = 247
Left = 246
Height = 32
Top = 218
Width = 75

23
foptions.pas
View file

@ -683,10 +683,10 @@ begin
sCurrPlugin := clbWCXList.Items[I];
PosEqual := Pos('=', sCurrPlugin);
sExt := Copy(sCurrPlugin, 1, PosEqual - 1);
if sExt[1] = '?' then
if sExt[1] = '#' then
Delete(sExt, 1, 1);
cbExt.Items.Add(sExt);
if Pos('?', clbWCXList.Items[I]) = 0 then
if Pos('#', clbWCXList.Items[I]) = 0 then
begin
clbWCXList.Items[I] := Copy(sCurrPlugin, PosEqual + 1, Length(sCurrPlugin) - PosEqual);
clbWCXList.Checked[I] := True
@ -741,13 +741,13 @@ begin
begin
if clbWCXList.Checked[I] then
begin
gIni.DeleteKey('PackerPlugins', '?' + cbExt.Items[I]);
gIni.DeleteKey('PackerPlugins', '#' + cbExt.Items[I]);
gIni.WriteString('PackerPlugins', cbExt.Items[I], clbWCXList.Items[I])
end
else
begin
gIni.DeleteKey('PackerPlugins', cbExt.Items[I]);
gIni.WriteString('PackerPlugins', '?' + cbExt.Items[I], clbWCXList.Items[I]);
gIni.WriteString('PackerPlugins', '#' + cbExt.Items[I], clbWCXList.Items[I]);
end;
end;
end;
@ -764,7 +764,7 @@ begin
begin
sCurrPlugin := clbWFXList.Items[I];
if Pos('?', clbWFXList.Items[I]) = 0 then
if Pos('#', clbWFXList.Items[I]) = 0 then
begin
clbWFXList.Items[I] := Copy(sCurrPlugin, 1, Length(sCurrPlugin));
clbWFXList.Checked[I] := True
@ -803,26 +803,24 @@ var
iIndex : Integer;
bChecked : Boolean;
begin
gIni.EraseSection('FileSystemPlugins');
for I := 0 to clbWFXList.Count - 1 do
begin
if clbWFXList.Checked[I] then
begin
gIni.DeleteKey('FileSystemPlugins', '?' + clbWFXList.Items.Names[I]);
gIni.WriteString('FileSystemPlugins', clbWFXList.Items.Names[I], clbWFXList.Items.ValueFromIndex[I])
end
else
begin
gIni.DeleteKey('FileSystemPlugins', clbWFXList.Items.Names[I]);
gIni.WriteString('FileSystemPlugins', '?' + clbWFXList.Items.Names[I], clbWFXList.Items.ValueFromIndex[I]);
gIni.WriteString('FileSystemPlugins', '#' + clbWFXList.Items.Names[I], clbWFXList.Items.ValueFromIndex[I]);
end;
end;
end;
procedure TfrmOptions.bbtnWFXDeleteClick(Sender: TObject);
begin
if clbWFXList.SelCount > 0 then
clbWFXList.Items.Delete(clbWFXList.ItemIndex);
end;
procedure TfrmOptions.bbtnWFXRenameClick(Sender: TObject);
@ -830,12 +828,15 @@ var
iItemIndex : Integer;
sName,
sValue : String;
bChecked : Boolean;
begin
iItemIndex := clbWFXList.ItemIndex;
if iItemIndex < 0 then exit;
sName := clbWFXList.Items.Names[iItemIndex];
sValue := clbWFXList.Items.ValueFromIndex[iItemIndex];
bChecked := clbWFXList.Checked[iItemIndex]; // Save state
clbWFXList.Items[iItemIndex] := InputBox('Double Commander', 'Rename', sName) + '=' + sValue;
clbWFXList.Checked[iItemIndex] := bChecked; // Restore state
end;
{/WFXPlugins}

35
fpackdlg.lfm
View file

@ -31,9 +31,9 @@ object PackDlg: TPackDlg
end
object cbStoredir: TCheckBox
Left = 4
Height = 30
Height = 13
Top = 43
Width = 301
Width = 197
Caption = 'Also &pack path names (only recursed)'
Checked = True
State = cbChecked
@ -41,9 +41,9 @@ object PackDlg: TPackDlg
end
object cbRecurse: TCheckBox
Left = 4
Height = 26
Height = 13
Top = 63
Width = 252
Width = 170
Caption = 'Recursively pack &subdirectories'
Checked = True
Enabled = False
@ -52,9 +52,9 @@ object PackDlg: TPackDlg
end
object cbMultivolume: TCheckBox
Left = 4
Height = 26
Height = 13
Top = 83
Width = 170
Width = 116
Caption = '&Multiple disk archive'
Enabled = False
TabOrder = 2
@ -87,7 +87,7 @@ object PackDlg: TPackDlg
Top = 16
Width = 142
Caption = ' Packer '
ClientHeight = 112
ClientHeight = 115
ClientWidth = 138
Font.Color = clBtnText
Font.Height = -11
@ -105,9 +105,9 @@ object PackDlg: TPackDlg
end
object rbOtherPlugins: TRadioButton
Left = 5
Height = 24
Height = 13
Top = 51
Width = 42
Width = 29
Caption = '&->'
Checked = True
Enabled = False
@ -124,6 +124,7 @@ object PackDlg: TPackDlg
Enabled = False
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
OnChange = arbChange
Style = csDropDownList
@ -132,17 +133,17 @@ object PackDlg: TPackDlg
end
object cbMoveToArchive: TCheckBox
Left = 4
Height = 26
Height = 13
Top = 103
Width = 141
Width = 97
Caption = 'M&ove to archive'
TabOrder = 3
end
object cbCreateSFX: TCheckBox
Left = 4
Height = 26
Height = 13
Top = 123
Width = 237
Width = 157
Caption = 'Create self e&xtracting archive'
Enabled = False
TabOrder = 4
@ -158,17 +159,17 @@ object PackDlg: TPackDlg
end
object cbEncrypt: TCheckBox
Left = 4
Height = 29
Height = 13
Top = 163
Width = 82
Width = 56
Caption = 'Encr&ypt'
TabOrder = 6
end
object cbCreateSeparateArchives: TCheckBox
Left = 4
Height = 26
Height = 13
Top = 143
Width = 384
Width = 255
Caption = 'Create separate archives, o&ne per selected file/dir'
Enabled = False
TabOrder = 5

371
fpackdlg.pas
View file

@ -1,185 +1,186 @@
{
Double Commander
-------------------------------------------------------------------------
File packing window
Copyright (C) 2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fPackDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, uFileList, uVFS, EditBtn;
type
{ TPackDlg }
TPackDlg = class(TForm)
btnHelp: TButton;
btnCancel: TButton;
btnConfig: TButton;
cbCreateSeparateArchives: TCheckBox;
cbCreateSFX: TCheckBox;
cbEncrypt: TCheckBox;
cbMoveToArchive: TCheckBox;
cbMultivolume: TCheckBox;
btnOk: TButton;
edtPackCmd: TDirectoryEdit;
gbPacker: TGroupBox;
cbPackerList: TComboBox;
lblPrompt: TLabel;
cbRecurse: TCheckBox;
cbStoredir: TCheckBox;
rbOtherPlugins: TRadioButton;
procedure btnConfigClick(Sender: TObject);
procedure edtPackCmdAcceptDirectory(Sender: TObject; var Value: String);
procedure FormShow(Sender: TObject);
procedure arbChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure ShowPackFilesForm(VFS : TVFS; var fl : TFileList; sDestPath:String);
var
arbRadioButtonArray : array [0..8] of TRadioButton;
implementation
uses
uWCXhead;
var
CurrentVFS : TVFS;
procedure ShowPackFilesForm(VFS : TVFS; var fl: TFileList; sDestPath:String);
var
Flags : LongInt;
begin
with TPackDlg.Create(nil) do
begin
(* if one file selected *)
if fl.Count = 1 then
begin
edtPackCmd.Text := sDestPath + ExtractFileName(fl.GetFileName(0));
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.none');
end
else
(* if some files selected *)
begin
edtPackCmd.Text := sDestPath + ExtractFileName(ExcludeTrailingPathDelimiter(fl.CurrentDirectory)) + '.none';
end;
CurrentVFS := VFS;
if (ShowModal = mrOK) then
if VFS.FindModule(edtPackCmd.Text) then
begin
Flags := 0;
if cbMoveToArchive.Checked then Flags := Flags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then Flags := Flags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then Flags := Flags or PK_PACK_ENCRYPT;
VFS.VFSmodule.VFSCopyIn(fl, '', Flags);
end;
Free;
end;
end;
{ TPackDlg }
procedure TPackDlg.FormShow(Sender: TObject);
var
I, J : Integer;
sCurrentPlugin : String;
iCurPlugCaps : Integer;
Count : Integer;
begin
J := 0;
Count := 0;
with CurrentVFS do
begin
for I:=0 to Plugins.Count -1 do
begin
sCurrentPlugin := Plugins.ValueFromIndex[i];
iCurPlugCaps := StrToInt(Copy(sCurrentPlugin, 1, Pos(',',sCurrentPlugin) - 1));
if (iCurPlugCaps and PK_CAPS_NEW) = PK_CAPS_NEW then
begin
(* First 9 plugins we display as RadioButtons *)
if J < 9 then
begin
arbRadioButtonArray[J] := TRadioButton.Create(gbPacker);
arbRadioButtonArray[J].Parent := gbPacker;
arbRadioButtonArray[J].Left := 5 + 45 * (J div 3);
arbRadioButtonArray[J].Top := Count * (arbRadioButtonArray[J].Height + 4);
arbRadioButtonArray[J].Visible := True;
arbRadioButtonArray[J].Caption := Plugins.Names[I];
arbRadioButtonArray[J].OnChange := @arbChange;
J := J + 1;
Count := Count + 1;
if Count > 2 then
Count := 0;
end
else
(* Other plugins we add in ComboBox *)
begin
cbPackerList.Items.Add(Plugins.Names[I]);
end;
end;
end; //for
if arbRadioButtonArray[0] <> nil then
arbRadioButtonArray[0].Checked := True;
if cbPackerList.Items.Count > 0 then
begin
rbOtherPlugins.Enabled := True;
cbPackerList.ItemIndex := 0;
end;
end;
end;
procedure TPackDlg.btnConfigClick(Sender: TObject);
begin
if CurrentVFS.FindModule(edtPackCmd.Text) then
CurrentVFS.VFSmodule.VFSConfigure(Handle);
end;
procedure TPackDlg.edtPackCmdAcceptDirectory(Sender: TObject; var Value: String
);
begin
Value := IncludeTrailingPathDelimiter(Value) + ExtractFileName(edtPackCmd.Text);
end;
procedure TPackDlg.arbChange(Sender: TObject);
begin
cbPackerList.Enabled := rbOtherPlugins.Checked;
if rbOtherPlugins.Checked then
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + cbPackerList.Text)
else
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + TRadioButton(Sender).Caption);
end;
initialization
{$I fpackdlg.lrs}
end.
{
Double Commander
-------------------------------------------------------------------------
File packing window
Copyright (C) 2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fPackDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, uFileList, uVFS, EditBtn;
type
{ TPackDlg }
TPackDlg = class(TForm)
btnHelp: TButton;
btnCancel: TButton;
btnConfig: TButton;
cbCreateSeparateArchives: TCheckBox;
cbCreateSFX: TCheckBox;
cbEncrypt: TCheckBox;
cbMoveToArchive: TCheckBox;
cbMultivolume: TCheckBox;
btnOk: TButton;
edtPackCmd: TDirectoryEdit;
gbPacker: TGroupBox;
cbPackerList: TComboBox;
lblPrompt: TLabel;
cbRecurse: TCheckBox;
cbStoredir: TCheckBox;
rbOtherPlugins: TRadioButton;
procedure btnConfigClick(Sender: TObject);
procedure edtPackCmdAcceptDirectory(Sender: TObject; var Value: String);
procedure FormShow(Sender: TObject);
procedure arbChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure ShowPackFilesForm(VFS : TVFS; var fl : TFileList; sDestPath:String);
var
arbRadioButtonArray : array [0..8] of TRadioButton;
implementation
uses
uWCXhead;
var
CurrentVFS : TVFS;
procedure ShowPackFilesForm(VFS : TVFS; var fl: TFileList; sDestPath:String);
var
Flags : LongInt;
begin
with TPackDlg.Create(nil) do
begin
(* if one file selected *)
if fl.Count = 1 then
begin
edtPackCmd.Text := sDestPath + ExtractFileName(fl.GetFileName(0));
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.none');
end
else
(* if some files selected *)
begin
edtPackCmd.Text := sDestPath + ExtractFileName(ExcludeTrailingPathDelimiter(fl.CurrentDirectory)) + '.none';
end;
CurrentVFS := VFS;
if (ShowModal = mrOK) then
if VFS.FindModule(edtPackCmd.Text) then
begin
Flags := 0;
if cbMoveToArchive.Checked then Flags := Flags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then Flags := Flags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then Flags := Flags or PK_PACK_ENCRYPT;
VFS.VFSmodule.VFSCopyIn(fl, '', Flags);
end;
Free;
end;
end;
{ TPackDlg }
procedure TPackDlg.FormShow(Sender: TObject);
var
I, J : Integer;
sCurrentPlugin : String;
iCurPlugCaps : Integer;
Count : Integer;
begin
J := 0;
Count := 0;
with CurrentVFS do
begin
for I:=0 to WCXPlugins.Count -1 do
begin
if Pos('#', WCXPlugins.Names[I]) <> 0 then Continue;
sCurrentPlugin := WCXPlugins.ValueFromIndex[i];
iCurPlugCaps := StrToInt(Copy(sCurrentPlugin, 1, Pos(',',sCurrentPlugin) - 1));
if (iCurPlugCaps and PK_CAPS_NEW) = PK_CAPS_NEW then
begin
(* First 9 plugins we display as RadioButtons *)
if J < 9 then
begin
arbRadioButtonArray[J] := TRadioButton.Create(gbPacker);
arbRadioButtonArray[J].Parent := gbPacker;
arbRadioButtonArray[J].Left := 5 + 45 * (J div 3);
arbRadioButtonArray[J].Top := Count * (arbRadioButtonArray[J].Height + 4);
arbRadioButtonArray[J].Visible := True;
arbRadioButtonArray[J].Caption := WCXPlugins.Names[I];
arbRadioButtonArray[J].OnChange := @arbChange;
J := J + 1;
Count := Count + 1;
if Count > 2 then
Count := 0;
end
else
(* Other plugins we add in ComboBox *)
begin
cbPackerList.Items.Add(WCXPlugins.Names[I]);
end;
end;
end; //for
if arbRadioButtonArray[0] <> nil then
arbRadioButtonArray[0].Checked := True;
if cbPackerList.Items.Count > 0 then
begin
rbOtherPlugins.Enabled := True;
cbPackerList.ItemIndex := 0;
end;
end;
end;
procedure TPackDlg.btnConfigClick(Sender: TObject);
begin
if CurrentVFS.FindModule(edtPackCmd.Text) then
CurrentVFS.VFSmodule.VFSConfigure(Handle);
end;
procedure TPackDlg.edtPackCmdAcceptDirectory(Sender: TObject; var Value: String
);
begin
Value := IncludeTrailingPathDelimiter(Value) + ExtractFileName(edtPackCmd.Text);
end;
procedure TPackDlg.arbChange(Sender: TObject);
begin
cbPackerList.Enabled := rbOtherPlugins.Checked;
if rbOtherPlugins.Checked then
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + cbPackerList.Text)
else
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + TRadioButton(Sender).Caption);
end;
initialization
{$I fpackdlg.lrs}
end.

35
ufilepanel.pas
View file

@ -23,6 +23,8 @@ uses
type
TOnChangeDirectory = procedure (Sender: TObject; const NewDir : String) of object;
{ TFilePanel }
TFilePanel=Class
private
fOwner : TObject;
@ -56,6 +58,7 @@ type
Destructor Destroy; override;
procedure LoadPanel;
procedure LoadPanelVFS(frp:PFileRecItem);
procedure LoadVFSListInPanel;
procedure SortByCol(iCol:Integer);
procedure Sort;
procedure UpdatePanel;
@ -230,12 +233,19 @@ begin
end
else // exit from VFS
begin
fPanelMode := pmDirectory;
fActiveDir := ExtractFilePath(fVFS.ArcFullName);
ChDir(fActiveDir);
if Assigned(FOnChangeDirectory) then
FOnChangeDirectory(fOwner, fActiveDir);
LoadFilesbyDir(fActiveDir, fFileList);
case fPanelMode of
pmVFS:
LoadVFSListInPanel;
pmArchive:
begin
fPanelMode := pmDirectory;
fActiveDir := ExtractFilePath(fVFS.ArcFullName);
ChDir(fActiveDir);
if Assigned(FOnChangeDirectory) then
FOnChangeDirectory(fOwner, fActiveDir);
LoadFilesbyDir(fActiveDir, fFileList);
end;
end; // case
end;
end;
end
@ -292,6 +302,17 @@ begin
end;
end;
procedure TFilePanel.LoadVFSListInPanel;
begin
if fVFS.LoadVFSList(fFileList) then
begin
fPanelMode := pmDirectory;
fActiveDir := PathDelim;
fFileList.UpdateFileInformation(PanelMode);
Sort;
end;
end;
procedure TFilePanel.LoadPanel;
begin
@ -370,7 +391,7 @@ begin
with pfri^ do
begin
if (fPanelMode=pmVFS) then
if (fPanelMode=pmVFS) or ((sModeStr = 'wfx') and fVFS.FindModule(sPath + sName)) then
begin
LoadPanelVFS(pfri);
Exit;

64
uvfs.pas
View file

@ -37,7 +37,8 @@ type
private
procedure SetVFSModule(Value : TVFSmodule);
protected
FPlugins : TStringList;
FWCXPlugins,
FWFXPlugins : TStringList;
FCurrentPlugin : String;
sLastArchive : String;
FVFSType : TVFSType;
@ -51,10 +52,11 @@ type
function FindModule(const sFileName:String; bLoadModule : Boolean = True):Boolean;
function LoadAndOpen(const sFileName:String) : Boolean;
function LoadVFSList(var fl:TFileList) : Boolean;
property VFSType : TVFSType read FVFSType;
property VFSmodule : TVFSmodule read FVFSModule write SetVFSModule;
property ArcFullName : String read sLastArchive write sLastArchive;
property Plugins : TStringList read FPlugins;
property WCXPlugins : TStringList read FWCXPlugins;
end; //class TVFS
implementation
@ -75,8 +77,9 @@ end;
constructor TVFS.Create;
begin
FPlugins := TStringList.Create;
gIni.ReadSectionRaw('PackerPlugins', FPlugins);
FWCXPlugins := TStringList.Create;
FWFXPlugins := TStringList.Create;
gIni.ReadSectionRaw('PackerPlugins', FWCXPlugins);
sLastArchive:=''; // nothing
end;
@ -85,7 +88,8 @@ begin
if Assigned(FVFSModule) then
FVFSModule.Destroy;
FVFSModule := nil;
FreeAndNil(FPlugins);
FreeAndNil(FWCXPlugins);
FreeAndNil(FWFXPlugins);
inherited
end;
@ -123,13 +127,13 @@ begin
sExt := LowerCase(ExtractFileExt(sFileName));
sExt := copy(sExt,2,length(sExt));
DebugLN('sExt = ', sExt);
tmp := FPlugins.Values[sExt];
tmp := FWCXPlugins.Values[sExt];
//**************** Debug
//DebugLN(FPlugins.Text);
for i:=0 to FPlugins.Count -1 do
DebugLN(FPlugins.ValueFromIndex[i]);
for i:=0 to FWCXPlugins.Count -1 do
DebugLN(FWCXPlugins.ValueFromIndex[i]);
//***************
@ -151,10 +155,10 @@ begin
Result := LoadAndOpen(sLastArchive);
end;
end
else
if sExt = 'wfx' then // WFX Support
else // WFX Support
if FWFXPlugins.IndexOfName(sFileName) >=0 then
begin
FCurrentPlugin := sFileName;
FCurrentPlugin := FWFXPlugins.Values[sFileName];
FVFSType := vtWFX;
Result := True;
@ -178,9 +182,45 @@ begin
end;
Result := FVFSModule.LoadModule(FCurrentPlugin);
DebugLN(Format('After Module %s Load', [FCurrentPlugin]));
FVFSModule.VFSOpen(sLastArchive);
DebugLN('After Module Load');
end;
function TVFS.LoadVFSList(var fl: TFileList) : Boolean;
var
I, Count : Integer;
sCurrPlugin : String;
pfri : PFileRecItem;
begin
Result := True;
gIni.ReadSectionRaw('FileSystemPlugins', FWFXPlugins);
Count := FWFXPlugins.Count;
if Count = 0 then
begin
Result := False;
Exit;
end;
dec(Count);
fl.Clear;
for I := 0 to Count do
begin
if Pos('#', FWFXPlugins.Names[I]) = 0 then
begin
New(pfri);
with pfri^ do
begin
sName := FWFXPlugins.Names[I];
sNameNoExt := sName;
iMode := faFolder;
sModeStr := 'wfx';
bSelected := False;
bLinkIsDir := False;
fl.AddItem(pfri);
end;
end
end;
end;