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

FIX: Compiling errors under Linux

Browse source 
ADD: More correct extract files uses file mask
This commit is contained in:
Alexander Koblov 2007-08-16 20:42:47 +00:00
commit e67a554713
18 changed files with 960 additions and 968 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
XP.res
View file

Binary file not shown.

4
doc/INSTALL
View file

@ -2,9 +2,9 @@ Compiling Double Commander
What you need?
At first must download FreePascal. I use FPC 2.0.4 (or higher).
At first must download FreePascal. I use FPC 2.1.4 (or higher).
After this download Lazarus. I use Lazarus 0.9.22 (or higher).
After this download Lazarus. I use Lazarus 0.9.23 (or higher).
For compiling Double Commander you must install in Lazarus two component packages

1
doc/fmain.txt
View file

@ -7,3 +7,4 @@
13.08.2007 ADD: Сохранение и загрузку табов
15.08.2007 ADD: Сделал корректную синхронизацию размеров панелей дисков
15.08.2007 ADD: Сохранение состояния окна (normal, maximized)
16.08.2007 Сделал более корректной распаковку по маске

3
doc/uwcxmodule.txt
View file

@ -10,4 +10,5 @@
20.07.2007 Добавил обработку ошибок, удалил старый неиспользуемый
больше код
30.07.2007 Добавил ProgressBar для операции удаления
04.08.2007 Добавил упаковку в подкаталоги, распаковку по маске
04.08.2007 Добавил упаковку в подкаталоги, распаковку по маске
16.08.2007 Сделал более корректной распаковку по маске

182
doublecmd.lpr
View file

