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