Updated 2012-09-12 09:46:02 by LkpPo

Bob Rashkin

[email protected]

http://users.t-3.cc/ranchocabron

The one application of which I am (perhaps inappropriately) proud is a Hex Analysis application:
    proc doScan {stadd fsz} {
        global fid fid2 val hval flnm tag
    #
        . configure -cursor watch
        update
    #
        set bold "-background #44aaaa -foreground white"
        set normal "-background {} -foreground {}"
        .top.val delete 0.0 end
        if {$fsz == 0} {set fsz [expr {[file size $flnm] -$stadd}]}
        if {$fsz>5000} {
            .top.val insert end "scanning more than 5000 bytes at a time\n" c1
            .top.val insert end "can result in unpredictable behavior\n" c1
        }
        set nlns [expr {$fsz/16}]
        if {[expr {fmod($fsz,16)}]>0} {incr nlns}
        set fid2 [open $flnm r]
        fconfigure $fid2 -translation binary
        seek $fid2 $stadd start
        cd [file dirname $flnm]
        set t 0
        set lnadd $stadd
        for {set ln 1} {$ln <= $nlns} {incr ln} {
            set val [read $fid2 16]
            set nbyt [string length $val]
            set fmnum [expr {2*$nbyt}]
            binary scan $val H$fmnum hval;#<<<<<<<<<<<<<<<<<convert to hex
            .top.val insert end "[format %5d $lnadd]: "
            .top.val insert end $hval d$t
            set val [string map {"\t" " " "\n" " "} $val]
            set astr "     "
            set spcs [expr {32-$fmnum}]
            for  {set i 1} {$i<=$spcs} {incr i} {append astr " "}
            append astr "  $val"
            .top.val insert end $astr
            .top.val insert end \n
            lappend dlist d$t
            incr t
            incr lnadd 16
            if [eof $fid2] {set ln $nlns}
        }
        close $fid2
        .top.val tag configure c1 -foreground red
        # Create bindings for tags.
        foreach tag $dlist {
            .top.val tag bind $tag <Any-Enter> ".top.val tag configure $tag $bold"
            .top.val tag bind $tag <Any-Leave> ".top.val tag configure $tag $normal"
            .top.val tag bind $tag <1> "scanBin $tag"
        }
    #
        . configure -cursor arrow
        update  ure -cursor arrow
    #
    }
    proc scanBin {hxline} {
        global val val1 val2 val3
        .middle.left.hval delete 0.0 end
        .middle.right.hval delete 0.0 end
        set val [.top.val get $hxline.first $hxline.last]
        set val2 [binary format "H32" $val]
        for {set i 0} {$i<=7} {incr i} {
            set val3 [string range $val2 $i $i]
            binary scan $val3 B8 hval;#<<<
            binary scan $val3 H2 val4
            binary scan $val3 c dval
            set dval [expr {( $dval + 0x100 ) % 0x100}]
            .middle.left.hval insert end $val4\t$hval\t$dval\n
        }
        for {set i 8} {$i<=15} {incr i} {
            set val3 [string range $val2 $i $i]
            binary scan $val3 B8 hval;#<<<
            binary scan $val3 H2 val4
            binary scan $val3 c dval
            set dval [expr {( $dval + 0x100 ) % 0x100}]
            .middle.right.hval insert end $val4\t$hval\t$dval\n
        }
    }
    #------------------------Main------------------------------
    wm title . Binary_Data_Analyzer
    wm deiconify .
    frame .top -borderwidth 4
    frame .middle -borderwidth 4
    frame .bottom -borderwidth 4
    pack .top .middle .bottom -side top
    set w .top
    for {set i 0} {$i<65} {incr i} {append lblstr " "}
    set lblstr [string replace $lblstr 2 5 Addr]
    set lblstr [string replace $lblstr 15 26 "16 Bytes HEX"]
    set lblstr [string replace $lblstr 52 56 ASCII]
    label $w.read2 -text $lblstr -fg blue -font {courier 9}
    text $w.val -height 12 -width 65 -yscrollcommand "$w.yscr set" -font {courier 9}
    scrollbar $w.yscr -command "$w.val yview"
    pack $w.yscr -side right -fill y
    pack $w.read2 $w.val -side top
    set w .middle
    frame .middle.left -borderwidth 4
    frame .middle.right -borderwidth 4
    pack .middle.left .middle.right -side left
    set w .middle.left
    for {set i 1} {$i<=28} {incr i} {append binlbl " "}
    set binlbl [string replace $binlbl 0 2 Hex]
    set binlbl [string replace $binlbl 9 14 Binary]
    set binlbl [string replace $binlbl 22 26 U-Int]
    label $w.scan -text "BinaryScan 0-7"
    label $w.tit2 -text $binlbl -font {courier 9} -fg blue
    text $w.hval -height 8 -width 28 -font {courier 9}
    pack $w.scan $w.tit2 $w.hval -side top
    set w .middle.right
    label $w.scan -text "BinaryScan 8-15"
    label $w.tit2 -text $binlbl -font {courier 9} -fg blue
    text $w.hval -height 8 -width 28 -font {courier 9}
    pack $w.scan $w.tit2 $w.hval -side top
     if {[winfo depth $w] > 1} {
        set bold "-background #43ce80 -relief raised -borderwidth 1"
        set normal "-background {} -relief flat"
     } else {
        set bold "-foreground white -background black"
        set normal "-foreground {} -background {}"
     }
    
    set w .bottom
    label $w.flbl -text "File name:  "
    entry $w.fent -textvariable flnm -width 42 -font {-size 9 -weight bold}
    button $w.scan -text Scan -width 42 -activebackground white -command {doScan $stadd $lngt}
    button $w.getf -text File -command {set flnm [tk_getOpenFile]}
    frame $w.add -borderwidth 4
    pack $w.add -side bottom
    pack $w.scan -side bottom
    pack $w.flbl $w.fent $w.getf -side left -padx 6
    set stadd 0
    set lngt 0
    if {$argc>0} {set flnm [lindex $argv 0];set lngt 5000;doScan 0 5000}
    set w .bottom.add
    label $w.dim -text "in Bytes >    "
    label $w.stlab -text "start address:"
    entry $w.stent -textvariable stadd -width 8
    label $w.lnlab -text Length:
    entry $w.lnent -textvariable lngt -width 8
    label $w.wrng -text "0=to EOF" -justify left
    pack $w.dim $w.stlab $w.stent $w.lnlab $w.lnent $w.wrng -side left -padx 6
    bind . <Escape> exit
    bind . <Return> {doScan $stadd $lngt}
    bind . <Control-F1> {console show}
    bind .bottom.add.lnent <Button-3> {set lngt [file size $flnm]}
    bind .bottom.add.stent <Button-3> {incr stadd $lngt}
    menu .menu -tearoff 0
    set m .menu.help 
    menu $m -tearoff 0
    .menu add cascade -label "Don't panic" -menu $m -underline 0 
    $m add cascade -label "System" -menu .menu.help.sys -underline 0
    $m add cascade -label "General" -menu .menu.help.gen -underline 0
    $m add cascade -label "Quirks" -menu .menu.help.qks -underline 0
    set m .menu.help.gen
    menu $m -tearoff 0
    $m add check -label "Scan button reads in file as HEX and ASCII in 16byte chunks" 
    $m add check -label "If start is not 0, reading starts at the address specified (in decimal)"
    $m add check -label "If Length is 0, the entire file is read (or to EOF)"
    $m add check -label "Otherwise only (decimal) Length number of bytes is read"
    $m add separator
    $m add check -label "If invoked from the command line, will take filename as argument"
    $m add check -label "   and scan from 0 to 5000"
    $m add separator
    $m add check -label "Move cursor over any line of HEX,"
    $m add check -label "Left click to analyze each byte of highlit line"
    $m add separator
    $m add check -label "The File button opens a file dialog"
    set m .menu.help.sys
    menu $m -tearoff 0
    $m add check -label "Requires Tcl/Tk 8.3 or higher"
    set m .menu.help.qks
    menu $m -tearoff 0
    $m add check -label "Right click in the Length entry to compute file size"
    $m add check -label "Very big files can overflow something (tag array?)"
    $m add check -label ">Not sure what 'very big' is but 5000 bytes or"
    $m add check -label "               fewer at a time certainly works"
    $m add check -label "<Enter> (return) anywhere in the main window is the same as Scan"
    $m add separator
    $m add check -label "Right click on Start Address entry increments by Length"
    . configure -menu .menu

Thanks to Larry Virden for teaching me how to post this properly.