Updated 2017-04-18 08:53:03 by pooryorick

See Also  edit

Based numbers
with the special case 'base 16'

Hex to decimal  edit

% set hex 3A
3A
% scan $hex %x decimal
1
% set decimal
58

MJL: [expr] is slower but doesn't ignore invalid hexadecimal characters
% set decimal [expr 0x$hex]
58
% set hex 3G        
3G
% set decimal [expr 0x$hex]
syntax error in expression "0x3G": extra tokens at end of expression

For extracting "unsigned" floating-point values from very long (>32 bits) integers in hex, MS has this recommendation on c.l.t.:
proc hex2dec {largeHex} {
    set res 0
    foreach hexDigit [split $largeHex {}] {
        set new 0x$hexDigit
        set res [expr {16*$res + $new}]
    }
    return $res
}

Decimal to hex  edit

format %X $decimalNumber

For numbers of arbitrary size, use the ll size modifer:
format %4.4llX $decimalNumber

An example in combination with a minimal field width, zero-padded:
format %04X $decimalNumber

This works for all sorts of numbers, such as
format %08.3f [expr {4*atan(1)}] ;# -> 0003.142

Character to Hex  edit

format %4.4X [scan $c %c]

Notice that [scan $c %c] only does what one wants with newer Tcl's, those since version 8.3.0+.

Since Tcl 8.6 there's binary decode/encode hex. Example:
% binary encode hex "Hello, world!"
48656c6c6f2c20776f726c6421
% binary decode hex 42657761726520756e69636f6465206368617273
Beware unicode chars

Be careful thought, chars with code>255, only the lower byte is encoded. And at decoding time each pair of hex digits XY will be encoded into unicode char U+00XY. If you need utf-8 hex conversion, use:
% binary encode hex [encoding convertto utf-8 "€"]
e282ac
% encoding convertfrom utf-8 [binary decode hex e282ac]
€

mfi: Can someone suggest a pure Tcl replacement for xxd UNIX command (creates a hex dump of a given string)?

RS: Sure enough:
proc string2hex {string} {
    set where 0
    set res {}
    while {$where<[string length $string]} {
        set str [string range $string $where [expr $where+15]]
        if {![binary scan $str H* t] || $t==""} break
        regsub -all (....) $t {\1 } t4
        regsub -all (..) $t {\1 } t2
        set asc ""
        foreach i $t2 {
            scan $i %2x c
            append asc [expr {$c>=32 && $c<=127? [format %c $c]: "."}]
        }
        lappend res [format "%7.7x: %-42s %s" $where $t4  $asc]
        incr where 16
    }
    join $res \n
}

See also Dump a file in hex and ASCII

LH: Here's something similar, but speeds things up by using external storage for a character map that is generated one time:
proc xxd2 {charMapname convertString} {
    upvar $charMapname mycharMap

    #generate a character map for displaying hex equiv of chars [0..127]
    if { 0 == [string length $mycharMap] } {
        # init charmap
        for {set i 0 } { $i < 128 } { incr i } { 
            append mycharMap "[format " \\%03o {%02x }" $i $i ]"
        }
    }
 
    string map $mycharMap $convertString
}

#example:
set hexcharMap ""  ;# global variable
xxd2 hexcharMap "abcdz"           ;# slow, even if initialized
string map $hexcharMap "abcdez"   ;# much faster

[Bob Rashkin]: I know there are plenty of these around but I wanted something to do a hex analysis without all the overhead of editing:
proc getFile {} {
#this is just a file search before the new tk_getOpenFile
    global dirlst dirname filelst flnm
    set dirname [pwd]
    set filelst [glob -directory $dirname *]
    lappend filelst "$dirname/.."
    toplevel .open
    frame .open.up -borderwidth 4
    frame .open.bottom -borderwidth 4
    pack .open.up .open.bottom -side top
    set w .open.up
    listbox $w.hval -height 8 -font {courier 9} -exportselection 1 \
        -yscrollcommand "$w.yscr set"  -listvar filelst \
        -xscrollcommand "$w.xscr set" -width 55
    scrollbar $w.yscr -command "$w.hval yview"
    scrollbar $w.xscr -command "$w.hval xview" -orient horizontal
    pack $w.yscr -side right -fill y
    pack $w.hval $w.xscr -side top -fill x
    bind .open.up.hval <Double-Button-1> {
        set filename [lindex $filelst [.open.up.hval curselection]]
    }
    bind .open.up.hval <Return> {
        set filename [lindex $filelst [.open.up.hval curselection]]
    }
    
    set u .open.bottom
    entry $u.filen -textvariable filename -width 50
    button $u.opn -text Open -command {
        if [file isdirectory $filename] {
            set filelst [glob -directory $filename *]
            lappend filelst "$filename/.."
        } else  {
            destroy .open
            set flnm $filename
        }
    }
    pack $u.filen $u.opn -side left -padx 8
    bind .open.bottom.filen <Return> {
        if [file isdirectory $filename] {
            set filelst [glob -directory $filename *]
        } else  {
            destroy .open
            set flnm $filename
        }
    }
    focus .open.bottom.filen
}

