snichols Below is the sources to a small application to quickly disconnect and reconnect all network drives for Windows operating systems. This tool can come in handy when your laptop is not on the network where the network drives exist. Because Windows Explorer will run very slow trying to find the drives if they are connected. Please use this application at your own risk. Please let me know what you think. Special thanks goes to kbk and dgp for their coding examples and use of regular expressions and the examples of use of Window's Net program.
package require starkit
starkit::startup
package require Tk
package require tile
namespace import -force ::tile::*
# Create the window
proc DriveTool {} {
puts "--proc DriveTool-------------------"
set ::quickFile [file dir .]/$::tcl_platform(user).drv
. configure -borderwidth 1
wm protocol . WM_DELETE_WINDOW {exit}
wm title . "Windows Drives Disconnect/Reconnect Tool"
wm resizable . 1 0
button .quickSave -text "Quick Save/Disconnect" -command {QuickSave}
button .quickLoad -text "Quick Load/Restore" -command {QuickLoad}
button .load -text "Load Drives From File" -command {LoadFile}
button .disconnect -text "Disconnect Current Drives" -command {Disconnect}
button .showConsole -text "Console Show" -command {console show}
button .save -text "Save Current Drives To File" -command {SaveFile}
button .cancel -text Exit -command {exit}
grid .quickSave - - -sticky news
grid .quickLoad - - -sticky news
grid .load - - -sticky news
grid .disconnect - - -sticky news
grid .showConsole - - -sticky news
grid .save - - -sticky news
grid .cancel - - -sticky news
grid rowconfigure . 0 -weight 1
grid columnconfigure . 1 -weight 1
raise .
grab set .
}
# Disconnect All network drives.
proc Disconnect { } {
puts "--proc Disconnect------------------"
foreach drive [string map {/ ""} [file volumes]] {
if { [catch {
exec net use /delete $drive
puts "$drive disconnected."
} errorString] } {
puts "Disconnect: $drive: $errorString"
}
}
.quickSave configure -state disabled
.save configure -state disabled
}
# Parses drives into Tcl list from Windows Net Program
proc ParseDrives { } {
puts "--proc Parse Drives----------------"
foreach drive [string map {/ ""} [file volumes]] {
if { [catch {
set data [split [exec net use $drive] \n]
foreach line $data {
if { [regexp {^Remote name +(.*)} $line -> path]} {
set volume $drive
lappend volume $path
lappend paths $volume
}
}
} errorString] } {
puts "SaveFile: $errorString"
}
}
if { [info exists paths] } {
return $paths
} else {
return ""
}
}
# Saves file and disconnect drives to default location without Save Dialog.
proc QuickSave { } {
puts "--proc QuickSave---------------"
set paths [ParseDrives]
set fileid [open $::quickFile w]
puts $fileid $paths
close $fileid
puts "File saved: $::quickFile"
Disconnect
}
# Mounts drive from Quick Save file
proc QuickLoad { } {
puts "--proc QuickLoad-------------------"
if { [catch {
set fileid [open $::quickFile r]
set paths [read $fileid]
close $fileid
puts "File opened: $::quickFile"
MountDrives $paths
.quickSave configure -state enabled
.save configure -state enabled
} errorString] } {
puts "QuickLoad: $errorString"
}
}
# Save the data field.
proc SaveFile { } {
puts "--proc SaveFile--------------------"
set types {
{"Drive Files" {.drv} }
}
set file [tk_getSaveFile -filetypes $types -defaultextension .drv]
# Only save the file if the user click save not cancel
if {! [string match "" $file ]} {
set paths [ParseDrives]
set fileid [open $file w]
puts $fileid $paths
close $fileid
puts "File saved: $file"
} else {
puts "File Not Saved."
}
}
# Mount Drives
proc MountDrives {paths} {
puts "--proc MountDrives-----------------"
foreach line $paths {
set drive [lindex $line 0]
set path [lindex $line 1]
if { [catch {
exec net use $drive $path
} errorString] } {
puts "MountDrives: $errorString"
}
}
}
# Load the File and Mount Drives
proc LoadFile {} {
puts "--proc LoadFile--------------------"
set types {
{"Drive Files" {.drv} }
}
set file [tk_getOpenFile -filetypes $types -defaultextension .drv]
if { $file == ""} {return}
set fileid [open $file r]
set paths [read $fileid]
close $fileid
MountDrives $paths
}
# show background errors
proc bgerror {value} {puts $value}
# Call the main window
DriveTool