@ -1,91 +1,91 @@
{ $threading on}
program doublecmd;
// uGlobs must be first in uses, uLng must be before any form;
{%File 'doc/changelog.txt'}
{.$APPTYPE GUI}
uses
{$IFDEF UNIX}
cthreads,
//cwstring,
{$ENDIF}
Interfaces,
LCLProc,
uGlobsPaths,
uGlobs,
uLng,
SysUtils,
Forms,
fMain,
fAbout,
uFileList,
uFilePanel,
uFileOp,
uTypes,
framePanel,
uFileOpThread,
uFileProcs,
fFileOpDlg,
uCopyThread,
uDeleteThread,
fMkDir,
uCompareFiles,
uHighlighterProcs,
fEditor,
uMoveThread,
fMsg,
uSpaceThread,
fHotDir,
fHardLink,
fFindView,
uPathHistory,
uExts,
uLog,
uShowForm,
fEditSearch,
uColorExt,
fEditorConf,
{$IFNDEF WIN32}
uFindMmap,
fFileProperties,
uUsersGroups,
{$ENDIF}
fLinker,
fCompareFiles,
dmHigh,
uPixMapManager, uVFS,
KASComp, fbtnchangedlg, fconfigtoolbar, uWCXprototypes, uDCUtils,
fLngForm, dmDialogs, fViewer, fOptions, fCopyDlg, fMoveDlg, fFindDlg,
fSymLink, fMultiRename, fSplitter, fPackDlg, fExtractDlg;
{$IFDEF WIN32}
{$R XP.res}
{$ENDIF}
begin
// AssignFile(output, 'c:\doublecmd.log');
// Rewrite(output);
Application.Title:='Double Commander';
// try
Application.Initialize;
ThousandSeparator:=' ';
DebugLn('Double commander 0.2 alpha - Free Pascal');
DebugLn('This program is free software released under terms of GNU GPL 2');
DebugLn('(C)opyright 2006-7 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn(' and contributors (see about dialog)');
LoadPaths;
if LoadGlobs then
begin
LoadPixMapManager;
Application.CreateForm(TfrmMain, frmMain); // main form
Application.CreateForm(TdmHighl, dmHighl); // highlighters
Application.Run;
end;
{ except
on E:Exception do
Writeln('Critical unhandled exception:', E.Message);
end}
end.
{ $threading on}
program doublecmd;
// uGlobs must be first in uses, uLng must be before any form;
{%File 'doc/changelog.txt'}
{.$APPTYPE GUI}
uses
{$IFDEF UNIX}
cthreads,
//cwstring,
{$ENDIF}
Interfaces,
LCLProc,
uGlobsPaths,
uGlobs,
uLng,
SysUtils,
Forms,
fMain,
fAbout,
uFileList,
uFilePanel,
uFileOp,
uTypes,
framePanel,
uFileOpThread,
uFileProcs,
fFileOpDlg,
uCopyThread,
uDeleteThread,
fMkDir,
uCompareFiles,
uHighlighterProcs,
fEditor,
uMoveThread,
fMsg,
uSpaceThread,
fHotDir,
fHardLink,
fFindView,
uPathHistory,
uExts,
uLog,
uShowForm,
fEditSearch,
uColorExt,
fEditorConf,
{$IFNDEF WIN32}
uFindMmap,
fFileProperties,
uUsersGroups,
{$ENDIF}
fLinker,
fCompareFiles,
dmHigh,
uPixMapManager, uVFS,
KASComp, fbtnchangedlg, fconfigtoolbar, uWCXprototypes, uDCUtils,
fLngForm, dmDialogs, fViewer, fOptions, fCopyDlg, fMoveDlg, fFindDlg,
fSymLink, fMultiRename, fSplitter, fPackDlg, fExtractDlg;
{$IFDEF WIN32}
{$R XP.res}
{$ENDIF}
begin
// AssignFile(output, 'c:\doublecmd.log');
// Rewrite(output);
Application.Title:='Double Commander';
// try
Application.Initialize;
ThousandSeparator:=' ';
DebugLn('Double commander 0.2 alpha - Free Pascal');
DebugLn('This program is free software released under terms of GNU GPL 2');
DebugLn('(C)opyright 2006-7 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn(' and contributors (see about dialog)');
LoadPaths;
if LoadGlobs then
begin
LoadPixMapManager;
Application.CreateForm(TfrmMain, frmMain); // main form
Application.CreateForm(TdmHighl, dmHighl); // highlighters
Application.Run;
end;
{ except
on E:Exception do
Writeln('Critical unhandled exception:', E.Message);
end}
end.

95
fbtnchangedlg.lfm
View file

@ -1,77 +1,69 @@
object OneButtonChangeDlg: TOneButtonChangeDlg
Tag = 1
Left = 250
Left = 147
Height = 240
Top = 235
Width = 533
Top = 155
Width = 550
HelpContext = 270
HorzScrollBar.Page = 532
HorzScrollBar.Page = 549
VertScrollBar.Page = 239
ActiveControl = cbCommand
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Change single button'
ClientHeight = 240
ClientWidth = 550
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Position = poScreenCenter
object lblCommand: TLabel
Tag = 9
Left = 4
Height = 14
Top = 7
Width = 80
AutoSize = False
Caption = '&Command:'
Color = clNone
FocusControl = cbCommand
ParentColor = False
end
object lblParameters: TLabel
Tag = 10
Left = 4
Height = 14
Top = 35
Width = 80
Width = 92
AutoSize = False
Caption = '&Parameters:'
Color = clNone
FocusControl = kedtParams
ParentColor = False
end
object lblStartpath: TLabel
Tag = 11
Left = 4
Height = 14
Top = 60
Width = 80
AutoSize = False
Caption = '&Start path:'
Color = clNone
FocusControl = kedtStartpath
ParentColor = False
end
object lblIconfile: TLabel
Tag = 12
Left = 4
Height = 13
Top = 85
Width = 80
AutoSize = False
Caption = 'Icon &file:'
Color = clNone
FocusControl = kedtIconFileName
ParentColor = False
end
object lblIconX: TLabel
Tag = 13
Left = 4
Height = 14
Top = 110
Width = 45
AutoSize = False
Caption = '&Icon:'
Color = clNone
FocusControl = lblIcons
ParentColor = False
WordWrap = True
@ -83,24 +75,21 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
Width = 25
AutoSize = False
Caption = '0'
Color = clNone
ParentColor = False
WordWrap = True
end
object lblTooltip: TLabel
Tag = 14
Left = 4
Height = 14
Top = 167
Width = 80
AutoSize = False
Caption = '&Tooltip:'
Color = clNone
FocusControl = kedtToolTip
ParentColor = False
end
object cbCommand: TComboBox
Left = 85
Left = 104
Height = 21
Top = 6
Width = 298
@ -108,32 +97,30 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
DropDownCount = 20
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
TabOrder = 0
end
object btnOpenFile: TButton
Left = 384
Left = 403
Height = 22
Top = 5
Width = 25
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenFileClick
TabOrder = 1
end
object btnAddSubBar: TButton
Tag = 15
Left = 412
Height = 23
Top = 4
Width = 110
Left = 431
Height = 22
Top = 5
Width = 118
BorderSpacing.InnerBorder = 4
Caption = 'Add Subbar >>'
TabOrder = 2
end
object kedtParams: TKASEdit
Left = 85
Left = 104
Height = 21
Top = 31
Width = 298
@ -143,16 +130,15 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 3
end
object lblRunMinimized: TCheckBox
Tag = 16
Left = 387
Height = 13
Top = 34
Width = 88
Left = 406
Height = 26
Top = 32
Width = 134
Caption = 'Run mi&nimized'
TabOrder = 4
end
object kedtStartpath: TKASEdit
Left = 85
Left = 104
Height = 21
Top = 56
Width = 298
@ -162,7 +148,7 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 6
end
object kedtIconFileName: TKASEdit
Left = 85
Left = 104
Height = 21
Top = 81
Width = 298
@ -172,17 +158,17 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 7
end
object btnOpenIconFile: TButton
Left = 384
Left = 403
Height = 21
Top = 81
Width = 25
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenIconFileClick
TabOrder = 8
end
object lblIcons: TListBox
Left = 85
Left = 104
Height = 54
Top = 106
Width = 298
@ -191,9 +177,10 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
ItemHeight = 36
Style = lbOwnerDrawFixed
TabOrder = 9
TopIndex = -1
end
object kedtToolTip: TKASEdit
Left = 85
Left = 104
Height = 21
Top = 164
Width = 298
@ -203,10 +190,9 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 10
end
object btnOK: TButton
Tag = 4001
Left = 420
Height = 23
Top = 110
Left = 443
Height = 32
Top = 104
Width = 100
BorderSpacing.InnerBorder = 4
Caption = 'OK'
@ -215,10 +201,9 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 11
end
object btnCancel: TButton
Tag = 4002
Left = 420
Height = 23
Top = 136
Left = 443
Height = 32
Top = 144
Width = 100
BorderSpacing.InnerBorder = 4
Cancel = True
@ -228,21 +213,19 @@ object OneButtonChangeDlg: TOneButtonChangeDlg
TabOrder = 12
end
object btnHelp: TButton
Tag = 4003
Left = 420
Height = 23
Top = 162
Left = 443
Height = 32
Top = 184
Width = 100
BorderSpacing.InnerBorder = 4
Caption = '&Help'
TabOrder = 13
end
object lblRunMaximized: TCheckBox
Tag = 17
Left = 387
Height = 13
Top = 50
Width = 91
Left = 406
Height = 26
Top = 52
Width = 139
Caption = 'Run ma&ximized'
TabOrder = 5
end

119
fconfigtoolbar.lfm
View file

@ -1,25 +1,23 @@
object ButtonChangeDlg: TButtonChangeDlg
Tag = 1
Left = 273
Height = 281
Top = 142
Width = 562
Left = 166
Height = 304
Top = 105
Width = 578
HelpContext = 270
HorzScrollBar.Page = 561
VertScrollBar.Page = 280
HorzScrollBar.Page = 577
VertScrollBar.Page = 303
ActiveControl = btnOpenBarFile
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Change button bar'
ClientHeight = 281
ClientWidth = 562
ClientHeight = 304
ClientWidth = 578
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnShow = FormShow
Position = poScreenCenter
object lblButtonBar: TLabel
Tag = 5
Left = 6
Height = 13
Top = 5
@ -39,7 +37,6 @@ object ButtonChangeDlg: TButtonChangeDlg
Transparent = False
end
object lblCommand: TLabel
Tag = 9
Left = 4
Height = 13
Top = 87
@ -50,18 +47,16 @@ object ButtonChangeDlg: TButtonChangeDlg
ParentColor = False
end
object lblParameters: TLabel
Tag = 10
Left = 4
Height = 13
Top = 115
Width = 81
Width = 108
AutoSize = False
Caption = '&Parameters:'
FocusControl = kedtParams
ParentColor = False
end
object lblStartpath: TLabel
Tag = 11
Left = 4
Height = 13
Top = 140
@ -72,7 +67,6 @@ object ButtonChangeDlg: TButtonChangeDlg
ParentColor = False
end
object lblIconfile: TLabel
Tag = 12
Left = 4
Height = 13
Top = 165
@ -83,7 +77,6 @@ object ButtonChangeDlg: TButtonChangeDlg
ParentColor = False
end
object lblIconX: TLabel
Tag = 13
Left = 4
Height = 13
Top = 190
@ -105,7 +98,6 @@ object ButtonChangeDlg: TButtonChangeDlg
WordWrap = True
end
object lblTooltip: TLabel
Tag = 14
Left = 4
Height = 14
Top = 248
@ -116,16 +108,15 @@ object ButtonChangeDlg: TButtonChangeDlg
ParentColor = False
end
object btnOpenBarFile: TButton
Left = 394
Left = 427
Height = 21
Top = 2
Width = 24
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
TabOrder = 0
end
object btnDeleteButton: TButton
Tag = 8
Left = 4
Height = 23
Top = 52
@ -136,7 +127,6 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 2
end
object btnAddButton: TButton
Tag = 7
Left = 4
Height = 23
Top = 25
@ -147,7 +137,7 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 1
end
object cbCommand: TComboBox
Left = 85
Left = 120
Height = 21
Top = 86
Width = 298
@ -155,12 +145,11 @@ object ButtonChangeDlg: TButtonChangeDlg
DropDownCount = 20
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
TabOrder = 4
end
object btnOpenFile: TButton
Left = 384
Left = 419
Height = 22
Top = 85
Width = 24
@ -170,17 +159,16 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 5
end
object btnAddSubBar: TButton
Tag = 15
Left = 420
Height = 23
Top = 84
Width = 109
Width = 132
BorderSpacing.InnerBorder = 4
Caption = 'Add S&ubbar >>'
TabOrder = 6
end
object kedtParams: TKASEdit
Left = 85
Left = 120
Height = 21
Top = 111
Width = 298
@ -190,16 +178,15 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 7
end
object cbRunMinimized: TCheckBox
Tag = 16
Left = 387
Height = 13
Top = 114
Width = 88
Left = 422
Height = 26
Top = 110
Width = 134
Caption = 'Run mi&nimized'
TabOrder = 8
end
object kedtStartPath: TKASEdit
Left = 85
Left = 120
Height = 21
Top = 136
Width = 298
@ -209,7 +196,7 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 10
end
object kedtIconFileName: TKASEdit
Left = 85
Left = 120
Height = 21
Top = 161
Width = 298
@ -219,17 +206,17 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 11
end
object btnOpenIconFile: TButton
Left = 384
Left = 419
Height = 21
Top = 160
Width = 24
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenIconFileClick
TabOrder = 12
end
object lbIcons: TListBox
Left = 85
Left = 120
Height = 54
Top = 186
Width = 298
@ -238,9 +225,10 @@ object ButtonChangeDlg: TButtonChangeDlg
ItemHeight = 36
Style = lbOwnerDrawFixed
TabOrder = 13
TopIndex = -1
end
object kedtToolTip: TKASEdit
Left = 85
Left = 120
Height = 21
Top = 245
Width = 298
@ -250,10 +238,9 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 14
end
object btnOK: TButton
Tag = 4001
Left = 420
Height = 23
Top = 187
Left = 455
Height = 32
Top = 186
Width = 109
BorderSpacing.InnerBorder = 4
Caption = 'OK'
@ -262,10 +249,9 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 15
end
object btnCancel: TButton
Tag = 4002
Left = 420
Height = 23
Top = 213
Left = 455
Height = 32
Top = 224
Width = 109
BorderSpacing.InnerBorder = 4
Cancel = True
@ -274,35 +260,31 @@ object ButtonChangeDlg: TButtonChangeDlg
TabOrder = 17
end
object btnHelp: TButton
Tag = 4003
Left = 420
Height = 23
Top = 239
Left = 455
Height = 32
Top = 262
Width = 109
BorderSpacing.InnerBorder = 4
Caption = '&Help'
TabOrder = 16
end
object cbRunMaximized: TCheckBox
Tag = 17
Left = 387
Height = 13
Left = 422
Height = 26
Top = 130
Width = 91
Width = 139
Caption = 'Run ma&ximized'
TabOrder = 9
end
object gbGroupBox: TGroupBox
Tag = 18
Left = 420
Height = 77
Width = 113
Left = 455
Height = 82
Width = 121
Caption = 'Appearance'
ClientHeight = 59
ClientWidth = 109
ClientHeight = 61
ClientWidth = 117
TabOrder = 3
object lblSize: TLabel
Tag = 6
Left = 6
Height = 14
Top = 7
@ -322,34 +304,33 @@ object ButtonChangeDlg: TButtonChangeDlg
Text = '0'
end
object cbFlatIcons: TCheckBox
Tag = 19
Left = 6
Height = 13
Height = 26
Top = 18
Width = 65
Width = 96
Caption = 'F&lat icons'
Checked = True
State = cbChecked
TabOrder = 1
end
object cbSmallIcons: TCheckBox
Tag = 20
Left = 6
Height = 13
Height = 26
Top = 38
Width = 73
Width = 109
Caption = 'S&mall icons'
TabOrder = 2
end
end
object tbScrollBox: TScrollBox
Left = 86
Left = 121
Height = 50
Top = 25
Width = 330
AutoScroll = True
TabOrder = 18
object ktbBar: TKAStoolBar
Left = 1
Height = 23
Width = 296
BevelOuter = bvNone
@ -362,6 +343,6 @@ object ButtonChangeDlg: TButtonChangeDlg
Title = 'Îòêðûòü ñóùåñòâóþùèé ôàéë'
FilterIndex = 0
left = 8
top = 535
top = 277
end
end

91
fextractdlg.lfm
View file

@ -1,24 +1,22 @@
object ExtractDlg: TExtractDlg
Tag = 1
Left = 309
Height = 168
Height = 183
Top = 176
Width = 400
HelpContext = 160
HorzScrollBar.Page = 399
VertScrollBar.Page = 167
ActiveControl = edtExtractTo
VertScrollBar.Page = 182
ActiveControl = cbFileMask
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Unpack files'
ClientHeight = 168
ClientHeight = 183
ClientWidth = 400
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Position = poScreenCenter
object lblExtractTo: TLabel
Tag = 2
Left = 4
Height = 16
Top = 5
@ -28,7 +26,6 @@ object ExtractDlg: TExtractDlg
ParentColor = False
end
object lblFileMask: TLabel
Tag = 3
Left = 4
Height = 16
Top = 51
@ -38,15 +35,6 @@ object ExtractDlg: TExtractDlg
FocusControl = cbFileMask
ParentColor = False
end
object edtExtractTo: TEdit
Left = 4
Height = 21
Top = 26
Width = 385
Font.Height = -11
Font.Name = 'MS Sans Serif'
TabOrder = 0
end
object cbFileMask: TComboBox
Left = 134
Height = 21
@ -55,80 +43,79 @@ object ExtractDlg: TExtractDlg
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
TabOrder = 1
TabOrder = 0
Text = '*.*'
end
object cbExtractPath: TCheckBox
Tag = 4
Left = 4
Height = 13
Height = 26
Top = 73
Width = 199
Width = 303
Caption = '&Unpack path names if stored with files'
TabOrder = 2
Checked = True
Enabled = False
State = cbChecked
TabOrder = 1
end
object cbOverwrite: TCheckBox
Tag = 5
Left = 4
Height = 13
Top = 92
Width = 124
Height = 26
Top = 95
Width = 188
Caption = '&Overwrite existing files'
TabOrder = 3
Checked = True
Enabled = False
State = cbChecked
TabOrder = 2
end
object btnOK: TButton
Tag = 4001
Left = 39
Left = 128
Height = 32
Top = 129
Top = 145
Width = 85
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 5
end
object btnTree: TButton
Tag = 6
Left = 128
Height = 32
Top = 129
Width = 85
BorderSpacing.InnerBorder = 4
Caption = '&Tree'
TabOrder = 6
TabOrder = 4
end
object btnCancel: TButton
Tag = 4002
Left = 216
Height = 32
Top = 129
Top = 145
Width = 85
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 7
TabOrder = 5
end
object btnHelp: TButton
Tag = 4003
Left = 305
Height = 32
Top = 128
Top = 145
Width = 85
BorderSpacing.InnerBorder = 4
Caption = 'Help'
TabOrder = 8
TabOrder = 6
end
object cbInSeparateFolder: TCheckBox
Tag = 7
Left = 4
Height = 13
Top = 111
Width = 322
Height = 26
Top = 117
Width = 488
Caption = 'Unpack each archive to a &separate subdir (name of the archive)'
TabOrder = 4
TabOrder = 3
end
object edtExtractTo: TDirectoryEdit
Left = 4
Height = 23
Top = 24
Width = 364
ButtonWidth = 23
NumGlyphs = 1
ParentColor = False
TabOrder = 7
end
end

49
fextractdlg.pas
View file

@ -28,22 +28,22 @@ unit fExtractDlg;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, uVFS, uFileList;
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, uVFS, uFileList, framePanel,
EditBtn;
type
{ TExtractDlg }
TExtractDlg = class(TForm)
edtExtractTo: TDirectoryEdit;
lblExtractTo : TLabel;
edtExtractTo : TEdit;
lblFileMask : TLabel;
cbFileMask : TComboBox;
cbExtractPath : TCheckBox;
cbOverwrite : TCheckBox;
cbInSeparateFolder : TCheckBox;
btnOK : TButton;
btnTree : TButton;
btnCancel : TButton;
btnHelp : TButton;
private
@ -55,14 +55,16 @@ TExtractDlg = class(TForm)
var
ExtractDlg: TExtractDlg;
procedure ShowExtractDlg(VFS : TVFS; var fl : TFileList; sDestPath:String);
procedure ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl : TFileList; sDestPath:String);
implementation
uses
uTypes, uDCUtils;
var
CurrentVFS : TVFS;
procedure ShowExtractDlg(VFS : TVFS; var fl: TFileList; sDestPath: String);
procedure ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl: TFileList; sDestPath: String);
var
I : Integer;
ExtractFileList : TFileList;
@ -70,19 +72,42 @@ begin
with TExtractDlg.Create(nil) do
begin
edtExtractTo.Text := sDestPath;
CurrentVFS := VFS;
CurrentVFS := ActiveFrame.pnlFile.VFS;
if ActiveFrame.pnlFile.PanelMode = pmArchive then
cbInSeparateFolder.Visible := False;
if (ShowModal = mrOK) then
begin
sDestPath := IncludeTrailingPathDelimiter(edtExtractTo.Text) + cbFileMask.Text;
ExtractFileList := TFileList.Create;
ExtractFileList.CurrentDirectory := PathDelim;
for I := 0 to fl.Count - 1 do
if VFS.FindModule(fl.GetFileName(I)) then
// if in archive
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
VFS.VFSmodule.VFSList(PathDelim, ExtractFileList); // select all files
VFS.VFSmodule.VFSCopyOutEx(ExtractFileList, sDestPath, 0);
if CurrentVFS.FindModule(CurrentVFS.ArcFullName) then
CurrentVFS.VFSmodule.VFSCopyOutEx(fl, sDestPath, 0);
end;
end;
// if in real directory
if ActiveFrame.pnlFile.PanelMode = pmDirectory then
for I := 0 to fl.Count - 1 do // extract all selected archives
if CurrentVFS.FindModule(fl.GetFileName(I)) then
begin
ExtractFileList := TFileList.Create;
ExtractFileList.CurrentDirectory := PathDelim;
// if each archive in separate folder
if cbInSeparateFolder.Checked then
begin
sDestPath := IncludeTrailingPathDelimiter(edtExtractTo.Text);
sDestPath := sDestPath + ExtractOnlyFileName(CurrentVFS.ArcFullName) + PathDelim + cbFileMask.Text;
end;
// select all files and extract
CurrentVFS.VFSmodule.VFSList(PathDelim, ExtractFileList);
CurrentVFS.VFSmodule.VFSCopyOut(ExtractFileList, sDestPath, 0);
end;
end; // ShowModal
Free;
end;
end;

