mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
1174 lines
No EOL
35 KiB
ObjectPascal
1174 lines
No EOL
35 KiB
ObjectPascal
{
|
|
Double Commander
|
|
-------------------------------------------------------------------------
|
|
Enumerating and monitoring drives in the system.
|
|
|
|
Copyright (C) 2006-2013 Koblov Alexander (Alexx2000@mail.ru)
|
|
Copyright (C) 2010 Przemyslaw Nagay (cobines@gmail.com)
|
|
|
|
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 uDriveWatcher;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, fgl, LCLType, uDrive;
|
|
|
|
type
|
|
TDriveWatcherEvent = (dweDriveAdded,
|
|
dweDriveRemoved,
|
|
dweDriveChanged);
|
|
|
|
TDriveWatcherEventNotify = procedure(EventType: TDriveWatcherEvent;
|
|
const ADrive: PDrive) of object;
|
|
|
|
TDriveWatcherObserverList = specialize TFPGList<TDriveWatcherEventNotify>;
|
|
|
|
TDriveWatcher = class
|
|
class procedure Initialize(Handle: HWND);
|
|
class procedure Finalize;
|
|
class procedure AddObserver(Func: TDriveWatcherEventNotify);
|
|
class procedure RemoveObserver(Func: TDriveWatcherEventNotify);
|
|
class function GetDrivesList: TDrivesList;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF UNIX}
|
|
Unix, uMyUnix, uDebug
|
|
{$IFDEF BSD}
|
|
, BSD, BaseUnix, StrUtils, FileUtil
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
, uUDisks, uFileSystemWatcher, DCStrUtils, uOSUtils, FileUtil
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
uMyWindows, Windows, JwaDbt
|
|
{$ENDIF}
|
|
;
|
|
|
|
{$IFDEF LINUX}
|
|
type
|
|
TFakeClass = class
|
|
public
|
|
procedure OnWatcherNotifyEvent(const EventData: TFSWatcherEventData);
|
|
procedure OnUDisksNotify(Reason: TUDisksMethod; const ObjectPath: UTF8String);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BSD}
|
|
const
|
|
{$warning Remove this two constants when they are added to FreePascal}
|
|
NOTE_MOUNTED = $0008;
|
|
NOTE_UMOUNTED = $0010;
|
|
|
|
type
|
|
TKQueueDriveEvent = procedure(Event: TDriveWatcherEvent);
|
|
|
|
TKQueueDriveEventWatcher = class(TThread)
|
|
private
|
|
kq: Longint;
|
|
Event: TDriveWatcherEvent;
|
|
FErrorMsg: String;
|
|
FOnError: TNotifyEvent;
|
|
FOnDriveEvent: TKQueueDriveEvent;
|
|
FFinished: Boolean;
|
|
procedure RaiseErrorEvent;
|
|
procedure RaiseDriveEvent;
|
|
protected
|
|
procedure Execute; override;
|
|
procedure DoTerminate; override;
|
|
public
|
|
property ErrorMsg: String read FErrorMsg;
|
|
property OnError: TNotifyEvent read FOnError write FOnError;
|
|
property OnDriveEvent: TKQueueDriveEvent read FOnDriveEvent write FOnDriveEvent;
|
|
constructor Create();
|
|
destructor Destroy; override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
var
|
|
FObservers: TDriveWatcherObserverList = nil;
|
|
InitializeCounter: Integer = 0;
|
|
{$IFDEF LINUX}
|
|
FakeClass: TFakeClass = nil;
|
|
IsUDisksAvailable: Boolean = False;
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
OldWProc: WNDPROC;
|
|
{$ENDIF}
|
|
{$IFDEF BSD}
|
|
KQueueDriveWatcher: TKQueueDriveEventWatcher;
|
|
{$ENDIF}
|
|
|
|
procedure DoDriveAdded(const ADrive: PDrive);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FObservers.Count - 1 do
|
|
FObservers[i](dweDriveAdded, ADrive);
|
|
end;
|
|
|
|
procedure DoDriveRemoved(const ADrive: PDrive);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FObservers.Count - 1 do
|
|
FObservers[i](dweDriveRemoved, ADrive);
|
|
end;
|
|
|
|
procedure DoDriveChanged(const ADrive: PDrive);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FObservers.Count - 1 do
|
|
FObservers[i](dweDriveChanged, ADrive);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function MyWndProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
|
|
var
|
|
ADrive: PDrive = nil;
|
|
begin
|
|
case uiMsg of
|
|
WM_DEVICECHANGE:
|
|
case wParam of
|
|
DBT_DEVICEARRIVAL:
|
|
DoDriveAdded(ADrive);
|
|
DBT_DEVICEREMOVECOMPLETE:
|
|
DoDriveRemoved(ADrive);
|
|
end;
|
|
end; // case
|
|
Result := CallWindowProc(OldWProc, hWnd, uiMsg, wParam, lParam);
|
|
end;
|
|
|
|
procedure SetMyWndProc(Handle : HWND);
|
|
begin
|
|
{$PUSH}{$HINTS OFF}
|
|
OldWProc := WNDPROC(SetWindowLongPtr(Handle, GWL_WNDPROC, LONG_PTR(@MyWndProc)));
|
|
{$POP}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BSD}
|
|
procedure KQueueDriveWatcher_OnDriveEvent(Event: TDriveWatcherEvent);
|
|
begin
|
|
case Event of
|
|
dweDriveAdded:
|
|
DoDriveAdded(nil);
|
|
dweDriveRemoved:
|
|
DoDriveRemoved(nil);
|
|
end; { case }
|
|
end;
|
|
{$ENDIF}
|
|
|
|
class procedure TDriveWatcher.Initialize(Handle: HWND);
|
|
begin
|
|
Inc(InitializeCounter);
|
|
if InitializeCounter > 1 then
|
|
// Already initialized.
|
|
Exit;
|
|
|
|
FObservers := TDriveWatcherObserverList.Create;
|
|
|
|
{$IFDEF LINUX}
|
|
FakeClass := TFakeClass.Create;
|
|
|
|
if uUDisks.Initialize then
|
|
begin
|
|
IsUDisksAvailable := True;
|
|
uUDisks.AddObserver(@FakeClass.OnUDisksNotify);
|
|
end
|
|
else
|
|
begin
|
|
DCDebug('Detecting devices through /etc/mtab.');
|
|
TFileSystemWatcher.AddWatch('/etc', [wfFileNameChange], @FakeClass.OnWatcherNotifyEvent);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
SetMyWndProc(Handle);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BSD}
|
|
KQueueDriveWatcher := TKQueueDriveEventWatcher.Create();
|
|
KQueueDriveWatcher.OnDriveEvent := @KQueueDriveWatcher_OnDriveEvent;
|
|
KQueueDriveWatcher.Start;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class procedure TDriveWatcher.Finalize;
|
|
begin
|
|
Dec(InitializeCounter);
|
|
if InitializeCounter <> 0 then
|
|
// Don't finalize yet.
|
|
Exit;
|
|
|
|
{$IFDEF LINUX}
|
|
if IsUDisksAvailable then
|
|
begin
|
|
uUDisks.RemoveObserver(@FakeClass.OnUDisksNotify);
|
|
uUDisks.Finalize;
|
|
IsUDisksAvailable := False;
|
|
end;
|
|
TFileSystemWatcher.RemoveWatch('/etc', @FakeClass.OnWatcherNotifyEvent);
|
|
if Assigned(FakeClass) then
|
|
FreeAndNil(FakeClass);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BSD}
|
|
KQueueDriveWatcher.Terminate;
|
|
FreeAndNil(KQueueDriveWatcher);
|
|
{$ENDIF}
|
|
|
|
if Assigned(FObservers) then
|
|
FreeAndNil(FObservers);
|
|
end;
|
|
|
|
class procedure TDriveWatcher.AddObserver(Func: TDriveWatcherEventNotify);
|
|
begin
|
|
if FObservers.IndexOf(Func) < 0 then
|
|
FObservers.Add(Func);
|
|
end;
|
|
|
|
class procedure TDriveWatcher.RemoveObserver(Func: TDriveWatcherEventNotify);
|
|
begin
|
|
FObservers.Remove(Func);
|
|
end;
|
|
|
|
{$IFDEF LINUX}
|
|
function BeginsWithString(const patterns: array of string; const strings: array of string): Boolean;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
for i := Low(strings) to High(strings) do
|
|
begin
|
|
for j := Low(patterns) to High(patterns) do
|
|
if StrBegins(strings[i], patterns[j]) then
|
|
Exit(True);
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function IsPartOfString(const patterns: array of string; const str: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Low(patterns) to High(patterns) do
|
|
if Pos(patterns[I], str) > 0 then
|
|
Exit(True);
|
|
Result := False;
|
|
end;
|
|
|
|
function UDisksGetDeviceInfo(const DeviceObjectPath: UTF8String;
|
|
const Devices: TUDisksDevicesInfos;
|
|
out DeviceInfo: TUDisksDeviceInfo): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Assigned(Devices) then
|
|
begin
|
|
for i := Low(Devices) to High(Devices) do
|
|
begin
|
|
if Devices[i].DeviceObjectPath = DeviceObjectPath then
|
|
begin
|
|
DeviceInfo := Devices[i];
|
|
Exit(True);
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end
|
|
else
|
|
begin
|
|
// Devices not supplied, retrieve info from UDisks.
|
|
Result := uUDisks.GetDeviceInfo(DeviceObjectPath, DeviceInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure UDisksDeviceToDrive(const Devices: TUDisksDevicesInfos; const DeviceInfo: TUDisksDeviceInfo; out Drive: PDrive);
|
|
var
|
|
OwnerDevice: TUDisksDeviceInfo;
|
|
begin
|
|
New(Drive);
|
|
with DeviceInfo do
|
|
begin
|
|
Drive^.DeviceId := DeviceFile;
|
|
Drive^.DisplayName := DevicePresentationName;
|
|
if DeviceIsMounted and (Length(DeviceMountPaths) > 0) then
|
|
begin
|
|
Drive^.Path := DeviceMountPaths[0];
|
|
if Drive^.DisplayName = EmptyStr then
|
|
begin
|
|
if Drive^.Path <> PathDelim then
|
|
Drive^.DisplayName := ExtractFileName(Drive^.Path)
|
|
else
|
|
Drive^.DisplayName := PathDelim;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Drive^.Path := EmptyStr;
|
|
if Drive^.DisplayName = EmptyStr then
|
|
begin
|
|
if (IdLabel <> EmptyStr) then
|
|
Drive^.DisplayName := IdLabel
|
|
else
|
|
Drive^.DisplayName := ExtractFileName(DeviceFile);
|
|
end;
|
|
end;
|
|
Drive^.DriveLabel := IdLabel;
|
|
Drive^.FileSystem := IdType;
|
|
|
|
if DeviceIsPartition then
|
|
begin
|
|
if UDisksGetDeviceInfo(PartitionSlave, Devices, OwnerDevice) and
|
|
OwnerDevice.DeviceIsRemovable then
|
|
begin
|
|
// Removable partition usually means pen-drive type.
|
|
if BeginsWithString(['usb'], OwnerDevice.DriveConnectionInterface) then
|
|
Drive^.DriveType := dtRemovableUsb
|
|
else
|
|
Drive^.DriveType := dtRemovable;
|
|
end
|
|
else
|
|
Drive^.DriveType := dtHardDisk;
|
|
end
|
|
else if DeviceIsDrive then
|
|
begin
|
|
if BeginsWithString(['flash'], DriveMediaCompatibility) then
|
|
Drive^.DriveType := dtFlash
|
|
else if BeginsWithString(['floppy'], DriveMediaCompatibility) then
|
|
Drive^.DriveType := dtFloppy
|
|
else if BeginsWithString(['optical'], DriveMediaCompatibility) then
|
|
Drive^.DriveType := dtOptical
|
|
else if BeginsWithString(['usb'], DriveConnectionInterface) then
|
|
Drive^.DriveType := dtRemovableUsb
|
|
else
|
|
Drive^.DriveType := dtUnknown;
|
|
end
|
|
else if DeviceIsSystemInternal then
|
|
Drive^.DriveType := dtHardDisk
|
|
else
|
|
Drive^.DriveType := dtUnknown;
|
|
|
|
Drive^.IsMediaAvailable := DeviceIsMediaAvailable;
|
|
Drive^.IsMediaEjectable := DeviceIsDrive and DriveIsMediaEjectable;
|
|
Drive^.IsMediaRemovable := DeviceIsRemovable;
|
|
Drive^.IsMounted := DeviceIsMounted;
|
|
Drive^.AutoMount := (DeviceAutomountHint = EmptyStr) or (DeviceAutomountHint = 'always');
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
class function TDriveWatcher.GetDrivesList: TDrivesList;
|
|
{$IF DEFINED(MSWINDOWS)}
|
|
var
|
|
Drive : PDrive;
|
|
DriveNum: Integer;
|
|
DriveBits: DWORD;
|
|
WinDriveType: UINT;
|
|
DriveLetter: AnsiChar;
|
|
DrivePath: String;
|
|
Key: HKEY;
|
|
RegDrivePath: WideString;
|
|
NetworkPath: array[0..Pred(MAX_PATH)] of WideChar;
|
|
NetworkPathSize: DWORD = MAX_PATH * SizeOf(WideChar);
|
|
begin
|
|
Result := TDrivesList.Create;
|
|
{ fill list }
|
|
DWORD(DriveBits) := GetLogicalDrives;
|
|
for DriveNum := 0 to 25 do
|
|
begin
|
|
if ((DriveBits shr DriveNum) and $1) = 0 then
|
|
begin
|
|
// Try to find in mapped network drives
|
|
DriveLetter := AnsiChar(DriveNum + Ord('a'));
|
|
RegDrivePath := 'Network' + PathDelim + DriveLetter;
|
|
if RegOpenKeyExW(HKEY_CURRENT_USER, PWideChar(RegDrivePath), 0, KEY_READ, Key) = ERROR_SUCCESS then
|
|
begin
|
|
if RegQueryValueExW(Key, 'RemotePath', nil, nil, @NetworkPath, @NetworkPathSize) = ERROR_SUCCESS then
|
|
begin
|
|
New(Drive);
|
|
Result.Add(Drive);
|
|
FillChar(Drive^, SizeOf(TDrive), #0);
|
|
with Drive^ do
|
|
begin
|
|
Path := DriveLetter + ':\';
|
|
DisplayName := DriveLetter;
|
|
DriveLabel := UTF8Encode(WideString(NetworkPath));
|
|
DriveType := dtNetwork;
|
|
AutoMount := True;
|
|
end;
|
|
end;
|
|
RegCloseKey(Key);
|
|
end;
|
|
Continue;
|
|
end;
|
|
|
|
DriveLetter := AnsiChar(DriveNum + Ord('a'));
|
|
DrivePath := DriveLetter + ':\';
|
|
WinDriveType := GetDriveType(PChar(DrivePath));
|
|
if WinDriveType = DRIVE_NO_ROOT_DIR then Continue;
|
|
New(Drive);
|
|
Result.Add(Drive);
|
|
with Drive^ do
|
|
begin
|
|
DeviceId := EmptyStr;
|
|
Path := DrivePath;
|
|
DisplayName := DriveLetter;
|
|
DriveLabel := EmptyStr;
|
|
FileSystem := EmptyStr;
|
|
IsMediaAvailable := True;
|
|
IsMediaEjectable := False;
|
|
IsMediaRemovable := False;
|
|
IsMounted := True;
|
|
AutoMount := True;
|
|
|
|
case WinDriveType of
|
|
DRIVE_REMOVABLE:
|
|
begin
|
|
if DriveLetter in ['a', 'b'] then
|
|
DriveType := dtFloppy
|
|
else
|
|
DriveType := dtFlash;
|
|
IsMediaEjectable := True;
|
|
IsMediaRemovable := True;
|
|
end;
|
|
DRIVE_FIXED:
|
|
DriveType := dtHardDisk;
|
|
DRIVE_REMOTE:
|
|
DriveType := dtNetwork;
|
|
DRIVE_CDROM:
|
|
begin
|
|
DriveType := dtOptical;
|
|
IsMediaEjectable := True;
|
|
IsMediaRemovable := True;
|
|
end;
|
|
DRIVE_RAMDISK:
|
|
DriveType := dtRamDisk;
|
|
else
|
|
DriveType := dtUnknown;
|
|
end;
|
|
|
|
if IsMediaAvailable then
|
|
begin
|
|
case DriveType of
|
|
dtFloppy: ; // Don't retrieve, it's slow.
|
|
dtHardDisk:
|
|
begin
|
|
DriveLabel := mbGetVolumeLabel(Path, True);
|
|
FileSystem := mbGetFileSystem(DrivePath);
|
|
end;
|
|
dtNetwork:
|
|
DriveLabel := mbGetRemoteFileName(Path);
|
|
else
|
|
DriveLabel := mbGetVolumeLabel(Path, True);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ELSEIF DEFINED(LINUX)}
|
|
function CheckMountEntry(MountEntry: PMountEntry): Boolean;
|
|
begin
|
|
Result:= False;
|
|
with MountEntry^ do
|
|
begin
|
|
// check filesystem
|
|
if (mnt_fsname = 'proc') then Exit;
|
|
|
|
// check mount dir
|
|
if (mnt_dir = '') or
|
|
(mnt_dir = '/') or
|
|
(mnt_dir = 'none') or
|
|
(mnt_dir = '/proc') or
|
|
(StrBegins(mnt_dir, '/dev/')) or
|
|
(StrBegins(mnt_dir, '/sys/')) or
|
|
(StrBegins(mnt_dir, '/proc/')) then Exit;
|
|
|
|
// check file system type
|
|
if (mnt_type = 'ignore') or
|
|
(mnt_type = 'none') or
|
|
(mnt_type = 'cgroup') or
|
|
(mnt_type = 'cpuset') or
|
|
(mnt_type = 'tmpfs') or
|
|
(mnt_type = 'proc') or
|
|
(mnt_type = 'swap') or
|
|
(mnt_type = 'sysfs') or
|
|
(mnt_type = 'debugfs') or
|
|
(mnt_type = 'devtmpfs') or
|
|
(mnt_type = 'devpts') or
|
|
(mnt_type = 'fusectl') or
|
|
(mnt_type = 'securityfs') or
|
|
(mnt_type = 'binfmt_misc') or
|
|
(mnt_type = 'fuse.gvfs-fuse-daemon') or
|
|
(mnt_type = 'fuse.truecrypt') or
|
|
(mnt_type = 'nfsd') or
|
|
(mnt_type = 'usbfs') or
|
|
(mnt_type = 'mqueue') or
|
|
(mnt_type = 'configfs') or
|
|
(mnt_type = 'hugetlbfs') or
|
|
(mnt_type = 'selinuxfs') or
|
|
(mnt_type = 'rpc_pipefs') then Exit;
|
|
end;
|
|
Result:= True;
|
|
end;
|
|
function UDisksGetDeviceObjectByUUID(const UUID: String; const Devices: TUDisksDevicesInfos): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(Devices) to High(Devices) do
|
|
if Devices[i].IdUuid = UUID then
|
|
Exit(Devices[i].DeviceObjectPath);
|
|
Result := EmptyStr;
|
|
end;
|
|
function UDisksGetDeviceObjectByLabel(const DriveLabel: String; const Devices: TUDisksDevicesInfos): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(Devices) to High(Devices) do
|
|
if Devices[i].IdLabel = DriveLabel then
|
|
Exit(Devices[i].DeviceObjectPath);
|
|
Result := EmptyStr;
|
|
end;
|
|
function UDisksGetDeviceObjectByDeviceFile(const DeviceFile: String; const Devices: TUDisksDevicesInfos): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(Devices) to High(Devices) do
|
|
if Devices[i].DeviceFile = DeviceFile then
|
|
Exit(Devices[i].DeviceObjectPath);
|
|
Result := EmptyStr;
|
|
end;
|
|
|
|
var
|
|
AddedDevices: TStringList = nil;
|
|
AddedMountPoints: TStringList = nil;
|
|
HaveUDisksDevices: Boolean = False;
|
|
|
|
function CheckDevice(const Device: String): Boolean;
|
|
begin
|
|
// If UDisks is available name=value pair should have been handled,
|
|
// so we are free to check the device name. Otherwise don't check it
|
|
// if it is a known name=value pair.
|
|
Result := HaveUDisksDevices or
|
|
not (StrBegins(Device, 'UUID=') or
|
|
StrBegins(Device, 'LABEL='));
|
|
end;
|
|
|
|
// Checks if device on some mount point hasn't been added yet.
|
|
function CanAddDevice(const Device, MountPoint: String): Boolean;
|
|
var
|
|
Idx: Integer;
|
|
begin
|
|
Idx := AddedMountPoints.IndexOf(MountPoint);
|
|
Result := (Idx < 0) or
|
|
(CheckDevice(Device) and
|
|
CheckDevice(AddedDevices[Idx]) and
|
|
(AddedDevices[Idx] <> Device));
|
|
end;
|
|
|
|
function GetDrive(const DrivesList: TDrivesList;
|
|
const Device, MountPoint: String): PDrive;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to DrivesList.Count - 1 do
|
|
begin
|
|
// If UDisks not available only check mount points.
|
|
if (DrivesList[i]^.Path = MountPoint) and
|
|
(not CheckDevice(Device) or
|
|
not CheckDevice(DrivesList[i]^.DeviceId) or
|
|
(DrivesList[i]^.DeviceId = Device)) then
|
|
Exit(DrivesList[i]);
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function GetStrMaybeQuoted(const s: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
if Length(s) > 0 then
|
|
begin
|
|
if s[1] in ['"', ''''] then
|
|
begin
|
|
for i := Length(s) downto 2 do
|
|
begin
|
|
if s[i] = s[1] then
|
|
Exit(Copy(s, 2, i-2));
|
|
end;
|
|
end
|
|
else
|
|
Result := s;
|
|
end;
|
|
end;
|
|
|
|
function IsDeviceMountedAtRoot(const UDisksDevice: TUDisksDeviceInfo): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if UDisksDevice.DeviceIsMounted then
|
|
begin
|
|
for i := Low(UDisksDevice.DeviceMountPaths) to High(UDisksDevice.DeviceMountPaths) do
|
|
if UDisksDevice.DeviceMountPaths[i] = PathDelim then
|
|
Exit(True);
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
const
|
|
MntEntFileList: array[1..2] of PChar = (_PATH_FSTAB, _PATH_MOUNTED);
|
|
var
|
|
Drive : PDrive = nil;
|
|
ExistingDrive : PDrive;
|
|
fstab: PIOFile;
|
|
pme: PMountEntry;
|
|
I: Integer;
|
|
UDisksDevices: TUDisksDevicesInfos;
|
|
UDisksDevice: TUDisksDeviceInfo;
|
|
UDisksDeviceObject: UTF8String;
|
|
DeviceFile: String;
|
|
MountPoint: String;
|
|
HandledByUDisks: Boolean = False;
|
|
begin
|
|
Result := TDrivesList.Create;
|
|
try
|
|
AddedDevices := TStringList.Create;
|
|
AddedMountPoints := TStringList.Create;
|
|
|
|
if IsUDisksAvailable then
|
|
HaveUDisksDevices := uUDisks.EnumerateDevices(UDisksDevices);
|
|
|
|
// Storage devices have to be in fstab or mtab and reported by UDisks.
|
|
for I:= Low(MntEntFileList) to High(MntEntFileList) do
|
|
begin
|
|
fstab:= setmntent(MntEntFileList[I],'r');
|
|
if not Assigned(fstab) then Continue;
|
|
pme:= getmntent(fstab);
|
|
while (pme <> nil) do
|
|
begin
|
|
if CheckMountEntry(pme) then
|
|
begin
|
|
DeviceFile := StrPas(pme^.mnt_fsname);
|
|
MountPoint := SysToUTF8(StrPas(pme^.mnt_dir));
|
|
if MountPoint <> PathDelim then
|
|
MountPoint := ExcludeTrailingPathDelimiter(MountPoint);
|
|
|
|
if HaveUDisksDevices then
|
|
begin
|
|
// Handle "/dev/", "UUID=" and "LABEL=" through UDisks if available.
|
|
if StrBegins(DeviceFile, 'UUID=') then
|
|
begin
|
|
UDisksDeviceObject := UDisksGetDeviceObjectByUUID(
|
|
GetStrMaybeQuoted(Copy(DeviceFile, 6, MaxInt)), UDisksDevices);
|
|
if UDisksDeviceObject <> EmptyStr then
|
|
DeviceFile := '/dev/' + ExtractFileName(UDisksDeviceObject);
|
|
HandledByUDisks := True;
|
|
end
|
|
else if StrBegins(DeviceFile, 'LABEL=') then
|
|
begin
|
|
UDisksDeviceObject := UDisksGetDeviceObjectByLabel(
|
|
GetStrMaybeQuoted(Copy(DeviceFile, 7, MaxInt)), UDisksDevices);
|
|
if UDisksDeviceObject <> EmptyStr then
|
|
DeviceFile := '/dev/' + ExtractFileName(UDisksDeviceObject);
|
|
HandledByUDisks := True;
|
|
end
|
|
else if StrBegins(DeviceFile, '/dev/') then
|
|
begin
|
|
DeviceFile := mbCheckReadLinks(DeviceFile);
|
|
if StrBegins(DeviceFile, '/dev/') then
|
|
UDisksDeviceObject := DeviceFileToUDisksObjectPath(DeviceFile)
|
|
else
|
|
UDisksDeviceObject := UDisksGetDeviceObjectByDeviceFile(DeviceFile, UDisksDevices);
|
|
HandledByUDisks := True;
|
|
end
|
|
else
|
|
HandledByUDisks := False;
|
|
|
|
if HandledByUDisks then
|
|
begin
|
|
if CanAddDevice(DeviceFile, MountPoint) and
|
|
UDisksGetDeviceInfo(UDisksDeviceObject, UDisksDevices, UDisksDevice) then
|
|
begin
|
|
if not UDisksDevice.DevicePresentationHide then
|
|
begin
|
|
UDisksDeviceToDrive(UDisksDevices, UDisksDevice, Drive);
|
|
Drive^.Path := MountPoint;
|
|
Drive^.DisplayName := UDisksDevice.DevicePresentationName;
|
|
if Drive^.DisplayName = EmptyStr then
|
|
begin
|
|
if MountPoint <> PathDelim then
|
|
Drive^.DisplayName := ExtractFileName(MountPoint)
|
|
else
|
|
Drive^.DisplayName := PathDelim;
|
|
end;
|
|
end;
|
|
end
|
|
// Even if mounted device is not listed by UDisks add it anyway the standard way.
|
|
else if I = 2 then // MntEntFileList[2] = _PATH_MOUNTED
|
|
HandledByUDisks := False;
|
|
// Else don't add the device if it's not listed by UDisks.
|
|
end;
|
|
end;
|
|
|
|
// Add by entry in fstab/mtab.
|
|
if not HandledByUDisks then
|
|
begin
|
|
DeviceFile := mbCheckReadLinks(DeviceFile);
|
|
if CanAddDevice(DeviceFile, MountPoint) then
|
|
begin
|
|
New(Drive);
|
|
with Drive^ do
|
|
begin
|
|
DeviceId := DeviceFile;
|
|
Path := MountPoint;
|
|
if MountPoint <> PathDelim then
|
|
DisplayName := ExtractFileName(Path)
|
|
else
|
|
DisplayName := PathDelim;
|
|
DriveLabel := Path;
|
|
FileSystem := StrPas(pme^.mnt_type);
|
|
|
|
if IsPartOfString(['ISO9660', 'CDROM', 'CDRW', 'DVD', 'UDF'], UpperCase(FileSystem)) then // for external usb cdrom and dvd
|
|
DriveType := dtOptical else
|
|
if IsPartOfString(['ISO9660', 'CDROM', 'CDRW', 'DVD'], UpperCase(DeviceFile)) then
|
|
DriveType := dtOptical else
|
|
if IsPartOfString(['FLOPPY'], UpperCase(FileSystem)) then
|
|
DriveType := dtFloppy else
|
|
if IsPartOfString(['FLOPPY', '/DEV/FD'], UpperCase(DeviceFile)) then
|
|
DriveType := dtFloppy else
|
|
if IsPartOfString(['ZIP', 'USB', 'CAMERA'], UpperCase(FileSystem)) then
|
|
DriveType := dtFlash else
|
|
if IsPartOfString(['/MEDIA/'], UpperCase(MountPoint)) then
|
|
DriveType := dtFlash else
|
|
if IsPartOfString(['NFS', 'SMB', 'NETW', 'CIFS'], UpperCase(FileSystem)) then
|
|
DriveType := dtNetwork
|
|
else
|
|
DriveType := dtHardDisk;
|
|
|
|
IsMediaAvailable:= True;
|
|
IsMediaEjectable:= (DriveType = dtOptical);
|
|
IsMediaRemovable:= DriveType in [dtFloppy, dtOptical, dtFlash];
|
|
// If drive from /etc/mtab then it is mounted
|
|
// else it will be checked via mtab below
|
|
IsMounted:= (MntEntFileList[I] = _PATH_MOUNTED);
|
|
AutoMount:= True;
|
|
end;
|
|
end
|
|
// Mark drive as mounted if found in mtab.
|
|
else if MntEntFileList[I] = _PATH_MOUNTED then
|
|
begin
|
|
ExistingDrive := GetDrive(Result, DeviceFile, MountPoint);
|
|
if Assigned(ExistingDrive) then
|
|
begin
|
|
ExistingDrive^.IsMounted := True;
|
|
if ExistingDrive^.FileSystem = EmptyStr then
|
|
ExistingDrive^.FileSystem := StrPas(pme^.mnt_type);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// If drive object has been created add it to the list.
|
|
if Assigned(Drive) then
|
|
begin
|
|
Result.Add(Drive);
|
|
Drive := nil;
|
|
AddedDevices.Add(DeviceFile);
|
|
AddedMountPoints.Add(MountPoint);
|
|
|
|
{$IFDEF DEBUG}
|
|
DCDebug('Adding drive "' + DeviceFile + '" with mount point "' + MountPoint + '"');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
pme:= getmntent(fstab);
|
|
end;
|
|
endmntent(fstab);
|
|
end;
|
|
|
|
if HaveUDisksDevices then
|
|
begin
|
|
for i := Low(UDisksDevices) to High(UDisksDevices) do
|
|
begin
|
|
// Add drives not having a partition table which are usually devices
|
|
// with removable media like CDROM, floppy - they can be mounted.
|
|
// Don't add drives with partition table because they cannot be mounted.
|
|
// Don't add drives with loop device because they cannot be mounted.
|
|
// Add devices reported as "filesystem".
|
|
if ((UDisksDevices[i].DeviceIsDrive and not UDisksDevices[i].DeviceIsPartitionTable) or
|
|
(UDisksDevices[i].IdUsage = 'filesystem')) and
|
|
(StrBegins(UDisksDevices[i].DeviceFile, '/dev/loop') = False) and
|
|
(not UDisksDevices[i].DevicePresentationHide) then
|
|
begin
|
|
if (AddedDevices.IndexOf(UDisksDevices[i].DeviceFile) < 0) and
|
|
(not IsDeviceMountedAtRoot(UDisksDevices[i])) then
|
|
begin
|
|
UDisksDeviceToDrive(UDisksDevices, UDisksDevices[i], Drive);
|
|
Result.Add(Drive);
|
|
Drive := nil;
|
|
AddedDevices.Add(UDisksDevices[i].DeviceFile);
|
|
AddedMountPoints.Add(EmptyStr);
|
|
|
|
{$IFDEF DEBUG}
|
|
DCDebug('Adding UDisks drive "' + UDisksDevices[i].DeviceFile + '"');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
if Assigned(AddedDevices) then
|
|
AddedDevices.Free;
|
|
if Assigned(AddedMountPoints) then
|
|
AddedMountPoints.Free;
|
|
if Assigned(Drive) then
|
|
Dispose(Drive);
|
|
end;
|
|
end;
|
|
{$ELSEIF DEFINED(BSD)}
|
|
function GetDriveTypeFromDeviceOrFSType(const DeviceId, FSType: String): TDriveType;
|
|
begin
|
|
// using filesystem type
|
|
if FSType = 'swap' then
|
|
Result := dtUnknown
|
|
else if FSType = 'zfs' then
|
|
Result := dtHardDisk
|
|
else if FSType = 'nfs' then
|
|
Result := dtNetwork
|
|
else if FSType = 'smbfs' then
|
|
Result := dtNetwork
|
|
else if FSType = 'cifs' then
|
|
Result := dtNetwork
|
|
{$IF DEFINED(DARWIN)}
|
|
else if FSType = 'hfs' then
|
|
Result := dtHardDisk
|
|
else if FSType = 'ntfs' then
|
|
Result := dtHardDisk
|
|
else if FSType = 'msdos' then
|
|
Result := dtHardDisk
|
|
else if FSType = 'exfat' then
|
|
Result := dtHardDisk
|
|
else if FSType = 'udf' then
|
|
Result := dtOptical
|
|
else if FSType = 'cd9660' then
|
|
Result := dtOptical
|
|
else if FSType = 'cddafs' then
|
|
Result := dtOptical
|
|
else if FSType = 'afpfs' then
|
|
Result := dtNetwork
|
|
else if FSType = 'webdav' then
|
|
Result := dtNetwork
|
|
{$ENDIF}
|
|
// using device name
|
|
else if AnsiStartsStr('/dev/ad', DeviceId) then
|
|
Result := dtHardDisk
|
|
else if AnsiStartsStr('/dev/acd', DeviceId) then
|
|
Result := dtOptical // CD-ROM (IDE)
|
|
else if AnsiStartsStr('/dev/da', DeviceId) then
|
|
Result := dtFlash // USB
|
|
else if AnsiStartsStr('/dev/cd', DeviceId) then
|
|
Result := dtOptical // CD-ROM (SCSI)
|
|
else if AnsiStartsStr('/dev/mcd', DeviceId) then
|
|
Result := dtOptical // CD-ROM (other)
|
|
else if AnsiStartsStr('/dev/fd', DeviceId) then
|
|
Result := dtFloppy
|
|
else if AnsiStartsStr('/dev/sa', DeviceId) then
|
|
Result := dtUnknown // Tape (SCSI)
|
|
else if AnsiStartsStr('/dev/ast', DeviceId) then
|
|
Result := dtUnknown // Tape (IDE)
|
|
else if AnsiStartsStr('/dev/fla', DeviceId) then
|
|
Result := dtHardDisk // Flash drive
|
|
else if AnsiStartsStr('/dev/aacd', DeviceId)
|
|
or AnsiStartsStr('/dev/mlxd', DeviceId)
|
|
or AnsiStartsStr('/dev/mlyd', DeviceId)
|
|
or AnsiStartsStr('/dev/amrd', DeviceId)
|
|
or AnsiStartsStr('/dev/idad', DeviceId)
|
|
or AnsiStartsStr('/dev/idad', DeviceId)
|
|
or AnsiStartsStr('/dev/twed', DeviceId) then
|
|
Result := dtHardDisk
|
|
else
|
|
Result := dtUnknown; // devfs, nullfs, procfs, etc.
|
|
end;
|
|
const
|
|
MAX_FS = 128;
|
|
var
|
|
drive: PDrive;
|
|
fstab: PFSTab;
|
|
fs: TStatFS;
|
|
fsList: array[0..MAX_FS] of TStatFS;
|
|
iMounted, iAdded, count: Integer;
|
|
found: boolean;
|
|
dtype: TDriveType;
|
|
begin
|
|
Result := TDrivesList.Create;
|
|
|
|
fstab := getfsent();
|
|
while fstab <> nil do
|
|
begin
|
|
dtype := GetDriveTypeFromDeviceOrFSType(fstab^.fs_spec, fstab^.fs_vfstype);
|
|
|
|
// only add known drive types and skip root directory
|
|
if (dtype = dtUnknown) or (fstab^.fs_file = PathDelim) then
|
|
begin
|
|
fstab := getfsent();
|
|
Continue;
|
|
end; { if }
|
|
|
|
New(drive);
|
|
Result.Add(drive);
|
|
|
|
with drive^ do
|
|
begin
|
|
Path := SysToUTF8(fstab^.fs_file);
|
|
DisplayName := ExtractFileName(Path);
|
|
DriveLabel := Path;
|
|
FileSystem := fstab^.fs_vfstype;
|
|
DeviceId := fstab^.fs_spec;
|
|
DriveType := dtype;
|
|
IsMediaAvailable := false;
|
|
IsMediaEjectable := false;
|
|
IsMediaRemovable := false;
|
|
IsMounted := false;
|
|
AutoMount := true;
|
|
end; { with }
|
|
|
|
fstab := getfsent();
|
|
end; { while }
|
|
endfsent();
|
|
|
|
count := getfsstat(@fsList, SizeOf(fsList), MNT_WAIT);
|
|
for iMounted := 0 to count - 1 do
|
|
begin
|
|
fs := fsList[iMounted];
|
|
|
|
// check if already added using fstab
|
|
found := false;
|
|
for iAdded := 0 to Result.Count - 1 do
|
|
begin
|
|
if Result[iAdded]^.Path = fs.mountpoint then
|
|
begin
|
|
drive := Result[iAdded];
|
|
with drive^ do
|
|
begin
|
|
IsMounted := true;
|
|
IsMediaAvailable := true;
|
|
end;
|
|
found := true;
|
|
break;
|
|
end; { if }
|
|
end; { for }
|
|
|
|
if found then
|
|
continue;
|
|
|
|
dtype := GetDriveTypeFromDeviceOrFSType(
|
|
{$IF DEFINED(DARWIN)}
|
|
fs.mntfromname
|
|
{$ELSE}
|
|
fs.mnfromname
|
|
{$ENDIF},
|
|
fs.fstypename
|
|
);
|
|
|
|
// only add known drive types and skip root directory
|
|
if (dtype = dtUnknown) or (fs.mountpoint = PathDelim) then
|
|
Continue;
|
|
|
|
New(drive);
|
|
Result.Add(drive);
|
|
|
|
with drive^ do
|
|
begin
|
|
Path := SysToUTF8(fs.mountpoint);
|
|
DisplayName := ExtractFileName(Path);
|
|
DriveLabel := Path;
|
|
FileSystem := fs.fstypename;
|
|
DeviceId := {$IF DEFINED(DARWIN)}fs.mntfromname{$ELSE}fs.mnfromname{$ENDIF};
|
|
DriveType := dtype;
|
|
IsMediaAvailable := true;
|
|
IsMediaEjectable := false;
|
|
IsMediaRemovable := false;
|
|
IsMounted := true;
|
|
AutoMount := true;
|
|
end; { with }
|
|
end; { for }
|
|
end;
|
|
{$ELSE}
|
|
begin
|
|
Result := TDrivesList.Create;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
procedure TFakeClass.OnWatcherNotifyEvent(const EventData: TFSWatcherEventData);
|
|
var
|
|
ADrive: PDrive = nil;
|
|
begin
|
|
if (EventData.EventType = fswFileDeleted) and (Pos('mtab', EventData.FileName) = 1) then
|
|
DoDriveChanged(ADrive);
|
|
end;
|
|
|
|
procedure TFakeClass.OnUDisksNotify(Reason: TUDisksMethod; const ObjectPath: UTF8String);
|
|
var
|
|
ADrive: PDrive = nil;
|
|
DeviceInfo: TUDisksDeviceInfo;
|
|
begin
|
|
if uUDisks.GetDeviceInfo(ObjectPath, DeviceInfo) then
|
|
UDisksDeviceToDrive(nil, DeviceInfo, ADrive);
|
|
try
|
|
case Reason of
|
|
UDisks_DeviceAdded:
|
|
DoDriveAdded(ADrive);
|
|
UDisks_DeviceRemoved:
|
|
DoDriveRemoved(ADrive);
|
|
UDisks_DeviceChanged:
|
|
DoDriveChanged(ADrive);
|
|
end;
|
|
finally
|
|
if Assigned(ADrive) then
|
|
Dispose(ADrive);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF BSD}
|
|
{ TKQueueDriveEventWatcher }
|
|
|
|
procedure TKQueueDriveEventWatcher.RaiseErrorEvent;
|
|
begin
|
|
DCDebug(Self.ErrorMsg);
|
|
if Assigned(Self.FOnError) then
|
|
Self.FOnError(Self);
|
|
end;
|
|
|
|
procedure TKQueueDriveEventWatcher.RaiseDriveEvent;
|
|
begin
|
|
if Assigned(Self.FOnDriveEvent) then
|
|
Self.FOnDriveEvent(Self.Event);
|
|
end;
|
|
|
|
procedure TKQueueDriveEventWatcher.Execute;
|
|
const
|
|
KQUEUE_ERROR = -1;
|
|
var
|
|
ke: TKEvent;
|
|
begin
|
|
try
|
|
Self.kq := kqueue();
|
|
if Self.kq = KQUEUE_ERROR then
|
|
begin
|
|
Self.FErrorMsg := 'ERROR: kqueue()';
|
|
Synchronize(@Self.RaiseErrorEvent);
|
|
exit;
|
|
end; { if }
|
|
|
|
try
|
|
FillByte(ke, SizeOf(ke), 0);
|
|
EV_SET(@ke, 1, EVFILT_FS, EV_ADD, 0, 0, nil);
|
|
if kevent(kq, @ke, 1, nil, 0, nil) = KQUEUE_ERROR then
|
|
begin
|
|
Self.FErrorMsg := 'ERROR: kevent()';
|
|
Synchronize(@Self.RaiseErrorEvent);
|
|
exit;
|
|
end; { if }
|
|
|
|
while not Terminated do
|
|
begin
|
|
FillByte(ke, SizeOf(ke), 0);
|
|
if kevent(kq, nil, 0, @ke, 1, nil) = KQUEUE_ERROR then
|
|
break;
|
|
|
|
case ke.Filter of
|
|
EVFILT_TIMER: // user triggered
|
|
continue;
|
|
|
|
EVFILT_FS:
|
|
begin
|
|
if (ke.FFlags and NOTE_MOUNTED <> 0) then
|
|
begin
|
|
Self.Event := dweDriveAdded;
|
|
{$IFDEF DARWIN}
|
|
Sleep(1 * 1000); // wait so drive gets available in MacOSX
|
|
{$ENDIF}
|
|
Synchronize(@Self.RaiseDriveEvent);
|
|
end { if }
|
|
else if (ke.FFlags and NOTE_UMOUNTED <> 0) then
|
|
begin
|
|
Self.Event := dweDriveRemoved;
|
|
{$IFDEF DARWIN}
|
|
Sleep(1 * 1000); // wait so drive disappears in MacOSX
|
|
{$ENDIF}
|
|
Synchronize(@Self.RaiseDriveEvent);
|
|
end; { else if }
|
|
end;
|
|
end; { case }
|
|
end; { while }
|
|
|
|
finally
|
|
FpClose(Self.kq);
|
|
end; { try - finally }
|
|
finally
|
|
FFinished := True;
|
|
end; { try - finally }
|
|
end;
|
|
|
|
procedure TKQueueDriveEventWatcher.DoTerminate;
|
|
var
|
|
ke: TKEvent;
|
|
begin
|
|
inherited DoTerminate;
|
|
|
|
if Self.kq = -1 then
|
|
Exit;
|
|
|
|
FillByte(ke, SizeOf(ke), 0);
|
|
EV_SET(@ke, 0, EVFILT_TIMER, EV_ADD or EV_ONESHOT, 0, 0, nil);
|
|
kevent(Self.kq, @ke, 1, nil, 0, nil);
|
|
end;
|
|
|
|
constructor TKQueueDriveEventWatcher.Create();
|
|
begin
|
|
Self.FreeOnTerminate := true;
|
|
Self.FFinished := false;
|
|
|
|
inherited Create(true);
|
|
end;
|
|
|
|
destructor TKQueueDriveEventWatcher.Destroy;
|
|
begin
|
|
if not Terminated then
|
|
begin
|
|
Self.Terminate;
|
|
{$IF (fpc_version<2) or ((fpc_version=2) and (fpc_release<5))}
|
|
If (MainThreadID=GetCurrentThreadID) then
|
|
while not FFinished do
|
|
CheckSynchronize(100);
|
|
{$ENDIF}
|
|
WaitFor;
|
|
end; { if }
|
|
end;
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|