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: Initial code of view operation in VFS

Browse source 
ADD: Initial code of context menu
This commit is contained in:
Alexander Koblov 2007-07-16 19:46:49 +00:00
commit f9ee717b2d
11 changed files with 915 additions and 641 deletions
Download patch file Download diff file Expand all files Collapse all files

4
_make.bat Normal file
View file

@ -0,0 +1,4 @@
set lazpath=X:\Prog\lazarus
fpc doublecmd.lpr -S2cdgi -OG3 -g -gl -vewnhi -l -Ficomponents\KASToolBar\ -Ficomponents\KASToolBar\lib\i386-win32\ -Ficomponents\viewer\ -Fu%lazpath%\components\jpeg\lib\i386-win32\ -Fucomponents\KASToolBar\lib\i386-win32\ -Fu%lazpath%\components\synedit\units\i386-win32\ -Fu%lazpath%\lcl\units\i386-win32\ -Fu%lazpath%\lcl\units\i386-win32\win32\ -Fucomponents\viewer\lib\i386-win32\ -Fu%lazpath%\packager\units\i386-win32\ -Fu. -odoublecmd

3
doc/uOSForms.txt Normal file
View file

@ -0,0 +1,3 @@
$$$*** This is unit history file ***$$$ ###encoding="UTF-8"###
16.07.2007 ADD: Перенес сюда функцию, показывающую свойства файла
ADD: Добавил функцию отображения контекстного меню

3
doc/uOSUtils.txt
View file

@ -1,2 +1,3 @@
$$$*** This is unit history file ***$$$ ###encoding="UTF-8"###
15.05.2007 ADD: Function ShowFilePropertiesDialog for Show file properties dialog (Функция для отображения диалога свойств файлов)
15.05.2007 ADD: Function ShowFilePropertiesDialog for Show file properties dialog (Функция для отображения диалога свойств файлов)
16.07.2007 DEL: Перенес в uOSForms функцию, показывающую свойства файла

24
fmain.lfm
View file

@ -4,11 +4,11 @@ inherited frmMain: TfrmMain
Top = 97
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
@ -97,7 +97,7 @@ inherited frmMain: TfrmMain
end
object pnlCommand: TPanel
Height = 62
Top = 254
Top = 255
Width = 525
Align = alBottom
Anchors = [akLeft, akRight]
@ -227,18 +227,18 @@ inherited frmMain: TfrmMain
end
end
object pnlNotebooks: TPanel
Height = 185
Height = 186
Top = 69
Width = 525
Align = alClient
ClientHeight = 185
ClientHeight = 186
ClientWidth = 525
FullRepaint = False
TabOrder = 3
TabStop = True
object nbLeft: TNotebook
Left = 1
Height = 183
Height = 184
Top = 1
Width = 391
Align = alLeft
@ -248,14 +248,14 @@ inherited frmMain: TfrmMain
end
object Splitter1: TSplitter
Left = 392
Height = 183
Height = 184
Top = 1
Width = 4
ResizeStyle = rsLine
end
object nbRight: TNotebook
Left = 396
Height = 183
Height = 184
Top = 1
Width = 128
Align = alClient
@ -789,14 +789,6 @@ inherited frmMain: TfrmMain
Caption = 'New Item1'
end
end
object pmFileList: TPopupMenu
OnPopup = pmFileListPopup
left = 216
top = 136
object file1: TMenuItem
Caption = 'file'
end
end
object pmDirHistory: TPopupMenu
AutoPopup = False
left = 184

110
fmain.pas
View file

