Updated 2011-11-16 16:37:00 by AK

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?
  2. How hard would it be to implement save/restore?
  3. 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  <Double-1> "select_node 2 $tree $txt"
     $tree bindImage <Double-1> "select_node 2 $tree $txt"
     $tree bindText  <Control-1> "select_node 3 $tree $txt"
     $tree bindImage <Control-1> "select_node 3 $tree $txt"
  
     bind $tree <Up> "arrow_select up $tree $txt $key"
     bind $tree <Down> "arrow_select down $tree $txt $key"
     bind $tree <Left> "arrow_select left $tree $txt $key"
     bind $tree <Right> "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  <Double-1> "select_node 2 $tree $txt"
     $tree bindImage <Double-1> "select_node 2 $tree $txt"
     $tree bindText  <Control-1> "select_node 3 $tree $txt"
     $tree bindImage <Control-1> "select_node 3 $tree $txt"
  
     bind $tree <Up> "arrow_select up $tree $txt $key"
     bind $tree <Down> "arrow_select down $tree $txt $key"
     bind $tree <Left> "arrow_select left $tree $txt $key"
     bind $tree <Right> "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