26
fmain.lfm
View file

@ -1,14 +1,14 @@
inherited frmMain: TfrmMain
Left = 222
Left = 238
Height = 336
Top = 57
Top = 297
Width = 525
HorzScrollBar.Page = 524
VertScrollBar.Page = 315
VertScrollBar.Page = 316
VertScrollBar.Range = 79
ActiveControl = pnlNotebooks
Caption = 'Double Commander'
ClientHeight = 316
ClientHeight = 317
ClientWidth = 525
Font.Color = clBlack
Font.Height = 13
@ -79,7 +79,7 @@ inherited frmMain: TfrmMain
end
object pnlCommand: TPanel
Height = 62
Top = 254
Top = 255
Width = 525
Align = alBottom
Anchors = [akLeft, akRight]
@ -209,18 +209,18 @@ inherited frmMain: TfrmMain
end
end
object pnlNotebooks: TPanel
Height = 205
Height = 206
Top = 49
Width = 525
Align = alClient
ClientHeight = 205
ClientHeight = 206
ClientWidth = 525
FullRepaint = False
TabOrder = 2
TabStop = True
object nbLeft: TNotebook
Left = 1
Height = 203
Height = 204
Top = 1
Width = 391
Align = alLeft
@ -230,14 +230,14 @@ inherited frmMain: TfrmMain
end
object MainSplitter: TSplitter
Left = 392
Height = 203
Height = 204
Top = 1
Width = 4
ResizeStyle = rsLine
end
object nbRight: TNotebook
Left = 396
Height = 203
Height = 204
Top = 1
Width = 128
Align = alClient
@ -295,6 +295,10 @@ inherited frmMain: TfrmMain
Action = actPackFiles
OnClick = actPackFilesExecute
end
object mnuExtractFiles: TMenuItem
Action = actExtractFiles
OnClick = actExtractFilesExecute
end
object mnuFilesSplit: TMenuItem
Action = actFileSpliter
OnClick = actFileSpliterExecute
@ -770,7 +774,7 @@ inherited frmMain: TfrmMain
end
object actExtractFiles: TAction
Category = 'File'
Caption = 'Extract files'
Caption = 'Extract files...'
DisableIfNoHandler = True
OnExecute = actExtractFilesExecute
ShortCut = 32888

