Returns the absolute paths to the volumes mounted on the system, as a proper Tcl list. On the Macintosh, this will be a list of the mounted drives, both local and network. N.B. if two drives have the same name, they will both appear on the volume list, but there is currently no way, from Tcl, to access any but the first of these drives. On UNIX, the command will always return "/", since all filesystems are locally mounted. On Windows, it will return a list of the available local drives (e.g. {a:/ c:/}).
Tcl 8.7 adds mounted virtual filesystems to this list.
PO 2022/06/07 - Example: Laptop with 2 SSD (C: and D:) and 1 mounted share from a NAS (Z:)
Tcl8.6: C:/ D:/ Z:/ Tcl8.7: //zipfs:/ C:/ D:/ Z:/
What file volumes does not detect are network shares, which are not mounted. This functionality can be added by using Twapi. Using the procedures below, the following output is generated for my system:
LocalDrives : C:/ D:/ Z:/ All drives : C:/ D:/ Z:/ //Syno Network drives: //Syno Network drive //Syno contains the following folders: //Syno/Family //Syno/Paul
package require twapi
proc GetNetworkFolders { networkDrive } {
set folderList [list]
set CSIDL_NETWORK 18
set shell [twapi::comobj Shell.Application]
set network [$shell NameSpace $CSIDL_NETWORK]
set networkItems [$network Items]
set numNetworkItems [$networkItems Count]
set found false
for { set i 0 } { $i < $numNetworkItems } { incr i } {
set networkItem [$networkItems Item $i]
if { [string map { "\\" "/" } [$networkItem Path]] eq $networkDrive } {
set folderObj [$networkItem GetFolder]
set folderItems [$folderObj Items]
set numFolderItems [$folderItems Count]
for { set f 0 } { $f < $numFolderItems } { incr f } {
set folderItem [$folderItems Item $f]
lappend folderList [string map { "\\" "/" } [$folderItem Path]]
$folderItem -destroy
}
$folderItems -destroy
$folderObj -destroy
set found true
}
$networkItem -destroy
if { $found } {
break
}
}
$networkItems -destroy
$network -destroy
$shell -destroy
return $folderList
}
proc GetNetworkDrives {} {
set driveList [list]
set CSIDL_NETWORK 18
set shell [twapi::comobj Shell.Application]
set network [$shell NameSpace $CSIDL_NETWORK]
set networkItems [$network Items]
set numNetworkItems [$networkItems Count]
for { set i 0 } { $i < $numNetworkItems } { incr i } {
set networkItem [$networkItems Item $i]
if { [$networkItem IsFolder] && [string first "\\\\" [$networkItem Path]] == 0 } {
lappend driveList [string map { "\\" "/" } [$networkItem Path]]
}
$networkItem -destroy
}
$networkItems -destroy
$network -destroy
$shell -destroy
return $driveList
}
proc GetDrives { args } {
global tcl_platform
set opts [dict create \
-networkdrives false \
]
foreach { key value } $args {
if { [dict exists $opts $key] } {
if { $value eq "" } {
error "GetDrives: No value specified for key \"$key\"."
}
dict set opts $key $value
} else {
error "GetDrives: Unknown option \"$key\" specified."
}
}
set driveList [list]
switch $tcl_platform(platform) {
windows {
foreach drive [file volumes] {
if {[string match "//zipfs*" $drive] } {
continue
} else {
lappend driveList $drive
}
}
if { [dict get $opts "-networkdrives"] } {
foreach networkDrive [GetNetworkDrives] {
lappend driveList [list $networkDrive]
}
}
}
default {
set driveList [file volumes]
}
}
return $driveList
}
puts "LocalDrives : [GetDrives]"
puts "All drives : [GetDrives -networkdrives true]"
puts "Network drives: [GetNetworkDrives]"
foreach networkDrive [GetNetworkDrives] {
puts "Network drive $networkDrive contains the following folders:"
foreach folder [GetNetworkFolders $networkDrive] {
puts " $folder"
}
}
if { [llength [twapi::comobj_instances]] > 1 } {
puts "COM objects still alive: [twapi::comobj_instances]"
}
exit