package require registry
package require BWidget 1.3
namespace eval regb {
variable BaseKeys {
HKEY_CLASSES_ROOT
HKEY_LOCAL_MACHINE
HKEY_CURRENT_USER
}
variable PROGINC -1
variable PROGTXT ""
}
proc regb::build_screen {w} {
variable BaseKeys
if {$w ne ""} {toplevel $w}
NoteBook $w.nb -internalborderwidth 0
foreach k $BaseKeys {
build_tree_tab $w.nb $k
}
build_info_tab $w.nb
$w.nb compute_size
pack $w.nb -fill both -expand yes
$w.nb raise [$w.nb pages end]
if {$w eq ""} {set w .; wm deic $w}
wm title $w Registrar
wm geometry $w 240x268
catch {wce siphide}
}
proc regb::build_info_tab {nb} {
set f [$nb insert end help -text ?]
text $f.t
$f.t tag config HEAD -font {Tahoma 9 bold}
pack $f.t
$f.t insert end "\nSimple Registry Browser" HEAD
$f.t insert end "\n
Each Tab is a separate HKEY section of Registry
Selecting a key on the left side shows all values under that key\n\n"
$f.t insert end "Mouse Actions:\n" HEAD
$f.t insert end "Click : Selects that key
Click: (on Cross) Opens/closes folder\n\n"
$f.t insert end "Arrow Key Actions:\n" HEAD
$f.t insert end "Up : Moves selection to previous key
Down : Moves selection to next key
Right : Opens key folder (subkeys)
Left : Closes key folder (subkeys)"
}
proc regb::make_readable key {
set str {}
foreach word [lrange [split $key _] 1 end] {
regexp {(.)(.*)} $word -> l rest
lappend str "$l[string tolower $rest]"
}
join $str
}
proc regb::build_tree_tab {nb key} {
set font {Tahoma 8}
set f [$nb insert end $key -text [make_readable $key]]
set pw [panedwindow $f.pw -ori vert]
bind $pw <Double-1> {toggle'ori %W}
set tf [labelframe $pw.tf -text $key -font $font]
$pw add $tf
set sw [ScrolledWindow $tf.sw -relief sunken -borderwidth 0]
set tree [Tree $sw.tree -deltax 8 \
-opencmd "regb::change_node 1 $sw.tree" \
-closecmd "regb::change_node 0 $sw.tree"]
$sw setwidget $tree
pack $sw -fill both -expand yes
set sw [ScrolledWindow $pw.sw -borderwidth 0]
$pw add $sw
set txt [text $sw.txt -font $font]
$txt tag config MAINKEY -font "$font bold"
$sw setwidget $txt
pack $pw -fill both -expand yes
after idle "$pw sash place 0 0 140"
$tree configure -selectcommand "regb::update_contents $txt"
$nb itemconfigure $key \
-createcmd "regb::init_tree $tree $key" \
-raisecmd "focus $tree"
return $tree
}
proc toggle'ori w {
$w config -ori [expr {[$w cget -ori] eq "horizontal"? "vertical" : "horizontal"}]
}
proc regb::init_tree {tw key} {
variable PROGTXT "Creating Tree for \n $key"
variable PROGINC -1
ProgressDlg .prg -textvariable ::regb::PROGTXT -variable ::regb::PROGINC \
-type infinite -maximum 50000
$tw configure -redraw 0
add_nodes $tw root $key 0
$tw configure -redraw 1
update
destroy .prg
}
proc max args {
if {[llength $args] == 1} {
set args [lindex $args 0]
}
lindex [lsort -dict -dec $args] 0
}
set regb::NODECOUNT 0
proc regb::add_nodes {tw node key {cfg 1}} {
variable PROGINC
if [catch {registry keys $key} keys] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get keys from registry.\nKey: $key\nError: $keys"
} else {
set cursor [$tw cget -cursor]
$tw configure -cursor watch
foreach k $keys {
$tw insert end $node nd:[incr ::regb::NODECOUNT] \
-text $k \
-data "$key\\$k" \
-drawcross allways \
-image [Bitmap::get folder]
incr PROGINC
}
$tw configure -cursor $cursor
}
set data "$key\n\n"
if [catch {registry values $key} vals] {
tk_messageBox -icon error -title "Registry Lookup Failed" -message \
"Unable to get values from registry.\nKey: $key\nError: $vals"
append data "ERROR: Cannot Get Values"
} else {
set items {}
foreach n $vals {
set t [registry type $key $n]
set v [registry get $key $n]
if {$t eq "binary"} {set v [hexdump $v]}
lappend items [format "%s (%s) %s" $n $t $v ]
}
if {[llength $items]} {
append data [join $items "\n"]
} else {append data "(no values)"}
}
if { $cfg } {
$tw itemconfigure $node -drawcross auto -data $data
}
incr PROGINC
}
proc regb::update_contents {txt tw node} {
$txt config -state normal
$txt delete 1.0 end
set dat [$tw itemcget $node -data]
if {[$tw itemcget $node -drawcross] eq "allways"} {
add_nodes $tw $node $dat
set dat [$tw itemcget $node -data]
}
$txt insert end $dat
$txt tag add MAINKEY 1.0 2.0
$txt config -state disabled
}
proc regb::change_node {open tw node} {
if {$open} {
if {[$tw itemcget $node -drawcross] eq "allways"} {
add_nodes $tw $node [$tw itemcget $node -data]
if {[llength [$tw nodes $node]]} {
$tw itemconfigure $node -image [Bitmap::get openfold]
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
} else {
$tw itemconfigure $node -image [Bitmap::get openfold]
}
} else {
$tw itemconfigure $node -image [Bitmap::get folder]
}
}#-- toplevel entry function proc registrar {{w ""}} {regb::build_screen $w}Note: even though this is only passively reading the registry, you can use it to change it as well. Just copy the text widget's contents into a buffer, put "registry set " in front, brace the name (because of the backslashes), remove the type (everything is an sz), and possibly quote the value. Eval and go...
MHo 2010-01-19: Just made a starpack of the above code because I quickly needed a browser to quickly inspect the registry while logged on as a normal user. Is there a way to avoid the invalid command name hexdump-message? I think this is a procedure available in your environment somewhere.
Category Windows