proc closeUp {fid} {
    close $fid
    .top.val delete 0.0 end
}

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}]}
    #.top.val insert end "Scanning $fsz bytes\n"
    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;#<<<<<<<---this is the key statement!
    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      -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
    }
}

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 21 28 Decimal]
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 {getFile}
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.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.stlab $w.stent $w.lnlab $w.lnent $w.wrng -side left -padx 6
bind . <Escape> exit
bind . <Return> {doScan $stadd $lngt}
bind .bottom.add.lnent <Button-3> {set lngt [file size $flnm]}
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 listbox to search files"
$m add check -label "Click Open to return the file to the main window file entry"
$m add check -label "                or open the indicated directory"
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 "<Enter> in the File window listbox brings the selection"
$m add check -label "              to the entry box"
$m add check -label "<Enter> in the file entry in the File window is the same as Open"
. configure -menu .menu

After that much code, here's a little one: convert a string to hex, so the result can be reparsed as the original string:
proc string2hex s {
    binary scan $s H* hex
    regsub -all (..) $hex {\\x\1}
} ;# RS
% string2hex "hello, world!"
\x68\x65\x6c\x6c\x6f\x2c\x20\x77\x6f\x72\x6c\x64\x21

% subst [string2hex "hello, world!"]
hello, world!

George Petasis: According to Donal Fellows, "encoding convertto utf-8" may be required before `[binary scan] is called on the string, as the internal representation of Tcl may not be "exactly" utf-8, thus a proper utf-8 representation must be generated first. Something like:
proc string2hex s {
    binary scan [encoding convertto utf-8 $s] H* hex
    regsub -all (..) $hex {\\x\1}
} ;# RS

AM: I needed to inspect the actual value of a number in a binary file. Actually the number was repeated many times, it represented a "missing value". Of course the program that needed to read this file had a different idea about what value constitutes a missing value. So I wanted to know what the actual value was (in human terms).

Via a hex viewer, I could see that the bytes were "5c ff 79 c4". In the chatroom, dkf came up with the following solution:
binary scan [binary format I 0x5cff79c4] f xx
set xx
-999.989990234

Explanation:

  • The string "0x5cff79c4" must be converted to a binary string
  • This can then be read via [binary scan]
  • Some caution is needed: the byte order. If the bytes are given in the same order as the machine expects, then use capital "I" in the [binary format]'s format. If the machine uses the opposite byte order, use a lowercase "i" instead. (The binary scan requires the "f" format in any case)

A poster on comp.lang.tcl asked how to convert binary to hex[1]. One proc that was provided in reply was:
proc bin2hex {bin} {
    set result ""
    set prepend [string repeat 0 [expr (4-[string length $bin]%4)%4]]
    foreach g [regexp -all -inline {[01]{4}} $prepend$bin] {
        foreach {b3 b2 b1 b0} [split $g ""] {
            append result [format %X [expr {$b3*8+$b2*4+$b1*2+$b0}]]
        }
    }
    return $result
} 

Another, by dkf was:
proc bin2hex {bin} {
    set result ""
    set prepend [string repeat 0 [expr (4-[string length $bin]%4)%4]]
    foreach g [regexp -all -inline {[01]{4}} $prepend$bin] {
        foreach {b3 b2 b1 b0} [split $g ""] {
            append result [format %X [expr {$b3*8+$b2*4+$b1*2+$b0}]]
        }
    }
    return $result
} 

And another replier pointed to [2], another thread from a couple weeks earlier, which generated:
proc convBinToHexNib { binIn {mode hex} } {
    set ret error
    switch -glob -- $mode {
        hex* {
            set val [binary format B $binIn]
            binary scan H $val ret
        } dec* {
            set val [binary format  B* 0000$binIn ]
            binary scan $val c ret
 
        } default {
           puts stderr "WHAT mode? $mode"
        }
    }
    return $ret 
}

and
# This works for up to 32 bits.
# Any more and the value will roll over.
proc bin2int {binstring} {
    set ret 0
    foreach bit [split $binstring ""] {
        set ret [expr {$ret << 1}]
        if {[string is boolean $bit]} {
            set ret [expr {$ret | $bit}]
        } else {
            error "string is not binary!"
        }
    }
    return $ret
}

# Usage: convert nybble to decimal:
set dec [bin2int 1010]

# convert nybble to hex:
format %x [bin2int 1010]

and
proc convBinToHexNib {binIn mode} {
    binary scan [binary format B8 0000$binIn] c1 num
    switch -exact -- $mode {
        dec {
            set result $num
        }
        hex {
            set result [format %x $num]
        }
        default {
            error "Unknown mode '$mode'"
        }

    }
    return $result

} 

as possible solutions.