19
fmain.pas
View file

@ -61,6 +61,7 @@ type
dskLeft: TKAStoolBar;
dskRight: TKAStoolBar;
MainToolBar: TKASToolBar;
mnuExtractFiles: TMenuItem;
pnlDisk: TPanel;
tbDelete: TMenuItem;
tbEdit: TMenuItem;
@ -365,7 +366,7 @@ begin
fl.CurrentDirectory := ActiveDir;
end;
try
ShowExtractDlg(ActiveFrame.pnlFile.VFS, fl, NotActiveFrame.ActiveDir);
ShowExtractDlg(ActiveFrame, fl, NotActiveFrame.ActiveDir);
finally
frameLeft.RefreshPanel;
frameRight.RefreshPanel;
@ -1764,7 +1765,17 @@ begin
else
sDestPath:=sDestPath+'*.*';
(* Extract files from archive *)
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
DebugLN('+++ Extract files from archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ShowExtractDlg(ActiveFrame, fl, ExtractFilePath(sDestPath));
NotActiveFrame.RefreshPanel;
Exit;
end;
with TfrmCopyDlg.Create(Application) do
begin
try
@ -1795,7 +1806,7 @@ begin
(* Check active panel *)
try
(*Copy files from VFS*)
if ActiveFrame.pnlFile.PanelMode in [pmArchive, pmVFS] then
if ActiveFrame.pnlFile.PanelMode = pmVFS then
begin
DebugLN('+++ Copy files from VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
@ -2262,6 +2273,8 @@ begin
Init;
ReAlign;
pnlFile.OnChangeDirectory := @FramepnlFileChangeDirectory;
if not DirectoryExists(sPath) then
GetDir(0, sPath);
pnlFile.ActiveDir := sPath;
pnlFile.LoadPanel;
UpDatelblInfo;

150
fpackdlg.lfm
View file

@ -1,24 +1,22 @@
object PackDlg: TPackDlg
Tag = 1
Left = 243
Height = 202
Top = 185
Left = 223
Height = 220
Top = 216
Width = 517
HelpContext = 150
HorzScrollBar.Page = 516
VertScrollBar.Page = 201
ActiveControl = edtPackCmd
VertScrollBar.Page = 219
ActiveControl = cbStoredir
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Pack files'
ClientHeight = 202
ClientHeight = 220
ClientWidth = 517
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnShow = FormShow
Position = poScreenCenter
object lblPrompt: TLabel
Tag = 2
Left = 4
Height = 12
Top = 2
@ -31,97 +29,71 @@ object PackDlg: TPackDlg
ParentColor = False
ShowAccelChar = False
end
object edtPackCmd: TEdit
Left = 4
Height = 21
Top = 19
Width = 340
Font.Height = -11
Font.Name = 'MS Sans Serif'
TabOrder = 0
end
object cbStoredir: TCheckBox
Tag = 3
Left = 4
Height = 13
Height = 30
Top = 43
Width = 197
Width = 301
Caption = 'Also &pack path names (only recursed)'
Checked = True
State = cbChecked
TabOrder = 1
TabOrder = 0
end
object cbRecurse: TCheckBox
Tag = 4
Left = 4
Height = 13
Top = 59
Width = 170
Height = 26
Top = 63
Width = 252
Caption = 'Recursively pack &subdirectories'
Checked = True
Enabled = False
State = cbChecked
TabOrder = 2
TabOrder = 1
end
object cbMultivolume: TCheckBox
Tag = 5
Left = 4
Height = 13
Top = 75
Width = 116
Height = 26
Top = 83
Width = 170
Caption = '&Multiple disk archive'
Enabled = False
TabOrder = 3
TabOrder = 2
end
object btnOk: TButton
Tag = 4001
Left = 119
Left = 213
Height = 32
Top = 157
Top = 181
Width = 90
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 8
end
object btnTree: TButton
Tag = 7
Left = 213
Height = 32
Top = 157
Width = 90
BorderSpacing.InnerBorder = 4
Caption = 'Tree'
TabOrder = 9
TabOrder = 7
end
object btnCancel: TButton
Tag = 4002
Left = 307
Height = 32
Top = 157
Top = 181
Width = 90
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 10
TabOrder = 8
end
object gbPacker: TGroupBox
Tag = 8
Left = 348
Height = 133
Top = 17
Top = 16
Width = 142
Caption = ' Packer '
ClientHeight = 115
ClientHeight = 112
ClientWidth = 138
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'MS Sans Serif'
TabOrder = 12
TabOrder = 10
object btnConfig: TButton
Tag = 6
Left = 5
Height = 32
Top = 80
@ -132,26 +104,26 @@ object PackDlg: TPackDlg
TabOrder = 2
end
object rbOtherPlugins: TRadioButton
Tag = 9
Left = 5
Height = 13
Height = 24
Top = 51
Width = 29
Width = 42
Caption = '&->'
Checked = True
Enabled = False
OnChange = arbChange
State = cbChecked
TabOrder = 0
end
object cbPackerList: TComboBox
Left = 40
Left = 45
Height = 21
Top = 49
Top = 51
Width = 69
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Enabled = False
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
OnChange = arbChange
Style = csDropDownList
@ -159,51 +131,57 @@ object PackDlg: TPackDlg
end
end
object cbMoveToArchive: TCheckBox
Tag = 9
Left = 4
Height = 13
Top = 91
Width = 97
Height = 26
Top = 103
Width = 141
Caption = 'M&ove to archive'
TabOrder = 4
TabOrder = 3
end
object cbCreateSFX: TCheckBox
Tag = 10
Left = 4
Height = 13
Top = 107
Width = 157
Height = 26
Top = 123
Width = 237
Caption = 'Create self e&xtracting archive'
Enabled = False
TabOrder = 5
TabOrder = 4
end
object btnHelp: TButton
Tag = 4003
Left = 401
Height = 32
Top = 157
Top = 181
Width = 90
BorderSpacing.InnerBorder = 4
Caption = 'Help'
TabOrder = 11
TabOrder = 9
end
object cbEncrypt: TCheckBox
Tag = 11
Left = 4
Height = 13
Top = 139
Width = 56
Height = 29
Top = 163
Width = 82
Caption = 'Encr&ypt'
TabOrder = 7
end
object cbCreateSeparateArchives: TCheckBox
Tag = 12
Left = 4
Height = 13
Top = 123
Width = 255
Caption = 'Create separate archives, o&ne per selected file/dir'
Enabled = False
TabOrder = 6
end
object cbCreateSeparateArchives: TCheckBox
Left = 4
Height = 26
Top = 143
Width = 384
Caption = 'Create separate archives, o&ne per selected file/dir'
Enabled = False
TabOrder = 5
end
object edtPackCmd: TDirectoryEdit
Left = 4
Height = 23
Top = 16
Width = 312
OnAcceptDirectory = edtPackCmdAcceptDirectory
ButtonWidth = 23
NumGlyphs = 1
ParentColor = False
TabOrder = 11
end
end

364
fpackdlg.pas
View file

@ -1,179 +1,185 @@
{
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;
type
{ TPackDlg }
TPackDlg = class(TForm)
btnHelp: TButton;
btnCancel: TButton;
btnConfig: TButton;
cbCreateSeparateArchives: TCheckBox;
cbCreateSFX: TCheckBox;
cbEncrypt: TCheckBox;
btnTree: TButton;
cbMoveToArchive: TCheckBox;
cbMultivolume: TCheckBox;
btnOk: TButton;
gbPacker: TGroupBox;
cbPackerList: TComboBox;
lblPrompt: TLabel;
cbRecurse: TCheckBox;
cbStoredir: TCheckBox;
edtPackCmd: TEdit;
rbOtherPlugins: TRadioButton;
procedure btnConfigClick(Sender: TObject);
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.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 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.

19
ufilelist.pas
View file

@ -56,7 +56,7 @@ Type
function GetFileName(iIndex: Integer): String;
Function CheckFileName(const sFileName:String):Integer;
procedure UpdateFileInformation(PanelMode: TPanelMode);
procedure Sort(SortBy:Integer; bDirection:Boolean); overload;
procedure Sort(SortBy:Integer; bDirection, bCaseSensitive:Boolean); overload;
property Count : Integer read GetCount;
property CurrentDirectory : String read fDir write fDir;
@ -79,7 +79,8 @@ uses
uGlobs, uPixmapManager, uOSUtils;
var
bSortNegative:Boolean; // because implementation of TList.Sort
bSortNegative : Boolean; // because implementation of TList.Sort
bCaseSensSort : Boolean;
{
class constructor
@ -194,9 +195,10 @@ end;
{
Sort files by the default value in SortCol (e.g. SortIn) variable.
}
procedure TFileList.Sort(SortBy:Integer; bDirection:Boolean);
procedure TFileList.Sort(SortBy:Integer; bDirection, bCaseSensitive:Boolean);
begin
bSortNegative:=bDirection;
bCaseSensSort := bCaseSensitive;
if fList.Count=0 then Exit;
case SortBy of
SF_BYNAME: fList.Sort(@ICompareByName);
@ -269,7 +271,10 @@ begin
Result:=0; // used in by Attr, or Date
Exit;
end;
Result:=StrComp(PChar(item1^.sName), PChar(item2^.sName));
if bCaseSensSort then
Result:=StrComp(PChar(item1^.sName), PChar(item2^.sName))
else
Result := StrIComp(PChar(item1^.sName), PChar(item2^.sName));
if bSortNegative then
Result:=-Result;
end;
@ -284,8 +289,10 @@ begin
Result:= ICompareCheckDir(PFileRecItem(item1),PFileRecItem(item2));
if Result<>0 then Exit;
Result:=StrComp(PChar(PFileRecItem(item1)^.sName),PChar(PFileRecItem(item2)^.sName));
if bCaseSensSort then
Result:=StrComp(PChar(PFileRecItem(item1)^.sName),PChar(PFileRecItem(item2)^.sName))
else
Result:=StrIComp(PChar(PFileRecItem(item1)^.sName),PChar(PFileRecItem(item2)^.sName));
{ if FileRecPtr(item1)^.fName = FileRecPtr(item2)^.fName then
Exit;

2
ufilepanel.pas
View file

@ -278,7 +278,7 @@ end;
procedure TFilePanel.Sort;
begin
fFileList.Sort(fSortCol, fSortDirect);
fFileList.Sort(fSortCol, fSortDirect, gCaseSensitiveSort);
UpDatePanel;
end;

6
ufindthread.pas
View file

@ -119,11 +119,7 @@ begin
FCaseSens:=True;
FFilesScaned:=0;
FilterMask:='*';
{$IFDEF WIN32}
FPathStart:='C:\';
{$ELSE}
FPathStart:='/';
{$ENDIF}
GetDir(0, FPathStart);
FItems:=Nil;
FIsDateFrom := False;
FIsDateTo := False;

772
uosforms.pas
View file

@ -1,386 +1,386 @@
{
Double Commander
-------------------------------------------------------------------------
This unit contains platform depended functions.
Copyright (C) 2006-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 uOSForms;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, uTypes, uFileList, Menus,
{$IFDEF UNIX}
fFileProperties;
{$ELSE}
Windows, Messages, ShellApi, ShlObj, ActiveX, uShlObjAdditional, JwaShlGuid;
{$ENDIF}
const
sCmdVerbOpen = 'open';
sCmdVerbRename = 'rename';
sCmdVerbDelete = 'delete';
sCmdVerbPaste = 'paste';
type
TContextMenu = class(TPopupMenu)
procedure ContextMenuSelect(Sender:TObject);
end;
procedure SetMyWndProc(Handle : THandle);
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
procedure ShowContextMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
implementation
uses
fMain, uVFSutil, uOSUtils, uExts, uGlobs, JwaDbt;
var
{$IFDEF MSWINDOWS}
OldWProc: WNDPROC;
ICM2: IContextMenu2 = nil;
{$ELSE}
CM : TContextMenu = nil;
{$ENDIF}
{$IFDEF MSWINDOWS}
function MyWndProc(hwnd: HWND; Msg, wParam, lParam: Cardinal): Cardinal; stdcall;
begin
case Msg of
(* For working wuth submenu of contex menu *)
WM_INITMENUPOPUP,
WM_DRAWITEM,
WM_MENUCHAR,
WM_MEASUREITEM:
if Assigned(ICM2) then
begin
ICM2.HandleMenuMsg(Msg, wParam, lParam);
Result := 0;
end
else
Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
WM_DEVICECHANGE:
if (wParam = DBT_DEVICEARRIVAL) or (wParam = DBT_DEVICEREMOVECOMPLETE) then
frmMain.UpdateDiskCount;
else
Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
end; // case
end;
{$ENDIF}
procedure SetMyWndProc(Handle : THandle);
{$IFDEF MSWINDOWS}
begin
OldWProc := WNDPROC(SetWindowLong(Handle, GWL_WNDPROC, Integer(@MyWndProc)));
end;
{$ELSE}
begin
end;
{$ENDIF}
(* handling user commands from context menu *)
procedure TContextMenu.ContextMenuSelect(Sender:TObject);
var
sCmd:String;
begin
// ShowMessage((Sender as TMenuItem).Hint);
sCmd:=(Sender as TMenuItem).Hint;
with frmMain.ActiveFrame do
begin
if Pos('{!VFS}',sCmd)>0 then
begin
pnlFile.LoadPanelVFS(PFileRecItem((Sender as TMenuItem).Tag));
Exit;
end;
if not pnlFile.ProcessExtCommand(sCmd) then
frmMain.ExecCmd(sCmd);
end;
end;
procedure ShowContextMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
var
fri : TFileRecItem;
{$IFDEF MSWINDOWS}
desktop: IShellFolder;
mycomputer: IShellFolder;
folder: IShellFolder;
pidl: PItemIDList;
malloc: IMalloc;
chEaten: ULONG;
dwAttributes: ULONG;
contMenu: IContextMenu;
menu: HMENU;
cmd: UINT;
iCmd: Integer;
HR: HResult;
cmici: CMINVOKECOMMANDINFO;
pwPath,
pwFileName : PWideChar;
bHandled : Boolean;
ZVerb: array[0..255] of char;
sVerb : String;
{$ELSE}
mi, miActions : TMenuItem;
i:Integer;
sCmd:String;
sl: TStringList;
{$ENDIF}
begin
fri := pfri^;
if fri.sName = '..' then
begin
fri.sName := ExtractFileName(ExcludeTrailingPathDelimiter(fri.sPath));
fri.sPath := LowDirLevel(fri.sPath);
end;
{$IFDEF MSWINDOWS}
OleCheck( SHGetMalloc(malloc) );
OleCheck( SHGetDesktopFolder(desktop) );
OleCheck( SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, pidl) );
try
OleCheck( desktop.BindToObject(pidl, nil, IShellFolder, mycomputer) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
pwPath := StringToOleStr(fri.sPath);
OleCheck( mycomputer.ParseDisplayName(Handle, nil, pwPath, chEaten, pidl, dwAttributes) );
try
OleCheck( mycomputer.BindToObject(pidl, nil, IShellFolder, folder) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
pwFileName := StringToOleStr(fri.sName);
OleCheck( folder.ParseDisplayName(Handle, nil, pwFileName, chEaten, pidl, dwAttributes) );
try
OleCheck( folder.GetUIObjectOf(Handle, 1, pidl, IID_IContextMenu, nil, contMenu) );
finally
malloc.Free(pidl);
end;
menu := CreatePopupMenu;
try
OleCheck( contMenu.QueryContextMenu(menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME) );
AppendMenu(menu,0,0,'Test');
contMenu.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus.
cmd := UINT(TrackPopupMenu(menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, X, Y, 0, Handle, nil));
finally
DestroyMenu(menu);
ICM2 := nil;
end;
if cmd > 0 then
begin
iCmd := LongInt(Cmd) - 1;
HR := contMenu.GetCommandString(iCmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
sVerb := StrPas(ZVerb);
bHandled := False;
if SameText(sVerb, sCmdVerbRename) then
begin
frmMain.RenameFile('');
bHandled := True;
end
else if SameText(sVerb, sCmdVerbOpen) then
begin
if FPS_ISDIR(fri.iMode) or (fri.bLinkIsDir) then
begin
if pfri^.sName = '..' then
frmMain.ActiveFrame.pnlFile.cdUpLevel
else
frmMain.ActiveFrame.pnlFile.cdDownLevel(@fri);
bHandled := True;
end;
end;
if not bHandled then
begin
FillChar(cmici, SizeOf(cmici), #0);
with cmici do
begin
cbSize := sizeof(cmici);
hwnd := Handle;
lpVerb := PChar(cmd - 1);
nShow := SW_NORMAL;
end;
OleCheck( contMenu.InvokeCommand(cmici) );
end;
if SameText(sVerb, sCmdVerbDelete) or SameText(sVerb, sCmdVerbPaste) then
frmMain.ActiveFrame.RefreshPanel;
end; // if cmd > 0
end;
{$ELSE}
if not Assigned(CM) then
CM := TContextMenu.Create(nil)
else
CM.Items.Clear;
mi:=TMenuItem.Create(CM);
mi.Caption:='Open...';
mi.Hint := 'open';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
miActions:=TMenuItem.Create(CM);
miActions.Caption:='Actions';
CM.Items.Add(miActions);
{ Actions submenu }
// Read actions from doublecmd.ext
sl:=TStringList.Create;
try
if FPS_ISDIR(fri.iMode) or (fri.bIsLink) then Exit;
if gExts.GetExtCommands(lowercase(ExtractFileExt(fri.sName)),sl) then
begin
//founded any commands
for i:=0 to sl.Count-1 do
begin
sCmd:=sl.Strings[i];
if pos('VIEW=',sCmd)>0 then Continue; // view command is only for viewer
frmMain.ActiveFrame.pnlFile.ReplaceExtCommand(sCmd, @fri);
mi:=TMenuItem.Create(miActions);
mi.Caption:=sCmd;
mi.Hint:=Copy(sCmd, pos('=',sCmd)+1, length(sCmd));
// length is bad, but in Copy is corrected
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
mi.Tag:=Integer(@fri);
miActions.Add(mi);
end;
end;
// now add delimiter
mi:=TMenuItem.Create(miActions);
mi.Caption:='-';
miActions.Add(mi);
// now add VIEW item
mi:=TMenuItem.Create(miActions);
mi.Caption:='{!VIEWER}' + fri.sPath + fri.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
miActions.Add(mi);
// now add EDITconfigure item
mi:=TMenuItem.Create(miActions);
mi.Caption:='{!EDITOR}' + fri.sPath + fri.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
miActions.Add(mi);
finally
FreeAndNil(sl);
end;
{ /Actions submenu }
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Cut';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Copy';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Delete';
mi.Hint := 'actDelete';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Rename';
mi.Hint := 'actShiftF6';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Properties';
mi.Hint := 'actFileProperties';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
CM.PopUp(X, Y);
end;
{$ENDIF}
(* Show file properties dialog *)
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
{$IFDEF UNIX}
begin
ShowFileProperties(FileList, aPath);
end;
{$ELSE}
var
SExInfo: TSHELLEXECUTEINFO;
Error: LongInt;
iCurrent : Integer;
FName : String;
(* Find first selected file *)
function FindNextSelected:Boolean;
var
i:Integer;
begin
for i:=iCurrent to FileList.Count-1 do
begin
if FileList.GetItem(i)^.bSelected then
begin
iCurrent:=i;
Result:=True;
Exit;
end;
end;
Result:=False;
end;
begin
iCurrent := 0;
if FindNextSelected then
begin
FName := aPath + FileList.GetItem(iCurrent)^.sName;
//DebugLN(FName);
ZeroMemory(Addr(SExInfo),SizeOf(SExInfo));
SExInfo.cbSize := SizeOf(SExInfo);
SExInfo.lpFile := PChar(FName);
SExInfo.lpVerb := 'properties';
SExInfo.fMask := SEE_MASK_INVOKEIDLIST;
ShellExecuteExA(Addr(SExInfo));
end;
end;
{$ENDIF}
end.
{
Double Commander
-------------------------------------------------------------------------
This unit contains platform depended functions.
Copyright (C) 2006-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 uOSForms;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, uTypes, uFileList, Menus,
{$IFDEF UNIX}
fFileProperties;
{$ELSE}
Windows, Messages, ShellApi, ShlObj, ActiveX, uShlObjAdditional, JwaShlGuid, JwaDbt;
{$ENDIF}
const
sCmdVerbOpen = 'open';
sCmdVerbRename = 'rename';
sCmdVerbDelete = 'delete';
sCmdVerbPaste = 'paste';
type
TContextMenu = class(TPopupMenu)
procedure ContextMenuSelect(Sender:TObject);
end;
procedure SetMyWndProc(Handle : THandle);
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
procedure ShowContextMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
implementation
uses
fMain, uVFSutil, uOSUtils, uExts, uGlobs;
var
{$IFDEF MSWINDOWS}
OldWProc: WNDPROC;
ICM2: IContextMenu2 = nil;
{$ELSE}
CM : TContextMenu = nil;
{$ENDIF}
{$IFDEF MSWINDOWS}
function MyWndProc(hwnd: HWND; Msg, wParam, lParam: Cardinal): Cardinal; stdcall;
begin
case Msg of
(* For working wuth submenu of contex menu *)
WM_INITMENUPOPUP,
WM_DRAWITEM,
WM_MENUCHAR,
WM_MEASUREITEM:
if Assigned(ICM2) then
begin
ICM2.HandleMenuMsg(Msg, wParam, lParam);
Result := 0;
end
else
Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
WM_DEVICECHANGE:
if (wParam = DBT_DEVICEARRIVAL) or (wParam = DBT_DEVICEREMOVECOMPLETE) then
frmMain.UpdateDiskCount;
else
Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
end; // case
end;
{$ENDIF}
procedure SetMyWndProc(Handle : THandle);
{$IFDEF MSWINDOWS}
begin
OldWProc := WNDPROC(SetWindowLong(Handle, GWL_WNDPROC, Integer(@MyWndProc)));
end;
{$ELSE}
begin
end;
{$ENDIF}
(* handling user commands from context menu *)
procedure TContextMenu.ContextMenuSelect(Sender:TObject);
var
sCmd:String;
begin
// ShowMessage((Sender as TMenuItem).Hint);
sCmd:=(Sender as TMenuItem).Hint;
with frmMain.ActiveFrame do
begin
if Pos('{!VFS}',sCmd)>0 then
begin
pnlFile.LoadPanelVFS(PFileRecItem((Sender as TMenuItem).Tag));
Exit;
end;
if not pnlFile.ProcessExtCommand(sCmd) then
frmMain.ExecCmd(sCmd);
end;
end;
procedure ShowContextMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
var
fri : TFileRecItem;
{$IFDEF MSWINDOWS}
desktop: IShellFolder;
mycomputer: IShellFolder;
folder: IShellFolder;
pidl: PItemIDList;
malloc: IMalloc;
chEaten: ULONG;
dwAttributes: ULONG;
contMenu: IContextMenu;
menu: HMENU;
cmd: UINT;
iCmd: Integer;
HR: HResult;
cmici: CMINVOKECOMMANDINFO;
pwPath,
pwFileName : PWideChar;
bHandled : Boolean;
ZVerb: array[0..255] of char;
sVerb : String;
{$ELSE}
mi, miActions : TMenuItem;
i:Integer;
sCmd:String;
sl: TStringList;
{$ENDIF}
begin
fri := pfri^;
if fri.sName = '..' then
begin
fri.sName := ExtractFileName(ExcludeTrailingPathDelimiter(fri.sPath));
fri.sPath := LowDirLevel(fri.sPath);
end;
{$IFDEF MSWINDOWS}
OleCheck( SHGetMalloc(malloc) );
OleCheck( SHGetDesktopFolder(desktop) );
OleCheck( SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, pidl) );
try
OleCheck( desktop.BindToObject(pidl, nil, IShellFolder, mycomputer) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
pwPath := StringToOleStr(fri.sPath);
OleCheck( mycomputer.ParseDisplayName(Handle, nil, pwPath, chEaten, pidl, dwAttributes) );
try
OleCheck( mycomputer.BindToObject(pidl, nil, IShellFolder, folder) );
finally
malloc.Free(pidl);
end;
dwAttributes := 0;
pwFileName := StringToOleStr(fri.sName);
OleCheck( folder.ParseDisplayName(Handle, nil, pwFileName, chEaten, pidl, dwAttributes) );
try
OleCheck( folder.GetUIObjectOf(Handle, 1, pidl, IID_IContextMenu, nil, contMenu) );
finally
malloc.Free(pidl);
end;
menu := CreatePopupMenu;
try
OleCheck( contMenu.QueryContextMenu(menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME) );
AppendMenu(menu,0,0,'Test');
contMenu.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus.
cmd := UINT(TrackPopupMenu(menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, X, Y, 0, Handle, nil));
finally
DestroyMenu(menu);
ICM2 := nil;
end;
if cmd > 0 then
begin
iCmd := LongInt(Cmd) - 1;
HR := contMenu.GetCommandString(iCmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
sVerb := StrPas(ZVerb);
bHandled := False;
if SameText(sVerb, sCmdVerbRename) then
begin
frmMain.RenameFile('');
bHandled := True;
end
else if SameText(sVerb, sCmdVerbOpen) then
begin
if FPS_ISDIR(fri.iMode) or (fri.bLinkIsDir) then
begin
if pfri^.sName = '..' then
frmMain.ActiveFrame.pnlFile.cdUpLevel
else
frmMain.ActiveFrame.pnlFile.cdDownLevel(@fri);
bHandled := True;
end;
end;
if not bHandled then
begin
FillChar(cmici, SizeOf(cmici), #0);
with cmici do
begin
cbSize := sizeof(cmici);
hwnd := Handle;
lpVerb := PChar(cmd - 1);
nShow := SW_NORMAL;
end;
OleCheck( contMenu.InvokeCommand(cmici) );
end;
if SameText(sVerb, sCmdVerbDelete) or SameText(sVerb, sCmdVerbPaste) then
frmMain.ActiveFrame.RefreshPanel;
end; // if cmd > 0
end;
{$ELSE}
if not Assigned(CM) then
CM := TContextMenu.Create(nil)
else
CM.Items.Clear;
mi:=TMenuItem.Create(CM);
mi.Caption:='Open...';
mi.Hint := 'open';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
miActions:=TMenuItem.Create(CM);
miActions.Caption:='Actions';
CM.Items.Add(miActions);
{ Actions submenu }
// Read actions from doublecmd.ext
sl:=TStringList.Create;
try
if FPS_ISDIR(fri.iMode) or (fri.bIsLink) then Exit;
if gExts.GetExtCommands(lowercase(ExtractFileExt(fri.sName)),sl) then
begin
//founded any commands
for i:=0 to sl.Count-1 do
begin
sCmd:=sl.Strings[i];
if pos('VIEW=',sCmd)>0 then Continue; // view command is only for viewer
frmMain.ActiveFrame.pnlFile.ReplaceExtCommand(sCmd, @fri);
mi:=TMenuItem.Create(miActions);
mi.Caption:=sCmd;
mi.Hint:=Copy(sCmd, pos('=',sCmd)+1, length(sCmd));
// length is bad, but in Copy is corrected
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
mi.Tag:=Integer(@fri);
miActions.Add(mi);
end;
end;
// now add delimiter
mi:=TMenuItem.Create(miActions);
mi.Caption:='-';
miActions.Add(mi);
// now add VIEW item
mi:=TMenuItem.Create(miActions);
mi.Caption:='{!VIEWER}' + fri.sPath + fri.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
miActions.Add(mi);
// now add EDITconfigure item
mi:=TMenuItem.Create(miActions);
mi.Caption:='{!EDITOR}' + fri.sPath + fri.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContextMenu.ContextMenuSelect; // handler
miActions.Add(mi);
finally
FreeAndNil(sl);
end;
{ /Actions submenu }
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Cut';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Copy';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Delete';
mi.Hint := 'actDelete';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Rename';
mi.Hint := 'actShiftF6';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='-';
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Properties';
mi.Hint := 'actFileProperties';
mi.OnClick:=TContextMenu.ContextMenuSelect;
CM.Items.Add(mi);
CM.PopUp(X, Y);
end;
{$ENDIF}
(* Show file properties dialog *)
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
{$IFDEF UNIX}
begin
ShowFileProperties(FileList, aPath);
end;
{$ELSE}
var
SExInfo: TSHELLEXECUTEINFO;
Error: LongInt;
iCurrent : Integer;
FName : String;
(* Find first selected file *)
function FindNextSelected:Boolean;
var
i:Integer;
begin
for i:=iCurrent to FileList.Count-1 do
begin
if FileList.GetItem(i)^.bSelected then
begin
iCurrent:=i;
Result:=True;
Exit;
end;
end;
Result:=False;
end;
begin
iCurrent := 0;
if FindNextSelected then
begin
FName := aPath + FileList.GetItem(iCurrent)^.sName;
//DebugLN(FName);
ZeroMemory(Addr(SExInfo),SizeOf(SExInfo));
SExInfo.cbSize := SizeOf(SExInfo);
SExInfo.lpFile := PChar(FName);
SExInfo.lpVerb := 'properties';
SExInfo.fMask := SEE_MASK_INVOKEIDLIST;
ShellExecuteExA(Addr(SExInfo));
end;
end;
{$ENDIF}
end.

36
uwcxmodule.pas
View file

@ -508,6 +508,10 @@ begin
begin
DebugLN(FDstPath + ExtractDirLevel(Folder, ArcHeader.FileName));
if (FFileMask <> '*.*') and (FFileMask <> '*') then
ForceDirectory(ExtractFilePath(FDstPath + ExtractDirLevel(Folder, PathDelim + ArcHeader.FileName)));
iResult := ProcessFile(ArcHandle, PK_EXTRACT, nil, PChar(FDstPath + ExtractDirLevel(Folder, PathDelim + ArcHeader.FileName)));
//Check for errors
@ -583,10 +587,9 @@ procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
fr : PFileRecItem;
I, Count : Integer;
CurrFileName : String; // Current file name
bForceDirectory : Boolean; // for future
begin
bForceDirectory := True;
if (FFileMask = '*.*') or (FFileMask = '*') then
ForceDirectory(FDstPath + ExtractDirLevel(FFolder, PathDelim + sDir));
//DebugLN('ForceDirectory = ' + FDstPath + ExtractDirLevel(FFolder, PathDelim + sDir));
@ -600,13 +603,13 @@ procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
if not IncludeFileInList(sDir + PathDelim, CurrFileName) then
Continue;
if not(G_ValidateWildText(CurrFileName, FFileMask)
or FPS_ISDIR(PHeaderData(FArcFileList.Items[I])^.FileAttr)) then
Continue;
// DebugLN('In folder = ' + CurrFileName);
if bForceDirectory then
ForceDirectory(FDstPath + ExtractDirLevel(FFolder, PathDelim + sDir));
if (FFileMask <> '*.*') and (FFileMask <> '*') and
not FPS_ISDIR(PHeaderData(FArcFileList.Items[I])^.FileAttr) and
not(G_ValidateWildText(CurrFileName, FFileMask)) then
Continue;
// DebugLN('In folder = ' + CurrFileName);
New(fr);
with fr^, PHeaderData(FArcFileList.Items[I])^ do
@ -617,14 +620,16 @@ procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
begin
sExt:='';
//DebugLN('SelectFilesInSubfolders = ' + FileName);
if (FFileMask = '*.*') or (FFileMask = '*') then
fl.AddItem(fr);
SelectFilesInSubfolders(fl, FileName);
end
else
begin
fl.AddItem(fr);
inc(FFilesSize, UnpSize);
end;
end; //with
fl.AddItem(fr);
end;
end;
@ -647,16 +652,21 @@ begin
if fri.sName[1] = PathDelim then
Delete(fri.sName, 1, 1);
if not(G_ValidateWildText(fri.sName, FFileMask) or FPS_ISDIR(fri.iMode)) then
if (FFileMask <> '*.*') and (FFileMask <> '*') and not(G_ValidateWildText(fri.sName, FFileMask) or FPS_ISDIR(fri.iMode)) then
Continue;
Newfl.AddItem(@fri);
DebugLN('Curr File = ' + fri.sName);
if FPS_ISDIR(fri.iMode) then
SelectFilesInSubfolders(Newfl, fri.sName)
begin
if (FFileMask = '*.*') or (FFileMask = '*') then
Newfl.AddItem(@fri);
SelectFilesInSubfolders(Newfl, fri.sName);
end
else
begin
Newfl.AddItem(@fri);
inc(FFilesSize, fri.iSize);
end;