@ -161,8 +161,6 @@ type
miExit: TMenuItem;
actMultiRename: TAction;
miMultiRename: TMenuItem;
pmFileList: TPopupMenu;
file1: TMenuItem;
actShiftF5: TAction;
actShiftF6: TAction;
actShiftF4: TAction;
@ -232,7 +230,6 @@ type
procedure actSortByDateExecute(Sender: TObject);
procedure actSortByAttrExecute(Sender: TObject);
procedure actMultiRenameExecute(Sender: TObject);
procedure pmFileListPopup(Sender: TObject);
procedure actShiftF5Execute(Sender: TObject);
procedure actShiftF6Execute(Sender: TObject);
procedure actShiftF4Execute(Sender: TObject);
@ -248,6 +245,8 @@ type
procedure actCalculateSpaceExecute(Sender: TObject);
procedure actFilePropertiesExecute(Sender: TObject);
procedure FramedgPanelEnter(Sender: TObject);
procedure framedgPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FramelblLPathClick(Sender: TObject);
procedure FrameHeaderDblClick(Sender: TObject);
procedure FramelblLPathMouseDown(Sender: TObject; Button: TMouseButton;
@ -280,7 +279,6 @@ type
//check selected count and generate correct msg, parameters is lng indexs
Function GetFileDlgStr(iLngOne, iLngMulti:Integer):String;
procedure HotDirSelected(Sender:TObject);
procedure pmFileListSelect(Sender:TObject); // handling user commands from popupmenu
procedure CreatePopUpHotDir;
procedure CreatePopUpDirHistory;
procedure miHotAddClick(Sender: TObject);
@ -312,13 +310,13 @@ uses
fMkDir, fCopyDlg, fCompareFiles,{ fEditor,} fMoveDlg, uMoveThread, uShowMsg,
fFindDlg, uSpaceThread, fHotDir, fSymLink, fHardLink,
fMultiRename, uShowForm, uGlobsPaths, fFileOpDlg, fMsg, fPackDlg,
fLinker, fSplitter, uFileProcs, lclType, LCLProc, uOSUtils, uPixMapManager;
fLinker, fSplitter, uFileProcs, lclType, LCLProc, uOSUtils, uOSForms, uPixMapManager;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
inherited;
SetMyWndProc(Handle);
Application.OnException := @AppException;
@ -910,6 +908,8 @@ begin
end;
function TfrmMain.HandleActionHotKeys(var Key: Word; Shift: TShiftState):Boolean; // handled
var
pfri : PFileRecItem;
begin
Result:=True;
if Shift=[] then
@ -965,7 +965,9 @@ begin
VK_APPS:
begin
pmFileList.PopUp(0,0);
pfri := ActiveFrame.GetActiveItem;
pfri^.sPath := ActiveFrame.ActiveDir;
ShowContexMenu(Handle, pfri, Mouse.CursorPos.x, Mouse.CursorPos.y);
Exit;
end;
@ -1667,85 +1669,6 @@ begin
end;
end;
procedure TfrmMain.pmFileListPopup(Sender: TObject);
var
mi:TMenuItem;
i:Integer;
pfri:PFileRecItem;
sCmd:String;
sl: TStringList;
begin
// Create All popup menu
with ActiveFrame do
begin
pmFileList.Items.Clear;
sl:=TStringList.Create;
try
pfri:=GetActiveItem;
if FPS_ISDIR(pfri^.iMode) or (pfri^.bIsLink) then Exit;
if gExts.GetExtCommands(lowercase(ExtractFileExt(pfri^.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
pnlFile.ReplaceExtCommand(sCmd, pfri);
mi:=TMenuItem.Create(pmFileList);
mi.Caption:=sCmd;
mi.Hint:=Copy(sCmd, pos('=',sCmd)+1, length(sCmd));
// length is bad, but in Copy is corrected
mi.OnClick:=@pmFileListSelect; // handler
mi.Tag:=Integer(pfri);
pmFileList.Items.Add(mi);
end;
end;
// now add delimiter
mi:=TMenuItem.Create(pmFileList);
mi.Caption:='-';
pmFileList.Items.Add(mi);
// now add VIEW item
mi:=TMenuItem.Create(pmFileList);
mi.Caption:='{!VIEWER}'+ActiveDir+pfri^.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=@pmFileListSelect; // handler
pmFileList.Items.Add(mi);
// now add EDITconfigure item
mi:=TMenuItem.Create(pmFileList);
mi.Caption:='{!EDITOR}'+ActiveDir+pfri^.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=@pmFileListSelect; // handler
pmFileList.Items.Add(mi);
finally
FreeAndNil(sl);
end;
end;
end;
procedure TfrmMain.pmFileListSelect(Sender:TObject);
var
sCmd:String;
begin
// ShowMessage((Sender as TMenuItem).Hint);
sCmd:=(Sender as TMenuItem).Hint;
with ActiveFrame do
begin
if Pos('{!VFS}',sCmd)>0 then
begin
// if VFS.VFSGetScriptName(PFileRecItem((Sender as TMenuItem).Tag).sName)<>'' then
begin
pnlFile.LoadPanelVFS(PFileRecItem((Sender as TMenuItem).Tag));
Exit;
end;
end;
pnlFile.ProcessExtCommand(sCmd);
end;
end;
procedure TfrmMain.RenameFile(sDestPath:String);
var
fl:TFileList;
@ -2177,6 +2100,19 @@ begin
end;
end;
procedure TfrmMain.framedgPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pfri : PFileRecItem;
begin
if Button = mbRight then
begin
pfri := ActiveFrame.GetActiveItem;
pfri^.sPath := ActiveFrame.ActiveDir;
ShowContexMenu(Handle, pfri, Mouse.CursorPos.x, Mouse.CursorPos.y);
end;
end;
procedure TfrmMain.FramelblLPathClick(Sender: TObject);
begin
@ -2306,7 +2242,7 @@ begin
dgPanel.OnEnter:=@framedgPanelEnter;
dgPanel.PopupMenu:=pmFileList;
dgPanel.OnMouseDown := @framedgPanelMouseDown;
pnlHeader.OnDblClick := @FrameHeaderDblClick;
end;

1
fviewer.lfm
View file

@ -45,6 +45,7 @@ inherited frmViewer: TfrmViewer
Align = alClient
PageIndex = 0
ShowTabs = False
TabOrder = 0
object pgText: TPage
Caption = 'pgText'
ClientWidth = 192

23
fviewer.pas
View file

@ -27,7 +27,7 @@ interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, fLngForm, Menus,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, LCLProc, fLngForm, Menus,
viewercontrol, fFindView;
type
@ -98,6 +98,7 @@ type
iActiveFile:Integer;
bImage:Boolean;
FFindDialog:TfrmFindView;
FDeleteAfterView : Boolean;
procedure UpDateScrollBar;
Function CheckGraphics(const sFileName:String):Boolean;
procedure AdjustViewerSize(ReqWidth, ReqHeight: Integer);
@ -111,14 +112,14 @@ type
end;
procedure ShowViewer(sl:TStringList);
procedure ShowViewer(sl:TStringList; bDeleteAfterView : Boolean = False);
implementation
uses
uLng, uShowMsg, uGlobs, lcltype, lazjpeg{$IFNDEF WIN32}, uFindMmap{$ENDIF} ;
procedure ShowViewer(sl:TStringList);
procedure ShowViewer(sl:TStringList; bDeleteAfterView : Boolean = False);
var viewer: TfrmViewer;
begin
//writeln('ShowViewer - Using Internal');
@ -127,6 +128,7 @@ begin
viewer.FileList.Assign(sl);
viewer.LoadFile(0);
viewer.Show;
viewer.FDeleteAfterView := bDeleteAfterView;
end;
procedure TfrmViewer.LoadLng;
@ -227,12 +229,25 @@ begin
end;
procedure TfrmViewer.frmViewerClose(Sender: TObject;
var CloseAction: TCloseAction);
var CloseAction: TCloseAction);
var
I, Count : Integer;
begin
// TODO: may be better automtic save
// (see also TfrmViewer.miSavePosClick)
CloseAction:=caFree;
if not bImage then gViewerPos.Save(Self);
ViewerControl.UnMapFile;
if FDeleteAfterView then
begin
Count := FileList.Count - 1;
//DebugLN('DeleteFile == ' + FileList.Strings[0]);
for I := 0 to Count do
DeleteFile(FileList.Strings[I]);
end;
end;
procedure TfrmViewer.frmViewerKeyDown(Sender: TObject; var Key: Word;

997
uOSUtils.pas
View file

@ -1,522 +1,475 @@
{
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 uOSUtils;
interface
uses
SysUtils, Classes, uFileList, LCLProc, uDCUtils
{$IFDEF WIN32}
, Windows, ShellApi, MMSystem, uNTFSLinks
{$ELSE}
, BaseUnix, Libc, Unix, UnixType, fFileProperties
{$ENDIF};
const
{$IFDEF UNIX}
faFolder = S_IFDIR;
{$ELSE}
faFolder = faDirectory;
{$ENDIF}
type
TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
dtRAM);
TDrive = record
Name,
Path,
DriveLabel :String;
DriveType : TDriveType;
DriveIcon : Integer;
end;
PDrive = ^TDrive;
{$IFDEF WIN32}
const
WM_DEVICECHANGE = $0219;
faSymLink = $00000400;
type
_DEV_BROADCAST_HDR = record // Device broadcast header
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
// The following messages are for WM_DEVICECHANGE. The immediate list
// is for the wParam. ALL THESE MESSAGES PASS A POINTER TO A STRUCT
// STARTING WITH A DWORD SIZE AND HAVING NO POINTER IN THE STRUCT.
const
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBTF_MEDIA = $0001; // media comings and goings
DBTF_NET = $0002; // network volume
type
_DEV_BROADCAST_VOLUME = record
dbcv_size: DWORD;
dbcv_devicetype: DWORD;
dbcv_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
{$ENDIF}
function FPS_ISDIR(iAttr:Cardinal) : Boolean;
function FPS_ISLNK(iAttr:Cardinal) : Boolean;
function ExecCmdFork(const sCmd:String):Integer;
function GetDiskFreeSpace(Path : String; var FreeSize, TotalSize : Int64) : Boolean;
function CreateHardLink(Path, LinkName: string) : Boolean;
function CreateSymLink(Path, LinkName: string) : Boolean;
function ReadSymLink(LinkName : String) : String;
function GetHomeDir : String;
function GetLastDir(Path : String) : String;
function IsAvailable(Path : String) : Boolean;
function GetAllDrives : TList;
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
implementation
(*Is Directory*)
function FPS_ISDIR(iAttr:Cardinal) : Boolean;
{$IFDEF WIN32}
begin
Result := Boolean(iAttr and faDirectory);
end;
{$ELSE}
begin
Result := BaseUnix.FPS_ISDIR(iAttr);
end;
{$ENDIF}
(*Is Link*)
function FPS_ISLNK(iAttr:Cardinal) : Boolean;
{$IFDEF WIN32}
begin
Result := Boolean(iAttr and faSymLink);
end;
{$ELSE}
begin
Result := BaseUnix.FPS_ISLNK(iAttr);
end;
{$ENDIF}
(* Execute external commands *)
function ExecCmdFork(const sCmd:String):Integer;
{$IFDEF UNIX}
var
pid : longint;
Begin
pid := fpFork;
if pid = 0 then
begin
{The child does the actual exec, and then exits}
Shell(sCmd);
{ If the shell fails, we return an exitvalue of 127, to let it be known}
fpExit(127);
end
else
if pid = -1 then {Fork failed}
begin
raise Exception.Create('Fork failed:'+sCmd);
end;
Result:=0;
end;
{$ELSE}
var
sFileName,
sParams : String;
begin
Split(sCmd, sFileName, sParams);
ShellExecute(0, 'open',PChar(sFileName), PChar(sParams), PChar(ExtractFilePath(sCmd)), SW_SHOW);
end;
{$ENDIF}
(* Get Disk Free Space *)
function GetDiskFreeSpace(Path : String; var FreeSize, TotalSize : Int64) : Boolean;
{$IFDEF UNIX}
var
sbfs:Tstatfs;
begin
statfs(PChar(Path),sbfs);
// writeln('Statfs:',sbfs.bavail,' ',sbfs.bsize,' ',sbfs.blocks,' ', sbfs.bfree);
FreeSize := (Int64(sbfs.bavail)*sbfs.bsize);
TotalSize := (Int64(sbfs.blocks)*sbfs.bsize);
end;
{$ELSE}
begin
Result:= GetDiskFreeSpaceEx(PChar(Path), FreeSize, TotalSize, nil);
end;
{$ENDIF}
function CreateHardLink(Path, LinkName: string) : Boolean;
{$IFDEF WIN32}
begin
Result := True;
try
uNTFSLinks.CreateHardlink(Path, LinkName);
except
Result := False;
end;
end;
{$ELSE}
begin
Result := (fplink(PChar(@Path[1]),PChar(@LinkName[1]))=0);
end;
{$ENDIF}
function CreateSymLink(Path, LinkName: string) : Boolean;
{$IFDEF WIN32}
begin
Result := True;
try
uNTFSLinks.CreateSymlink(Path, LinkName);
except
Result := False;
end;
end;
{$ELSE}
begin
Result := (fpsymlink(PChar(@Path[1]),PChar(@LinkName[1]))=0);
end;
{$ENDIF}
(* Get symlink target *)
function ReadSymLink(LinkName : String) : String;
{$IFDEF WIN32}
var
Target: WideString;
LinkType: TReparsePointType;
begin
try
if uNTFSLinks.FGetSymlinkInfo(LinkName, Target, LinkType) then
Result := Target
else
Result := '';
except
Result := '';
end;
end;
{$ELSE}
begin
Result := fpReadlink(LinkName);
end;
{$ENDIF}
(* Return home directory*)
function GetHomeDir : String;
{$IFDEF WIN32}
var
size : Integer;
begin
size := GetEnvironmentVariable('USERPROFILE', nil, 0);
if size > 0 then
begin
SetLength(Result, size);
GetEnvironmentVariable('USERPROFILE', PChar(Result), size);
end;
Delete(Result, size, 1);
Result := Result + DirectorySeparator;
end;
{$ELSE}
begin
Result := GetEnvironmentVariable('HOME')+DirectorySeparator;
end;
{$ENDIF}
function GetLastDir(Path : String) : String;
begin
Result := ExtractFileName(ExcludeTrailingPathDelimiter(Path));
if Result = '' then
Result := ExtractFileDrive(Path);
end;
{$IFDEF WIN32}
(* Drive ready *)
const drive_root: AnsiString = ':\';
function DriveReady(const Drv: Char): Boolean;
var
NotUsed: DWORD;
begin
Result := GetVolumeInformation(PChar(Drv + drive_root), nil, 0, nil,
NotUsed, NotUsed, nil, 0);
end;
(* Disk label *)
function GetLabelDisk(const Drv: Char; const VolReal: Boolean): string;
function DisplayName(const Drv: Char): string;
var
SFI: TSHFileInfo;
begin
FillChar(SFI, SizeOf(SFI), 0);
SHGetFileInfo(PChar(Drv + drive_root), 0, SFI, SizeOf(SFI), SHGFI_DISPLAYNAME);
Result := SFI.szDisplayName;
if Pos('(', Result) <> 0 then
SetLength(Result, Pos('(', Result) - 2);
end;
var
WinVer: Byte;
DriveType, NotUsed: DWORD;
Buf: array [0..MAX_PATH - 1] of Char;
begin
Result := '';
WinVer := LOBYTE(LOWORD(GetVersion));
DriveType := GetDriveType(PChar(Drv + drive_root));
if (WinVer <= 4) and (DriveType <> DRIVE_REMOVABLE) or VolReal then
begin // Win9x, Me, NT <= 4.0
Buf[0] := #0;
GetVolumeInformation(PChar(Drv + drive_root), Buf, DWORD(SizeOf(Buf)), nil,
NotUsed, NotUsed, nil, 0);
Result := Buf;
if VolReal and (WinVer >= 5) and (Result <> '') and
(DriveType <> DRIVE_REMOVABLE) then // Win2k, XP and higher
Result := DisplayName(Drv)
else if (Result = '') and (not VolReal) then
Result := '<none>';
end else
Result := DisplayName(Drv);
end;
(* Wait for change disk label *)
procedure WaitLabelChange(const Drv: Char; const Str: string);
var
st1, st2: string;
begin
if GetLabelDisk(Drv, True) = '' then
Exit;
st1 := TrimLeft(Str);
st2 := st1;
while st1 = st2 do
st2 := GetLabelDisk(Drv, FALSE);
end;
(* Close CD/DVD *)
procedure CloseCD(const Drive: string);
var
OpenParms: MCI_OPEN_PARMS;
begin
FillChar(OpenParms, SizeOf(OpenParms), 0);
OpenParms.lpstrDeviceType := 'CDAudio';
OpenParms.lpstrElementName := PChar(Drive + ':');
mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));
mciSendCommand(OpenParms.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
mciSendCommand(OpenParms.wDeviceID, MCI_CLOSE, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));
end;
(* Drive icon *)
function DriveIconSysIdx(const Path: string): Integer;
var
SFI: TSHFileInfo;
begin
SFI.iIcon := 0;
SHGetFileInfo(PChar(Path), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);
Result := SFI.iIcon + $1000;
end;
{$ENDIF}
function IsAvailable(Path: String): Boolean;
{$IFDEF WIN32}
var
Drv: Char;
DriveLabel: string;
begin
Drv := ExtractFileDrive(Path)[1];
{ Close CD/DVD }
if (GetDriveType(PChar(Drv + drive_root)) = DRIVE_CDROM) and
(not DriveReady(Drv)) then
begin
DriveLabel:= GetLabelDisk(Drv, False);
CloseCD(Drv);
if DriveReady(Drv) then
WaitLabelChange(Drv, DriveLabel);
end;
Result := DriveReady(Drv);
end;
{$ELSE}
var
mtab: PIOFile;
pme: PMountEntry;
begin
Result:= False;
mtab:= setmntent(_PATH_MOUNTED,'r');
if not Assigned(mtab) then exit;
pme:= getmntent(mtab);
while (pme <> nil) do
begin
if pme.mnt_dir = Path then
begin
Result:= True;
Break;
end;
pme:= getmntent(mtab);
end;
endmntent(mtab);
end;
{$ENDIF}
(*Return a list of drives in system*)
function GetAllDrives : TList;
var
Drive : PDrive;
{$IFDEF WIN32}
DriveNum: Integer;
DriveBits: set of 0..25;
begin
Result := TList.Create;
{ fill list }
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do
begin
New(Drive);
with Drive^ do
begin
if not (DriveNum in DriveBits) then Continue;
Name := Char(DriveNum + Ord('a')) + ':\';
Path := Name;
DriveType := TDriveType(GetDriveType(PChar(Name)));
if DriveType <> dtFloppy then
DriveLabel := GetLabelDisk(Name[1], True);
DriveIcon := DriveIconSysIdx(Path);
end;
Result.Add(Drive);
end;
end;
{$ELSE}
fstab: PIOFile;
pme: PMountEntry;
begin
Result := TList.Create;
fstab:= setmntent(_PATH_FSTAB,'r');
if not Assigned(fstab) then exit;
pme:= getmntent(fstab);
while (pme <> nil) do
begin
if (pme.mnt_dir <> '/') and (pme.mnt_dir <> 'none') and
(pme.mnt_dir <> 'swap') and (pme.mnt_dir <> '/proc') and
(pme.mnt_dir <> '/dev/pts') then
begin
New(Drive);
with Drive^ do
begin
Name := ExtractFileName(pme.mnt_dir);
Path := pme.mnt_dir;
// TODO drive icons on Linux
end;
Result.Add(Drive);
end;
pme:= getmntent(fstab);
end;
endmntent(fstab);
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 uOSUtils;
interface
uses
SysUtils, Classes, LCLProc, uDCUtils
{$IFDEF WIN32}
, Windows, ShellApi, MMSystem, uNTFSLinks
{$ELSE}
, BaseUnix, Libc, Unix, UnixType
{$ENDIF};
const
{$IFDEF UNIX}
faFolder = S_IFDIR;
{$ELSE}
faFolder = faDirectory;
{$ENDIF}
type
TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
dtRAM);
TDrive = record
Name,
Path,
DriveLabel :String;
DriveType : TDriveType;
DriveIcon : Integer;
end;
PDrive = ^TDrive;
{$IFDEF WIN32}
const
WM_DEVICECHANGE = $0219;
faSymLink = $00000400;
type
_DEV_BROADCAST_HDR = record // Device broadcast header
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
// The following messages are for WM_DEVICECHANGE. The immediate list
// is for the wParam. ALL THESE MESSAGES PASS A POINTER TO A STRUCT
// STARTING WITH A DWORD SIZE AND HAVING NO POINTER IN THE STRUCT.
const
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBTF_MEDIA = $0001; // media comings and goings
DBTF_NET = $0002; // network volume
type
_DEV_BROADCAST_VOLUME = record
dbcv_size: DWORD;
dbcv_devicetype: DWORD;
dbcv_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
{$ENDIF}
function FPS_ISDIR(iAttr:Cardinal) : Boolean;
function FPS_ISLNK(iAttr:Cardinal) : Boolean;
function ExecCmdFork(const sCmd:String):Integer;
function GetDiskFreeSpace(Path : String; var FreeSize, TotalSize : Int64) : Boolean;
function CreateHardLink(Path, LinkName: string) : Boolean;
function CreateSymLink(Path, LinkName: string) : Boolean;
function ReadSymLink(LinkName : String) : String;
function GetHomeDir : String;
function GetLastDir(Path : String) : String;
function IsAvailable(Path : String) : Boolean;
function GetAllDrives : TList;
implementation
(*Is Directory*)
function FPS_ISDIR(iAttr:Cardinal) : Boolean;
{$IFDEF WIN32}
begin
Result := Boolean(iAttr and faDirectory);
end;
{$ELSE}
begin
Result := BaseUnix.FPS_ISDIR(iAttr);
end;
{$ENDIF}
(*Is Link*)
function FPS_ISLNK(iAttr:Cardinal) : Boolean;
{$IFDEF WIN32}
begin
Result := Boolean(iAttr and faSymLink);
end;
{$ELSE}
begin
Result := BaseUnix.FPS_ISLNK(iAttr);
end;
{$ENDIF}
(* Execute external commands *)
function ExecCmdFork(const sCmd:String):Integer;
{$IFDEF UNIX}
var
pid : longint;
Begin
pid := fpFork;
if pid = 0 then
begin
{The child does the actual exec, and then exits}
Shell(sCmd);
{ If the shell fails, we return an exitvalue of 127, to let it be known}
fpExit(127);
end
else
if pid = -1 then {Fork failed}
begin
raise Exception.Create('Fork failed:'+sCmd);
end;
Result:=0;
end;
{$ELSE}
var
sFileName,
sParams : String;
begin
Split(sCmd, sFileName, sParams);
ShellExecute(0, 'open',PChar(sFileName), PChar(sParams), PChar(ExtractFilePath(sCmd)), SW_SHOW);
end;
{$ENDIF}
(* Get Disk Free Space *)
function GetDiskFreeSpace(Path : String; var FreeSize, TotalSize : Int64) : Boolean;
{$IFDEF UNIX}
var
sbfs:Tstatfs;
begin
statfs(PChar(Path),sbfs);
// writeln('Statfs:',sbfs.bavail,' ',sbfs.bsize,' ',sbfs.blocks,' ', sbfs.bfree);
FreeSize := (Int64(sbfs.bavail)*sbfs.bsize);
TotalSize := (Int64(sbfs.blocks)*sbfs.bsize);
end;
{$ELSE}
begin
Result:= GetDiskFreeSpaceEx(PChar(Path), FreeSize, TotalSize, nil);
end;
{$ENDIF}
function CreateHardLink(Path, LinkName: string) : Boolean;
{$IFDEF WIN32}
begin
Result := True;
try
uNTFSLinks.CreateHardlink(Path, LinkName);
except
Result := False;
end;
end;
{$ELSE}
begin
Result := (fplink(PChar(@Path[1]),PChar(@LinkName[1]))=0);
end;
{$ENDIF}
function CreateSymLink(Path, LinkName: string) : Boolean;
{$IFDEF WIN32}
begin
Result := True;
try
uNTFSLinks.CreateSymlink(Path, LinkName);
except
Result := False;
end;
end;
{$ELSE}
begin
Result := (fpsymlink(PChar(@Path[1]),PChar(@LinkName[1]))=0);
end;
{$ENDIF}
(* Get symlink target *)
function ReadSymLink(LinkName : String) : String;
{$IFDEF WIN32}
var
Target: WideString;
LinkType: TReparsePointType;
begin
try
if uNTFSLinks.FGetSymlinkInfo(LinkName, Target, LinkType) then
Result := Target
else
Result := '';
except
Result := '';
end;
end;
{$ELSE}
begin
Result := fpReadlink(LinkName);
end;
{$ENDIF}
(* Return home directory*)
function GetHomeDir : String;
{$IFDEF WIN32}
var
size : Integer;
begin
size := GetEnvironmentVariable('USERPROFILE', nil, 0);
if size > 0 then
begin
SetLength(Result, size);
GetEnvironmentVariable('USERPROFILE', PChar(Result), size);
end;
Delete(Result, size, 1);
Result := Result + DirectorySeparator;
end;
{$ELSE}
begin
Result := GetEnvironmentVariable('HOME')+DirectorySeparator;
end;
{$ENDIF}
function GetLastDir(Path : String) : String;
begin
Result := ExtractFileName(ExcludeTrailingPathDelimiter(Path));
if Result = '' then
Result := ExtractFileDrive(Path);
end;
{$IFDEF WIN32}
(* Drive ready *)
const drive_root: AnsiString = ':\';
function DriveReady(const Drv: Char): Boolean;
var
NotUsed: DWORD;
begin
Result := GetVolumeInformation(PChar(Drv + drive_root), nil, 0, nil,
NotUsed, NotUsed, nil, 0);
end;
(* Disk label *)
function GetLabelDisk(const Drv: Char; const VolReal: Boolean): string;
function DisplayName(const Drv: Char): string;
var
SFI: TSHFileInfo;
begin
FillChar(SFI, SizeOf(SFI), 0);
SHGetFileInfo(PChar(Drv + drive_root), 0, SFI, SizeOf(SFI), SHGFI_DISPLAYNAME);
Result := SFI.szDisplayName;
if Pos('(', Result) <> 0 then
SetLength(Result, Pos('(', Result) - 2);
end;
var
WinVer: Byte;
DriveType, NotUsed: DWORD;
Buf: array [0..MAX_PATH - 1] of Char;
begin
Result := '';
WinVer := LOBYTE(LOWORD(GetVersion));
DriveType := GetDriveType(PChar(Drv + drive_root));
if (WinVer <= 4) and (DriveType <> DRIVE_REMOVABLE) or VolReal then
begin // Win9x, Me, NT <= 4.0
Buf[0] := #0;
GetVolumeInformation(PChar(Drv + drive_root), Buf, DWORD(SizeOf(Buf)), nil,
NotUsed, NotUsed, nil, 0);
Result := Buf;
if VolReal and (WinVer >= 5) and (Result <> '') and
(DriveType <> DRIVE_REMOVABLE) then // Win2k, XP and higher
Result := DisplayName(Drv)
else if (Result = '') and (not VolReal) then
Result := '<none>';
end else
Result := DisplayName(Drv);
end;
(* Wait for change disk label *)
procedure WaitLabelChange(const Drv: Char; const Str: string);
var
st1, st2: string;
begin
if GetLabelDisk(Drv, True) = '' then
Exit;
st1 := TrimLeft(Str);
st2 := st1;
while st1 = st2 do
st2 := GetLabelDisk(Drv, FALSE);
end;
(* Close CD/DVD *)
procedure CloseCD(const Drive: string);
var
OpenParms: MCI_OPEN_PARMS;
begin
FillChar(OpenParms, SizeOf(OpenParms), 0);
OpenParms.lpstrDeviceType := 'CDAudio';
OpenParms.lpstrElementName := PChar(Drive + ':');
mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));
mciSendCommand(OpenParms.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
mciSendCommand(OpenParms.wDeviceID, MCI_CLOSE, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, Longint(@OpenParms));
end;
(* Drive icon *)
function DriveIconSysIdx(const Path: string): Integer;
var
SFI: TSHFileInfo;
begin
SFI.iIcon := 0;
SHGetFileInfo(PChar(Path), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);
Result := SFI.iIcon + $1000;
end;
{$ENDIF}
function IsAvailable(Path: String): Boolean;
{$IFDEF WIN32}
var
Drv: Char;
DriveLabel: string;
begin
Drv := ExtractFileDrive(Path)[1];
{ Close CD/DVD }
if (GetDriveType(PChar(Drv + drive_root)) = DRIVE_CDROM) and
(not DriveReady(Drv)) then
begin
DriveLabel:= GetLabelDisk(Drv, False);
CloseCD(Drv);
if DriveReady(Drv) then
WaitLabelChange(Drv, DriveLabel);
end;
Result := DriveReady(Drv);
end;
{$ELSE}
var
mtab: PIOFile;
pme: PMountEntry;
begin
Result:= False;
mtab:= setmntent(_PATH_MOUNTED,'r');
if not Assigned(mtab) then exit;
pme:= getmntent(mtab);
while (pme <> nil) do
begin
if pme.mnt_dir = Path then
begin
Result:= True;
Break;
end;
pme:= getmntent(mtab);
end;
endmntent(mtab);
end;
{$ENDIF}
(*Return a list of drives in system*)
function GetAllDrives : TList;
var
Drive : PDrive;
{$IFDEF WIN32}
DriveNum: Integer;
DriveBits: set of 0..25;
begin
Result := TList.Create;
{ fill list }
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do
begin
New(Drive);
with Drive^ do
begin
if not (DriveNum in DriveBits) then Continue;
Name := Char(DriveNum + Ord('a')) + ':\';
Path := Name;
DriveType := TDriveType(GetDriveType(PChar(Name)));
if DriveType <> dtFloppy then
DriveLabel := GetLabelDisk(Name[1], True);
DriveIcon := DriveIconSysIdx(Path);
end;
Result.Add(Drive);
end;
end;
{$ELSE}
fstab: PIOFile;
pme: PMountEntry;
begin
Result := TList.Create;
fstab:= setmntent(_PATH_FSTAB,'r');
if not Assigned(fstab) then exit;
pme:= getmntent(fstab);
while (pme <> nil) do
begin
if (pme.mnt_dir <> '/') and (pme.mnt_dir <> 'none') and
(pme.mnt_dir <> 'swap') and (pme.mnt_dir <> '/proc') and
(pme.mnt_dir <> '/dev/pts') then
begin
New(Drive);
with Drive^ do
begin
Name := ExtractFileName(pme.mnt_dir);
Path := pme.mnt_dir;
DriveIcon := 0;
// TODO drive icons on Linux
end;
Result.Add(Drive);
end;
pme:= getmntent(fstab);
end;
endmntent(fstab);
end;
{$ENDIF}
end.

12
ufilepanel.pas
View file

@ -70,7 +70,7 @@ type
procedure cdDownLevel(frp:PFileRecItem);
procedure MarkGroup(const sMask:String; bSelect:Boolean); // second parametr is switch sel/uns
procedure UpdatePrompt;
procedure ProcessExtCommand(sCmd:String{; pfr:PFileRecItem});
function ProcessExtCommand(sCmd:String{; pfr:PFileRecItem}) : Boolean;
procedure ReplaceExtCommand(var sCmd:String; pfr:PFileRecItem);
procedure SetActiveDir(const AValue:String);
function GetActiveDir:String;
@ -553,30 +553,30 @@ begin
end;
end;
procedure TFilePanel.ProcessExtCommand(sCmd:String{; pfr:PFileRecItem});
function TFilePanel.ProcessExtCommand(sCmd:String{; pfr:PFileRecItem}) : Boolean;
begin
Result := False;
if Pos('{!SHELL}', sCmd)>0 then
begin
sCmd:=StringReplace(sCmd,'{!SHELL}','',[rfReplaceAll]);
sCmd:=Format(gTerm,[sCmd]);
Result := True;
end;
if Pos('{!EDITOR}',sCmd)>0 then
begin
sCmd:=StringReplace(sCmd,'{!EDITOR}','',[rfReplaceAll]);
uShowForm.ShowEditorByGlob(sCmd);
Result := True;
Exit;
end;
if Pos('{!VIEWER}',sCmd)>0 then
begin
sCmd:=StringReplace(sCmd,'{!VIEWER}','',[rfReplaceAll]);
uShowForm.ShowViewerByGlob(sCmd);
Result := True;
Exit;
end;
System.ChDir(ActiveDir);
// LastActive:=sName;
writeln(output, sCmd);
ExecCmdFork(sCmd);
// LoadPanel;
end;
procedure TFilePanel.SetActiveDir(const AValue:String);

352
uosforms.pas Normal file
View file

@ -0,0 +1,352 @@
{
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
TContexMenu = class(TPopupMenu)
procedure ContexMenuSelect(Sender:TObject);
end;
procedure SetMyWndProc(Handle : THandle);
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
procedure ShowContexMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
implementation
uses
fMain, uOSUtils, uExts, uGlobs;
var
{$IFDEF MSWINDOWS}
OldWProc: WNDPROC;
ICM2: IContextMenu2 = nil;
{$ELSE}
CM : TContexMenu = nil;
{$ENDIF}
{$IFDEF MSWINDOWS}
function MyWndProc(hwnd: HWND; Msg, wParam, lParam: Cardinal): Cardinal; stdcall;
begin
(* For working wuth submenu of contex menu *)
if ((Msg = WM_INITMENUPOPUP) or (Msg = WM_DRAWITEM) or (Msg = WM_MENUCHAR)
or (Msg = WM_MEASUREITEM)) and Assigned(ICM2) then
begin
ICM2.HandleMenuMsg(Msg, wParam, lParam);
Result := 0;
end
else
Result := CallWindowProc(OldWProc, hwnd, Msg, wParam, lParam);
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 TContexMenu.ContexMenuSelect(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 ShowContexMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
{$IFDEF MSWINDOWS}
var
desktop: IShellFolder;
mycomputer: IShellFolder;
folder: IShellFolder;
pidl: PItemIDList;
malloc: IMalloc;
chEaten: ULONG;
dwAttributes: ULONG;
contMenu: IContextMenu;
menu: HMENU;
cmd: UINT;
cmici: CMINVOKECOMMANDINFO;
pwPath,
pwFileName : PWideChar;
bHandled : Boolean;
sVerb : String;
begin
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(pfri^.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(pfri^.sName);
OleCheck( folder.ParseDisplayName(Handle, nil, pwFileName, chEaten, pidl, dwAttributes) );
try
OleCheck( folder.GetUIObjectOf(Handle, 1, pidl, 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_RETURNCMD, X, Y, 0, Handle, nil));
finally
DestroyMenu(menu);
ICM2 := nil;
end;
{bHandled := False;
sVerb := StrPas(PChar(cmd - 1));
if SameText(sVerb, SCmdVerbRename) then
begin
//EditText;
bHandled := True;
end
else if SameText(sVerb, SCmdVerbOpen) then
begin
if FPS_ISDIR(pfri^.iMode) or (pfri^.bLinkIsDir) then
begin
frmMain.ActiveFrame.pnlFile.cdDownLevel(pfri);
end;
end; }
if {(not bHandled) and} (cmd > 0) then
begin
with cmici do
begin
cbSize := sizeof(cmici);
fMask := 0;
hwnd := Handle;
lpVerb := PChar(cmd - 1);
lpParameters := nil;
lpDirectory := nil;
nShow := SW_NORMAL;
end;
OleCheck( contMenu.InvokeCommand(cmici) );
end
end;
{$ELSE}
var
mi, miActions : TMenuItem;
i:Integer;
sCmd:String;
sl: TStringList;
begin
if not Assigned(CM) then
CM := TContexMenu.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(pfri^.iMode) or (pfri^.bIsLink) then Exit;
if gExts.GetExtCommands(lowercase(ExtractFileExt(pfri^.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, pfri);
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:=TContexMenu.ContexMenuSelect; // handler
mi.Tag:=Integer(pfri);
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}' + pfri^.sPath + pfri^.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContexMenu.ContexMenuSelect; // handler
miActions.Add(mi);
// now add EDITconfigure item
mi:=TMenuItem.Create(miActions);
mi.Caption:='{!EDITOR}' + pfri^.sPath + pfri^.sName;
mi.Hint:=mi.Caption;
mi.OnClick:=TContexMenu.ContexMenuSelect; // 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:=TContexMenu.ContexMenuSelect;
CM.Items.Add(mi);
mi:=TMenuItem.Create(CM);
mi.Caption:='Rename';
mi.Hint := 'actShiftF6';
mi.OnClick:=TContexMenu.ContexMenuSelect;
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:=TContexMenu.ContexMenuSelect;
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.

27
ushowform.pas
View file

@ -19,12 +19,12 @@ uses
Function ShowEditorByGlob(const sFileName:String):Boolean;
Function ShowViewerByGlob(const sFileName:String):Boolean;
Function ShowViewerByGlobList(list:TStringList):Boolean;
Function ShowViewerByGlobList(list:TStringList; bDeleteAfterView : Boolean = False):Boolean;
implementation
uses
SysUtils,
SysUtils, Process,
uGlobs, uOSUtils, fEditor, fViewer;
Function ShowEditorByGlob(const sFileName:String):Boolean;
@ -55,18 +55,35 @@ begin
Result:=True;
end;
Function ShowViewerByGlobList(list:TStringList):Boolean;
Function ShowViewerByGlobList(list : TStringList; bDeleteAfterView : Boolean = False):Boolean;
var
i:Integer;
I, Count:Integer;
Process : TProcess;
begin
if gUseExtView then
begin
if bDeleteAfterView then
begin
Process := TProcess.Create(nil);
Process.CommandLine := Format(gExtView,[List.Strings[0]]);
Process.Options := [poWaitOnExit];
Process.Execute;
Count := list.Count - 1;
//DebugLN('DeleteFile == ' + FileList.Strings[0]);
for I := 0 to Count do
DeleteFile(list.Strings[I]);
end;
//************
writeln('ShowViewerByGlobList - Use ExtView ');
for i:=0 to list.Count-1 do
ExecCmdFork(Format(gExtView,[List.Strings[i]]))
end
else
ShowViewer(list);
ShowViewer(list, bDeleteAfterView);
Result:=True;
end;