''Please repalce the image with one that isn't password protected on an external site'' ''[escargo] 1 Apr 2005 - Apparently the image file is now stored in a site that requires authentication. The image is always broken.'' A Simple [browser] for seeing what's in your Registry (''requires [BWidget] package, available from http://tcllib.sourceforge.net/'') '''BBH''' 10April2001 New version using BWidget 1.3 (original done with 1.2.1), so removed all explicit bindings & take advantage of selectcommand. (Old version still listed below). Worked for me with [ActiveState]'s [ActiveTcl] 8.4.3.2 on Win98, except for an error reading the "Performance Data" tab. I suspect this is because I'm using Win98. -- [Ro] Some questions ''(added by [escargo] on 10/23/2002)'' 1. Is it '''possible''' to extend this browser to save and restore registry settings? 1. How hard would it be to implement save/restore? 1. Would it be possible to extend the browser to preserve the registry settings in some way and then compare current and preserved settings to highlight the differences? LES - ''How about bookmarking?'' ---- ====== # # simple registry browser # package require registry package require BWidget 1.3 set BaseKeys { HKEY_LOCAL_MACHINE HKEY_USERS HKEY_CLASSES_ROOT HKEY_CURRENT_USER HKEY_CURRENT_CONFIG HKEY_PERFORMANCE_DATA HKEY_DYN_DATA } ################################################################################# font create Tabs -family Arial -size 8 -weight bold -slant italic font create Help -family Arial -size 10 font create HelpSect -family Arial -size 10 -weight bold font create HelpHead -family Arial -size 12 -weight bold font create Frames -family Arial -size 8 -weight bold font create Keys -family Arial -size 8 font create Values -family Arial -size 8 font create FullKey -family Arial -size 8 -weight bold -slant italic font create ValName -family Arial -size 8 -weight bold set PROGINC -1 set PROGTXT "" ################################################################################# proc build_screen {} { wm title . "Registry Browser" NoteBook .nb -font Tabs build_info_tab .nb foreach k $::BaseKeys { build_tree_tab .nb $k } .nb compute_size pack .nb -fill both -expand yes .nb raise [.nb pages 0] } proc build_info_tab {nb} { set f [$nb insert end help -text Help] text $f.t -tabs {1c 2c 5c} -relief flat \ -font Help -background [. cget -background] pack $f.t $f.t tag config HEAD -font HelpHead -justify center $f.t tag config SECT -font HelpSect $f.t insert end "Simple Registry Browser" HEAD $f.t insert end "\n\n" $f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n" $f.t insert end "\tSelecting a key on the left side shows all values" $f.t insert end " under that key\n" $f.t insert end "\t\n\n" $f.t insert end "\tMouse Actions:\n" SECT $f.t insert end "\t\tClick :\t Selects that key\n" $f.t insert end "\t\tClick :\t (on Cross) Opens/Closes Folder\n" $f.t insert end "\t\n" $f.t insert end "\tArrow Key Actions:\n" SECT $f.t insert end "\t\tUp :\t Moves selection to previous key\n" $f.t insert end "\t\tDown :\t Moves selection to next key\n" $f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n" $f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n" } proc make_readable {key} { set str {} foreach word [lrange [split $key _] 1 end] { regexp {(.)(.*)} $word -> l rest lappend str "$l[string tolower $rest]" } return [join $str] } proc build_tree_tab {nb key} { set f [$nb insert end $key -text [make_readable $key]] set pw [PanedWindow $f.pw -side top] set lp [$pw add -weight 1] set tf [TitleFrame $lp.tf -text "$key" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set tree [Tree $sw.tree \ -opencmd "change_node 1 $sw.tree" \ -closecmd "change_node 0 $sw.tree"] $sw setwidget $tree pack $sw $tf -fill both -expand yes set rp [$pw add -weight 2] set tf [TitleFrame $rp.tf -text "Contents" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ] $txt tag config MAINKEY -font FullKey $txt tag config NAME -font ValName $sw setwidget $txt pack $sw $tf -fill both -expand yes pack $pw -fill both -expand yes $tree configure -selectcommand "update_contents $txt" $nb itemconfigure $key \ -createcmd "init_tree $tree $key" \ -raisecmd "focus $tree" return $tree } proc init_tree {tw key} { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Creating Tree for \n $key" set ::PROGINC -1 $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 NODECOUNT 0 proc add_nodes {tw node key {cfg 1}} { 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 c -1 foreach k $keys { $tw insert end $node nd:[incr ::NODECOUNT] \ -text $k \ -font Keys \ -data "$key\\$k" \ -drawcross allways \ -image [Bitmap::get folder] incr ::PROGINC } } set data "$key\n\n" set tab1 [font measure Values "Name"] set tab2 [font measure Values "Type"] 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] lappend items [format "%s\t %s \t%s" $n $t $v ] set tab1 [max $tab1 [font measure Values $n]] set tab2 [max $tab2 [font measure Values $t]] } if {[llength $items]} { append data "Name\tType\tValue\n" append data [join $items "\n"] } else { append data "NO VALUES" } } if { $cfg } { $tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data] } incr ::PROGINC } proc 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] == "allways"} { add_nodes $tw $node $dat set dat [$tw itemcget $node -data] } foreach {tab1 tab2 str} $dat {} set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center " append tabs "[expr {$tab1 + $tab2 + 20}] left" $txt config -tabs $tabs $txt insert end $str $txt tag add MAINKEY 1.0 2.0 $txt tag add NAME 3.0 4.0 $txt config -state disabled } proc change_node {open tw node} { if {$open} { if {[$tw itemcget $node -drawcross] == "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] } } ################################################################################# build_screen tkwait window . ====== ---- Older version for that handles all keyboard traversal & selection actions explicitly ---- ====== # # simple registry browser # package require registry package require BWidget set BaseKeys { HKEY_LOCAL_MACHINE HKEY_USERS HKEY_CLASSES_ROOT HKEY_CURRENT_USER HKEY_CURRENT_CONFIG HKEY_PERFORMANCE_DATA HKEY_DYN_DATA } ############################################################################## font create Tabs -family Arial -size 8 -weight bold -slant italic font create Help -family Arial -size 10 font create HelpSect -family Arial -size 10 -weight bold font create HelpHead -family Arial -size 12 -weight bold font create Frames -family Arial -size 8 -weight bold font create Keys -family Arial -size 8 font create Values -family Arial -size 8 font create FullKey -family Arial -size 8 -weight bold -slant italic font create ValName -family Arial -size 8 -weight bold set PROGINC -1 set PROGTXT "" ############################################################################## proc build_screen {} { wm title . "Registry Browser" NoteBook .nb -font Tabs build_info_tab .nb foreach k $::BaseKeys { build_tree_tab .nb $k } .nb compute_size pack .nb -fill both -expand yes .nb raise [.nb pages 0] } proc build_info_tab {nb} { set f [$nb insert end help -text Help] text $f.t -tabs {1c 2c 5c} -relief flat \ -font Help -background [. cget -background] pack $f.t $f.t tag config HEAD -font HelpHead -justify center $f.t tag config SECT -font HelpSect $f.t insert end "Simple Registry Browser" HEAD $f.t insert end "\n\n" $f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n" $f.t insert end "\tSelecting a key on the left side shows all values under that key\n" $f.t insert end "\t\n\n" $f.t insert end "\tMouse Actions:\n" SECT $f.t insert end "\t\tClick :\t Selects that key\n" $f.t insert end "\t\tDouble Click :\t Opens/Closes that key folder (subkeys)\n" $f.t insert end "\t\tControl Click :\t Recursively opens entire subtree \n" $f.t insert end "\t\n" $f.t insert end "\tArrow Key Actions:\n" SECT $f.t insert end "\t\tUp :\t Moves selection to previous key\n" $f.t insert end "\t\tDown :\t Moves selection to next key\n" $f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n" $f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n" } proc make_readable {key} { set str {} foreach word [lrange [split $key _] 1 end] { regexp {(.)(.*)} $word -> l rest lappend str "$l[string tolower $rest]" } return [join $str] } proc build_tree_tab {nb key} { set f [$nb insert end $key -text [make_readable $key]] set pw [PanedWindow $f.pw -side top] set lp [$pw add -weight 1] set tf [TitleFrame $lp.tf -text "$key" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set tree [Tree $sw.tree \ -opencmd "change_node 1 $sw.tree" \ -closecmd "change_node 0 $sw.tree"] $sw setwidget $tree pack $sw $tf -fill both -expand yes set rp [$pw add -weight 2] set tf [TitleFrame $rp.tf -text "Contents" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ] $txt tag config MAINKEY -font FullKey $txt tag config NAME -font ValName $sw setwidget $txt pack $sw $tf -fill both -expand yes pack $pw -fill both -expand yes $tree bindText <1> "select_node 1 $tree $txt" $tree bindImage <1> "select_node 1 $tree $txt" $tree bindText "select_node 2 $tree $txt" $tree bindImage "select_node 2 $tree $txt" $tree bindText "select_node 3 $tree $txt" $tree bindImage "select_node 3 $tree $txt" bind $tree "arrow_select up $tree $txt $key" bind $tree "arrow_select down $tree $txt $key" bind $tree "arrow_select left $tree $txt $key" bind $tree "arrow_select right $tree $txt $key" $nb itemconfigure $key \ -createcmd "init_tree $tree $key" \ -raisecmd "focus $tree" return $tree } proc init_tree {tw key} { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Creating Tree for \n $key" set ::PROGINC -1 $tw configure -redraw 0 add_nodes $tw root $key 0 $tw configure -redraw 1 update destroy .prg } set NODECOUNT 0 proc add_nodes {tw node key {cfg 1}} { 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 c -1 foreach k $keys { $tw insert end $node nd:[incr ::NODECOUNT] \ -text $k \ -font Keys \ -data "$key\\$k" \ -drawcross allways \ -image [Bitmap::get folder] incr ::PROGINC } } set data "$key\n\n" set tab1 [font measure Values "Name"] set tab2 [font measure Values "Type"] 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] lappend items [format "%s\t %s \t%s" $n $t $v ] set tab1 [max $tab1 [font measure Values $n]] set tab2 [max $tab2 [font measure Values $t]] } if {[llength $items]} { append data "Name\tType\tValue\n" append data [join $items "\n"] } else { append data "NO VALUES" } } if { $cfg } { $tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data] } incr ::PROGINC } proc max {a b} { if {$a > $b} {set a} {set b} } proc prev_vis_node {tw node} { if {[set idx [$tw index $node]] == 0} { if {"[set p [$tw parent $node]]" == "root"} { return $node } else { return $p } } else { return [last_vis_child $tw [$tw nodes [$tw parent $node] [incr idx -1]]] } } proc last_vis_child {tw node} { if {[$tw itemcget $node -open]} { if {[llength [set kids [$tw nodes $node]]]} { return [last_vis_child $tw [lindex $kids end]] } else { return $node } } else { return $node } } proc next_vis_node {tw node} { if {[$tw itemcget $node -open] && "[set n [$tw nodes $node 0]]" != ""} { return $n } else { if {"[set n [next_vis_sib $tw $node]]" == ""} { return $node } else { return $n } } } proc next_vis_sib {tw node} { set sib [$tw nodes [$tw parent $node] [expr 1 + [$tw index $node]]] if {"$sib" != ""} { return $sib } else { if {"[set p [$tw parent $node]]" == "root"} { return "" } else { return [next_vis_sib $tw $p] } } } proc arrow_select {arrow tw txt root} { set node [$tw selection get] if {"$node" == ""} { select_node 1 $tw $txt $root } else { switch $arrow { right { $tw itemconfigure $node -open 1 } left { $tw itemconfigure $node -open 0 } up { select_node 1 $tw $txt [prev_vis_node $tw $node] } down { select_node 1 $tw $txt [next_vis_node $tw $node] } } } } proc select_node {num tw txt node} { $tw selection set $node $tw see $node update switch $num { 3 { if {[$tw itemcget $node -open] == 0} { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Recursively Opening [$tw itemcget $node -text]" set ::PROGINC -1 $tw configure -redraw 0 $tw opentree $node $tw configure -redraw 1 update idletasks destroy .prg } else { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Creating Tree for \n $key" set ::PROGINC -1 $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 NODECOUNT 0 proc add_nodes {tw node key {cfg 1}} { 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 c -1 foreach k $keys { $tw insert end $node nd:[incr ::NODECOUNT] \ -text $k \ -font Keys \ -data "$key\\$k" \ -drawcross allways \ -image [Bitmap::get folder] incr ::PROGINC } } set data "$key\n\n" set tab1 [font measure Values "Name"] set tab2 [font measure Values "Type"] 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] lappend items [format "%s\t %s \t%s" $n $t $v ] set tab1 [max $tab1 [font measure Values $n]] set tab2 [max $tab2 [font measure Values $t]] } if {[llength $items]} { append data "Name\tType\tValue\n" append data [join $items "\n"] } else { append data "NO VALUES" } } if { $cfg } { $tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data] } incr ::PROGINC } proc 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] == "allways"} { add_nodes $tw $node $dat set dat [$tw itemcget $node -data] } foreach {tab1 tab2 str} $dat {} set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center " append tabs "[expr {$tab1 + $tab2 + 20}] left" $txt config -tabs $tabs $txt insert end $str $txt tag add MAINKEY 1.0 2.0 $txt tag add NAME 3.0 4.0 $txt config -state disabled } proc change_node {open tw node} { if {$open} { if {[$tw itemcget $node -drawcross] == "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] } } ################################################################################# build_screen tkwait window . ====== ---- Older version for that handles all keyboard traversal & selection actions explicitly ====== ---- # # simple registry browser # package require registry package require BWidget set BaseKeys { HKEY_LOCAL_MACHINE HKEY_USERS HKEY_CLASSES_ROOT HKEY_CURRENT_USER HKEY_CURRENT_CONFIG HKEY_PERFORMANCE_DATA HKEY_DYN_DATA } ############################################################################## font create Tabs -family Arial -size 8 -weight bold -slant italic font create Help -family Arial -size 10 font create HelpSect -family Arial -size 10 -weight bold font create HelpHead -family Arial -size 12 -weight bold font create Frames -family Arial -size 8 -weight bold font create Keys -family Arial -size 8 font create Values -family Arial -size 8 font create FullKey -family Arial -size 8 -weight bold -slant italic font create ValName -family Arial -size 8 -weight bold set PROGINC -1 set PROGTXT "" ############################################################################## proc build_screen {} { wm title . "Registry Browser" NoteBook .nb -font Tabs build_info_tab .nb foreach k $::BaseKeys { build_tree_tab .nb $k } .nb compute_size pack .nb -fill both -expand yes .nb raise [.nb pages 0] } proc build_info_tab {nb} { set f [$nb insert end help -text Help] text $f.t -tabs {1c 2c 5c} -relief flat \ -font Help -background [. cget -background] pack $f.t $f.t tag config HEAD -font HelpHead -justify center $f.t tag config SECT -font HelpSect $f.t insert end "Simple Registry Browser" HEAD $f.t insert end "\n\n" $f.t insert end "\tEach Tab is a seperate HKEY section of Registry\n" $f.t insert end "\tSelecting a key on the left side shows all values under that key\n" $f.t insert end "\t\n\n" $f.t insert end "\tMouse Actions:\n" SECT $f.t insert end "\t\tClick :\t Selects that key\n" $f.t insert end "\t\tDouble Click :\t Opens/Closes that key folder (subkeys)\n" $f.t insert end "\t\tControl Click :\t Recursively opens entire subtree \n" $f.t insert end "\t\n" $f.t insert end "\tArrow Key Actions:\n" SECT $f.t insert end "\t\tUp :\t Moves selection to previous key\n" $f.t insert end "\t\tDown :\t Moves selection to next key\n" $f.t insert end "\t\tRight :\t Opens key folder (subkeys)\n" $f.t insert end "\t\tLeft :\t Closes key folder (subkeys)\n" } proc make_readable {key} { set str {} foreach word [lrange [split $key _] 1 end] { regexp {(.)(.*)} $word -> l rest lappend str "$l[string tolower $rest]" } return [join $str] } proc build_tree_tab {nb key} { set f [$nb insert end $key -text [make_readable $key]] set pw [PanedWindow $f.pw -side top] set lp [$pw add -weight 1] set tf [TitleFrame $lp.tf -text "$key" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set tree [Tree $sw.tree \ -opencmd "change_node 1 $sw.tree" \ -closecmd "change_node 0 $sw.tree"] $sw setwidget $tree pack $sw $tf -fill both -expand yes set rp [$pw add -weight 2] set tf [TitleFrame $rp.tf -text "Contents" -font Frames] set sw [ScrolledWindow [$tf getframe].sw -relief sunken -borderwidth 2] set txt [text $sw.txt -font Values -wrap none -tabs {4c center 5c left} ] $txt tag config MAINKEY -font FullKey $txt tag config NAME -font ValName $sw setwidget $txt pack $sw $tf -fill both -expand yes pack $pw -fill both -expand yes $tree bindText <1> "select_node 1 $tree $txt" $tree bindImage <1> "select_node 1 $tree $txt" $tree bindText "select_node 2 $tree $txt" $tree bindImage "select_node 2 $tree $txt" $tree bindText "select_node 3 $tree $txt" $tree bindImage "select_node 3 $tree $txt" bind $tree "arrow_select up $tree $txt $key" bind $tree "arrow_select down $tree $txt $key" bind $tree "arrow_select left $tree $txt $key" bind $tree "arrow_select right $tree $txt $key" $nb itemconfigure $key \ -createcmd "init_tree $tree $key" \ -raisecmd "focus $tree" return $tree } proc init_tree {tw key} { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Creating Tree for \n $key" set ::PROGINC -1 $tw configure -redraw 0 add_nodes $tw root $key 0 $tw configure -redraw 1 update destroy .prg } set NODECOUNT 0 proc add_nodes {tw node key {cfg 1}} { 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 c -1 foreach k $keys { $tw insert end $node nd:[incr ::NODECOUNT] \ -text $k \ -font Keys \ -data "$key\\$k" \ -drawcross allways \ -image [Bitmap::get folder] incr ::PROGINC } } set data "$key\n\n" set tab1 [font measure Values "Name"] set tab2 [font measure Values "Type"] 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] lappend items [format "%s\t %s \t%s" $n $t $v ] set tab1 [max $tab1 [font measure Values $n]] set tab2 [max $tab2 [font measure Values $t]] } if {[llength $items]} { append data "Name\tType\tValue\n" append data [join $items "\n"] } else { append data "NO VALUES" } } if { $cfg } { $tw itemconfigure $node -drawcross auto -data [list $tab1 $tab2 $data] } incr ::PROGINC } proc max {a b} { if {$a > $b} {set a} {set b} } proc prev_vis_node {tw node} { if {[set idx [$tw index $node]] == 0} { if {"[set p [$tw parent $node]]" == "root"} { return $node } else { return $p } } else { return [last_vis_child $tw [$tw nodes [$tw parent $node] [incr idx -1]]] } } proc last_vis_child {tw node} { if {[$tw itemcget $node -open]} { if {[llength [set kids [$tw nodes $node]]]} { return [last_vis_child $tw [lindex $kids end]] } else { return $node } } else { return $node } } proc next_vis_node {tw node} { if {[$tw itemcget $node -open] && "[set n [$tw nodes $node 0]]" != ""} { return $n } else { if {"[set n [next_vis_sib $tw $node]]" == ""} { return $node } else { return $n } } } proc next_vis_sib {tw node} { set sib [$tw nodes [$tw parent $node] [expr 1 + [$tw index $node]]] if {"$sib" != ""} { return $sib } else { if {"[set p [$tw parent $node]]" == "root"} { return "" } else { return [next_vis_sib $tw $p] } } } proc arrow_select {arrow tw txt root} { set node [$tw selection get] if {"$node" == ""} { select_node 1 $tw $txt $root } else { switch $arrow { right { $tw itemconfigure $node -open 1 } left { $tw itemconfigure $node -open 0 } up { select_node 1 $tw $txt [prev_vis_node $tw $node] } down { select_node 1 $tw $txt [next_vis_node $tw $node] } } } } proc select_node {num tw txt node} { $tw selection set $node $tw see $node update switch $num { 3 { if {[$tw itemcget $node -open] == 0} { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Recursively Opening [$tw itemcget $node -text]" set ::PROGINC -1 $tw configure -redraw 0 $tw opentree $node $tw configure -redraw 1 update idletasks destroy .prg } else { ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \ -type infinite -maximum 50000 set ::PROGTXT "Recursively Closeing [$tw itemcget $node -text]" set ::PROGINC -1 $tw configure -redraw 0 $tw closetree $node $tw configure -redraw 1 update idletasks destroy .prg } } 2 { if {[$tw itemcget $node -open] == 0} { $tw itemconfigure $node -open 1 } else { $tw itemconfigure $node -open 0 } } } $txt config -state normal $txt delete 1.0 end set dat [$tw itemcget $node -data] if {[$tw itemcget $node -drawcross] == "allways"} { add_nodes $tw $node $dat set dat [$tw itemcget $node -data] } foreach {tab1 tab2 str} $dat {} set tabs "[expr {$tab1 + ($tab2 / 2) + 10}] center [expr {$tab1 + $tab2 + 20}] left" $txt config -tabs $tabs $txt insert end $str $txt tag add MAINKEY 1.0 2.0 $txt tag add NAME 3.0 4.0 $txt config -state disabled } proc change_node {open tw node} { if {$open} { if {[$tw itemcget $node -drawcross] == "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] } } ###################################################################################### build_screen tkwait window . ====== ---- 21 Aug, 2003 - Why are there three versions of the same program? Which one is newest? How old are they? Is there a really good reason to keep them all here? ---- [LV] 2006-Feb-22 I tried the first of the 3 above programs using [ActiveTcl] 8.4.10.something (1 or 2 I think), on Windows XP SP2. When I click on the Dyn Data tab, I get the error: Unable to get keys from registry. Key: HKEY_DYN_DATA Error: unable to open key: The handle is invalid. A similar one of these showed up under the Local Machine tab, when I clicked on the security key. This time, the error says: Unable to get keys from registry. Key: HKEY_LOCAL_MACHINE\SECURITY Error: unable to open key: Access is denied. Anyone have a fix for these errors? [MEd] I think thats not really a script-error, the HKEY_DYN_DATA just does not exist in Win XP (i checked my registry with regedit.exe, also running on WinXP) and the HKEY_LOCAL_MACHINE\SECURITY is only browsable when logged in with Administrator-rights. [MHo] 2006-Feb-22 Sometimes screen updates do not take place. Program stops responding building tree für HKCR. Klicking on the close-icon in the upper right corner leads to an error message (invalid command name "older"...). ---- See also: [Microsoft Windows and Tcl] - [Microsoft Windows and Tk] - [Windows: getting desktop properties] - http://www.cleanerreview.com/%|%registry cleaner reviews%|% http://www.top-registry-cleaner.org%|%vista registry cleaner%|% http://registrycleanertechinfo.com%|%windows registry cleaner%|% http://www.ccleanerdownloadx.com%|%ccleaner download%|% <> Arts and crafts of Tcl-Tk programming | Windows | Desktop