[SeS] 12th Nov 2015 I present to you a simple Hex Editor. A poor man's IDE like [tG²] is not complete without one, so finally I got one created myself instead of relying on external tools for so many years. Mind you, this is work in progress, possibly some bugs exist. I am also aware of redundant procedures, which are placeholders at the moment. Feel free to comment or add your remarks/improvements on the script and ofcourse feel free to use it in your applications while honoring the BSD license. here a screenshot of it's current state: [http://members.upc.nl/~s.serper/img/hexeditor.png] Things I like about this hex editor: - It can be easily instantiated as a layout object in [tG²]'s Layout Editor. Wrapper will be made available in future versions as a [tG²]-plugin. - Dedicated namespace. - Simple & intuitive to control. - Instead of creating a tktable with thousands of equivalent cells to represent the complete content of the file, I have tried to be creative by mapping the filesegments on demand to visible cells of the table. Hence, I think this method consumes less memory and is probably faster to render by the tk-window managers. Things to do and which will be (hopefully) available in [tG²] once the plugin wrapper is finished: - search for data patterns - insert/delete bytes (+ bindings for Insert & Delete keys) - bindings for Home, End, PageUp/Down keys to provide additional navigation methods - mark ASCII char of selected byte-cell (link between hex & ascii string) - undo/redo? (not sure yet...) - performance testing + bugfixing + benchmarking with various file sizes To test it, please copy/paste the code section below into a file and source it. ---- [KPV]: I get an error on Linux due to the Window's only color: SystemDisabledText. ---- [SeS]: sorry for my late reply. I haven't tried it in Linux, so thanks for the feedback. I think a conditional selection for the color would be the simplest solution: ====== if {[tk windowingsystem]=="win32"} {set color SystemDisabledText} {set color gray55} ====== I will adapt it in future releases, the plugin is now available in [tG2]'s latest version. Some of the objectives I set for this gadget are still in queue, haven't implemented undo yet and I am not satisfied with the performance of adding/deleting bytes in relative large files. But, good enough for a first release ;-) ---- ====== # Copyright (C) 2015 by Sedat Serper, email : s.serper@chello.nl # # The author hereby grants permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, # provided that existing copyright notices are retained in all copies # and that this notice is included verbatim in any distributions. No # written agreement, license, or royalty fee is required for any of the # authorized uses. Modifications to this software may be copyrighted by # their authors and need not follow the licensing terms described here, # provided that the new terms are clearly indicated on the first page of # each file where they apply. # # IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND # NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, # AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. package require Tktable package require Img package require tile ;# not necessary for functionality, pure aesthetic reasons set wrapper "binary_x.tcl" set ::wrapLug($wrapper,version) "1.0" # ------------------------------------------------------------------------------ # namespace # ------------------------------------------------------------------------------ namespace eval ::Binary:: { image create photo ::Binary::downarrow -data { R0lGODlhDwAPAO4AAE1hhdvj+MnY/LnN+7vO/cLT/MLV/H2g1L7Q/J+10rnJ87rN/LzO+sjW+8XV /MXW/LzM88rZ/aC107LP+7PI9bbN+7jJ8rfN/LbO+8rY+a3J+b3O973T+9Th/Hyf09Dd/NDf/MrY /dHg/drm/s7b/bfK9c3b/L7R/LfT/LrU/LjL9rXJ87HG87HI87rM9LLI9K/F9LnL87rL9KzC9bPH 9a7A1oKk1pSx2Yin2LHC1YOk036f0qi71KS4073L2rDF8rDE8rHF86rA87fG8c/X3ZSw3a7E5arA 4cHV+8HT+8jY+8jV+8HS+7nO+6/O+7bR+7nP+7PR/M7d/cPV/eHq/tHe/cPT/c3a/MXT/Obu/Njj /LLN+8DQ97XI98TU98TS967I963D9rvN9bTI9rHH9r7Q+LXN+rHL+q/M+7zN+q7K+rfL+bDL+dzm +bvO+f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5 BAEAAG8ALAAAAAAPAA8AAAfVgG9HNzg6BzseHgeLNkVvAQFDFgqUFhQULyxARjUBQmtNDAxuUBVb bBpgPxIBMwsITCcnHChPE2gaQQkBYQgFVgYGSCkoUU5qLbtkBQ8AD1MGKRMAE2cUu2MOANsOBhzb AGYruyUNDeBJ4BgVMawqAiEh4NsYFwMyrBsmVwIC4AP2BkDoEaDMBykRzAEgsGDAggUQeATw0kGE iX5LEBDYyABCjgAZRmipQiKCAAdYCiBI48JHABBURlT8UFLJgwIMFBB5kwVEhi9cNohRUaILDRht 3gQCADs= } image create photo ::Binary::uparrow -data { R0lGODlhDwAPAO4AAE1hhdvj+MnY/LnN+7vO/cLT/MLV/H2g1L7Q/J+10rnJ87rN/LzO+sjW+8XV /MXW/LzM88rZ/aC107LP+7PI9bbN+7jJ8rfN/LbO+8rY+a3J+b3O973T+9Th/Hyf09Dd/NDf/MrY /dHg/drm/s7b/bfK9c3b/L7R/LfT/LrU/LjL9rXJ87HG87HI87rM9LLI9K/F9LnL87rL9KzC9bPH 9a7A1oKk1pSx2Yin2LHC1YOk036f0qi71KS4073L2rDF8rDE8rHF86rA87fG8c/X3ZSw3a7E5arA 4cHV+8HT+8jY+8jV+8HS+7nO+6/O+7bR+7nP+7PR/M7d/cPV/eHq/tHe/cPT/c3a/MXT/Obu/Njj /LLN+8DQ97XI98TU98TS967I963D9rvN9bTI9rHH9r7Q+LXN+rHL+q/M+7zN+q7K+rfL+bDL+dzm +bvO+f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5 BAEAAG8ALAAAAAAPAA8AAAfTgG9ZIBlfXBtiKiVdNDBtbwEgVCMdIh8kEUoPBQwKRAEZI1pVmAIO WAUIaS4+AV6VJgICSwgEtgwQOQFlH1IRDQ0ABAsDCwsQPAEbJleyAM8DFwMDED0BKgIhIc/cGNIy EgElwNxJ3RUx4WMO3A4GHNxmKwkBZAUPAA9TBikTABNnKNALg6CAFQMGkKRAEcWJmhb0ZixAwOTE CQ4onkxAoyEIPSFrmjBg4AZKhS1sNID5ES7AEAsKYlqgQOEFCyBGarw5cgOHjgM7PHg4QNRGkTeB AAA7 } image create photo ::Binary::arrowMdwn -data { iVBORw0KGgoAAAANSUhEUgAAAA8AAAAYCAYAAAFSApf/AAAABGdBTUEAAK/INwWK6QAAABl0RVh0 U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVcSURBVHjaYrh27drnHz9+MAAEEMuZM2cY 2NjYEgECiOXZs2e8ra2t/wECiOHbt28Mt27d+g8QQEzfv3//t2fPHgaAAGJ+/fp1g4yMTChAADF+ /PhR9caNG7eYmZkZ1NXVdQECiPnly5cPOTk52R4+fMgwZ86cLIAAYvj//7/e5s2bGbKzs5m+fPli ARBADD9//lwOMhFomRDQQA2AAGI4e/bs//fv3886derUf6AkA0AAsRw7dozh79+/q4ECqSwsLLEA AcT0798/hpMnT+6SlZVl2L17dw1AADHx8fExvHnzhuHp06cMmZmZxwACiOnSpUsN5ubmEcePH09j YmJKBAggxvPnz3/+9esXj7a29nKg46I+ffok9fjx46dAcxnk5eU7AQKI6fr16wyampoMN2/ejATq /g/07VMREZHMO3fugJy2FSAAACEA3v8CISEhoLS0tADDw8MAFhYWvMTExAC3t7eXJSUlpx4eHtYC iAVovNOuXbsYLCwsGF68eJEKlLizYsUKZqCTtYHWvAUIIGag178CnR6vp6fnA5Ro+/PnDxMw5LiB rp8PdE8/QAAxAhUwbNy4kQHo4qIdO3b0MTAwlE+ZMuUgkD4BxAwAAcT45MmT/6KioowgVwMVgcQY gEF+gYuL6xtAALGAPA8MyP/AUGEBCgLV/D0H9KI+0LEfAQKIBejH+48ePVIE6voD1HTg3bt3hkBX P+Hh4ZEFCCAmYCgpKisrM7x9+xaEHYSFhR8BI/gr0LrzAAHEBDSCYf/+/QxA7ySxsrK63r179wcw gNSBMcsFEECMQIn/V65cYZCWlmYASl578OCBlomJCQPQi6EAAcQMtKchOjqaAaia4cOHD6JWVlYM 06dPB5kWBhBATEDVDN3d3QwxMTEPTE1NXaZOncoASjWxsbFiAAHE2NHR0QZMMZW/f/9mAAYfKPYZ vL291wkJCVkBBBCzpKTkXqBjPgFDyx2YghiArt0BTDh+z58/TwMIIKaUlJSPQJf129nZ6QPTHSNQ 0BMY52/S09PVAQKIBSjID0xZ6UCdM0FhDbTrr4uLC8ihDAABxAhMXZ+BocPDz8/PALRiNZAdDRT/ DZIEOQwKJIAxtQPoTX2QAcB8wQAM++sAAcQItPLF/fv3xRkZGRlAWEBAABQmi4HuigNqEgLGy25g ijKCyQOj/CvQIi+g3CGAAGI8ceJEFTB1+QJNswAGOwOSIgagAaAcArYaGFcvgbgVGBpq4uLi94Ah sxQggBgnT578GZioeIAGMDg6OoIzJyglABMX2BCgV+4DDW4HxlIVECuAxEBeBAbOLYAAYgTGzD6g 7Y4gW0D+UVJSYrC2tt4LDHdvYBKSA8b9nqtXr8qB0hoIAzPIcWCqcQY65jtAADG2tLR8BvqTB6iB 4dy5cwyguADFKtCJDF+/fgW7ABRwxsbGDMDwYQCWKAzOzs5ngDZnAgQQy+fPnxlAWQtUuoDSBVCC 4fLly/9fvXr1H2SIvb09EzD5gdMLyMkg24EJWQqIbQACCJQN5IGmbV+9erUmyBZQ8gBqYHBzc1t7 9OhRBWDeMQZpAtluYGDAICEhsdzDw2MR0OZjAAHEGB8fDwoUUIAuBxZREUD/g0MZZgs7Ozu4IACm nK3AzOBvaGj4F6g2GliccAAEEOO+ffu+Llq0qB4o0ANK2kCgDUza04BOrhcUFGxav379fyDfS0dH 5ysosfj5+RUAY2QLkH0EIIDA2RsIDNeuXRsEjKLXQPYkUIiDnAksD2ApLA2oqRtYiLgB2SdhggAB xAjMowxIgBfo1Hqgxl6gX58D+RzA+D8aFBS0FciuY0ADAAEGABGVa+1QCoL8AAAAAElFTkSuQmCC } image create photo ::Binary::arrowMup -data { iVBORw0KGgoAAAANSUhEUgAAAA8AAAAYCAYAAAFSApf/AAAABGdBTUEAAK/INwWK6QAAABl0RVh0 U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVFSURBVHjaYv7+/TsDJycnA0AAMfz9+5fv 8ePHawACiFlXV/cSMzOzLUAAMYCkjh8/zgAQQCy5ubn/GRkZGQACiHHfvn33v3z5ogAQQMwXLlxg UFFRYcjKynLg4OB4ABBAjFeuXDH5+vXr6Zs3bzIADWAACCAmYWHhMwxA4OXlxfjr1y8GgABiBJm2 bt26s0Bt+//9+1cCEEBMQMs6Tp8+/eXTp0/zgZJfAQKI6dKlS3IfPnywW7x48RU1NTUtgABi7Ojo +M/Nzc0AVM7w+fPnLwABxALiBAYG3mdlZVVctWoVA0AAMd64ceMLFxfXzR8/fhjx8/O/BAggxidP noBsZThx4sTHTZs28UdERDDcvn2bQVpaujk4OLgWIIAYz549m3zy5Mm5jx492gK0zBvkLKAPGAQF BVc8f/48EiCAmIAEL1DR/xcvXngDvcdgZGT0DxgADEB+hISExGeAAGK8c+cOA1D3satXr1pqamo+ 0tHRUTt16tSP+/fvMzg6Ou4HCCAWWVlZMSYmprPi4uJKwNCS+/jx4w+gTgZbW1sGYPjsAQggxlu3 bl0D2q2pqKh4kY+PzwAY9CA3sz59+vTX+/fvvwAEEDisoKCpt7e3zcPDQ/D3799fgPzPAAHE9Pbt WwYgNk9PT38CNOkH0MHPgfYnWlhYGAIEEMubN29s9uzZcwdo/5XExMRDr169+q+lpWUPZJcABBDL sWPH5IEOOG5oaPhnwYIFoCgHufg/0HGMAAHEEhcX9xYY0H+Afmdwd3c/C4xN40OHDjFERkZeAwgg ZmCkHQQGKW9oaCgD0DoJoKsZxMTEGLdt2yYKEECMwEg8DRQ0AYU9KJn8//+fgZ2dHZx+AAKICRiu dsCYZgA6n8HJyUktPDx8LzAuGdjY2BgAAogJ6KBvIEcA7UgDJoNbDx8+dE5OTgbrBAggRqADCoHe +QMM+Ekg40AmgFKCgoLCCYAAYgKqPvvy5ctJILtkZGSEgX5cDLIbGAkWAAHECEyd/0Gq9fT0JIFB 9gJkBVDnKmBqCQUIIEaQEWjAAhhiRzds2FAFZHeCBIDhDaKKgGq/AumZ/v7+YIUAAcTy7ds3uKaD Bw9uWbFiRSWQzQwMDyaQoLe3dzjQtutAZh9QHiRUDwyBIjs7O1uAAGKcNWvWVKDXXYAKjIESX4B5 hgsY9GuBCjxAaRTkTGCgMhgbG19+8ODBfGACmwtU9wkYl/EAAcQIyiVAf3kABXMlJSUjnz17FnT+ /HmGP3/+gAMbmNgYgOkHbAgoPZuZmTEAA6gdaEAVQAAxgnIxEIgCbdwDTPx6IE1AUxnCwsL+CggI uAND8a6Ghsb+lStXKoDUgkKShYWFITY29hpAADF2dnbeBEaMGsjvIImAgABQkDMADWKAplwwAGVO kK179+5lOHfuHMiCLwABBAptYWBsOgKdHQRUHAkqOEC2gwAwIq8BM88zoDdcgBmKAVjoMACLDQag 90BemAIQQIxAU2KB/q65du2aGsgmkO3AguGWkpJSB1D8MdAgRmDKlAE6f+7+/fsZgYkQnPiAXvoC EEAsQkJCD4AF2zdQoACde1NeXn4C0JBKoMZ5oMQBAqBQB/kTmAkYgGUK2OmgtAcQQIw/f/5kAJVa QKADzMLbgSlYBsQBBRrQ9ANAZ94G5sFUUF4EuQrkdGARcx9ooTtAADECE2wH0JQMYN7jB2kCSUpJ SZ0H0j5A7jNQ5gEJA12zGBiNkcAsD3YNMEt8AQggUNbXAPprHtAvlsAS7SIQOwHl3sFCGTn5ggwG guWvX7+OAHrrC0CAAQDv+57Ct6IkSwAAAABJRU5ErkJggg== } # return text in binary (1 byte) proc ::Binary::Byte {v} { return [binary format c1 $v] } # return text in binary (2 bytes) proc ::Binary::Word {v} { return [binary format s1 $v] } # return text in binary (4 bytes) proc ::Binary::Dword {v} { return [binary format i1 $v] } # return text in Hex-byte (1 byte) proc ::Binary::Hbyte {v} { return [binary format H2 $v] } # return text in Hex-binary (2 bytes) proc ::Binary::Hword {v} { return [binary format H4 $v] } # returns bits in binary proc ::Binary::Bits {value} { append cb $value while {[string length $cb] >= 8} { set bits [string range $cb 0 7] set cb [string range $cb 8 end] append txt [binary format B8 $bits] } return $txt } # save file in binary format proc ::Binary::writeFile {file d} { set p [open $file w] fconfigure $p -translation binary puts -nonewline $p $d close $p } # save file in binary format proc ::Binary::readFile {file} { set f [open $file r] fconfigure $f -translation binary while {[set r [read $f 2]]!=""} { binary scan $r H4 b if {![info exists b]} {set b [format %x [toASCII $r]]} append d "$b " unset b } close $f return $d } # -------------------------------------------------------- # removes all cell values of table proc ::Binary::clearTable {} { variable cfg set i 1 while {$i < [$cfg(editor).e cget -rows]} { set j 1 while {$j < ($cfg(lastCol)-1)} {set ::Binary::val($i,$j) ""; incr j} incr i } } # -------------------------------------------------------- # converts data of file into 1Byte hex format for all cells in given row proc ::Binary::toString {row} { variable cfg set tmp ""; set c 1 while {$c < $cfg(lastCol)} { if {"$::Binary::val($row,$c)"==""} {set tmp "${tmp} "} { if {([format %u 0x$::Binary::val($row,$c)]>13) && ([format %u 0x$::Binary::val($row,$c)]<126)} { set tmp "$tmp[toChar [format %u 0x$::Binary::val($row,$c)]]" } {set tmp "${tmp}."} } incr c } return $tmp } # -------------------------------------------------------- # the ascii equivalent into last row is compiled and written out proc ::Binary::toReadableText {{row ""}} { variable cfg if {$row!=""} { set ::Binary::val($row,$cfg(lastCol)) [::Binary::toString $row] } { ser r 1 while {$r<[$cfg(editor).e cget -rows]} { set ::Binary::val($row,$cfg(lastCol)) [::Binary::toString $r] incr r } } } # -------------------------------------------------------- # this proc performs the actual displaying of the values into table proc ::Binary::displaySelBlock {{dir ""} {reload 0}} { variable cfg set z [expr $cfg(startCell)] if {$dir!=""} {if {[expr $z + 8*$dir]>=0} {set z [expr $z + 8*$dir]}} if {($cfg(startCell)==$z) && [info exists ::Binary::val(1,1)] && !$reload && !$::Binary::cfg(update)} {return} set cfg(startCell) $z update ;# otherwise blckCnt sets to 1 set nrRows [$cfg(editor).e cget -rows] set blckCnt [expr ($nrRows-1) * 8] set tmp [lindex $cfg(data) end] switch [string length $tmp] { "1" - "3" {set tmp "${tmp}0"} default {set tmp ""} } if {$tmp!=""} {set cfg(data) [lreplace $cfg(data) end end $tmp]} set cfg(data) [string toupper $cfg(data)] ::Binary::clearTable set i 1 foreach word $cfg(data) { set j 0 while {$j < ($cfg(lastCol)-2)} { set ::Binary::val($i,[expr $j+1]) [string range [lindex $cfg(data) $z] 0 1] set ::Binary::val($i,[expr $j+2]) [string range [lindex $cfg(data) $z] 2 3] incr z incr j 2 } ::Binary::writeAdress $i $z ::Binary::toReadableText $i incr i if {$i>=$nrRows} {break} } if {$i<$nrRows} { #cleanup unused space } } # -------------------------------------------------------- # writes address into column 0 according to latest pointer proc ::Binary::writeAdress {r v} { variable cfg set v [format %x [expr 2*$v-16]] while {[string length $v]<[string length $cfg(maxAddr)]} {set v "0$v"} set ::Binary::val($r,0) [string toupper $v] } # -------------------------------------------------------- # set bindings to custom laebls to perform as buttons proc ::Binary::setBindings {} { variable cfg foreach w {up0 up1} { bind $cfg(editor).ctrls.scroll.$w {::Binary::scroll -1 %W} bind $cfg(editor).ctrls.scroll.$w {::Binary::unpress %W} bind $cfg(editor).ctrls.scroll.$w {::Binary::unpress %W} } foreach w {dw0 dw1} { bind $cfg(editor).ctrls.scroll.$w {::Binary::scroll 1 %W} bind $cfg(editor).ctrls.scroll.$w {::Binary::unpress %W} bind $cfg(editor).ctrls.scroll.$w {::Binary::unpress %W} } bind $cfg(editor).e {::Binary::selAddress} foreach w "$cfg(editor).ctrls.butts.ca.e1 $cfg(editor).ctrls.butts.ca.fr1.e $cfg(editor).ctrls.butts.ca.fr2.e" { bind $w {focus -force $::Binary::cfg(parent)} } bind $cfg(parent) {+; set ::Binary::cfg(update) 1 } bind $cfg(editor).e {+; if {$::Binary::cfg(update)} {::Binary::displaySelBlock; set ::Binary::cfg(update) 0} { set pntr [$::Binary::cfg(editor).e index @%x,%y] if {$::Binary::cfg(currCell) != $pntr} { if {[string length $::Binary::val($::Binary::cfg(currCell))]==1} { set ::Binary::val($::Binary::cfg(currCell)) "0$::Binary::val($::Binary::cfg(currCell))" ::Binary::updateBuffer } } } } bind $cfg(editor).ctrls.butts.gt.e { $::Binary::cfg(editor).ctrls.butts.gt.e selection range 0 end } bind $cfg(editor).ctrls.butts.gt.e {if {"%k"=="13"} {::Binary::goto}} bind Table {+; ::Binary::wheel %D} bind $cfg(editor).e {if {("%k"=="86") && ("%K"=="v")} {break}} ;# overrule paster functionality wm protocol [winfo toplevel $cfg(parent)] WM_DELETE_WINDOW "[wm protocol [winfo toplevel $cfg(parent)] WM_DELETE_WINDOW]; ::Binary::exitHandle" } # -------------------------------------------------------- # governs the mouse wheel functionality proc ::Binary::wheel {D} { variable cfg $cfg(editor).e selection clear all if {$D<0} { set w $cfg(editor).ctrls.scroll.dw1 ::Binary::scroll 1 $w 1 $w config -relief raised } { set w $cfg(editor).ctrls.scroll.up1 ::Binary::scroll -1 $w 1 $w config -relief raised } } # -------------------------------------------------------- # to scroll the table in direction 'dir' proc ::Binary::scroll {dir w {once 0}} { variable cfg if {([file extension $w]==".dw1") || ([file extension $w]==".up1")} {set dir [expr $dir * ([$cfg(editor).e cget -rows]-1)]} if {([expr $cfg(startCell) + 8*$dir]>0) || (([expr $cfg(startCell) + 8*$dir]==0) && ($::Binary::val(1,0)!=$cfg(startAddr)))} { if {!$once} {$w config -relief sunken} set ::Binary::cfg(bpress) 1 ::Binary::displaySelBlock $dir ::Binary::selAddress if {!$once} { after 100 update while {$::Binary::cfg(bpress)} {::Binary::displaySelBlock $dir; ::Binary::selAddress; after $cfg(delay); update; incr cfg(delay) -1; if {$cfg(delay)<0} {set cfg(delay) 0}} } set ::Binary::cfg(bpress) 0 } } # -------------------------------------------------------- # restores relief of labels proc ::Binary::unpress {w} { variable cfg set ::Binary::cfg(bpress) 0 $w config -relief raised set cfg(delay) 50 } # -------------------------------------------------------- # shows details on active cell proc ::Binary::selAddress {} { variable cfg if {[info exists ::tk::table::Priv(tablePrev)] && ($::tk::table::Priv(tablePrev)!="")} { if {[catch {set val $::Binary::val($::tk::table::Priv(tablePrev))}]} {return} if {$val==""} {return} set cfg(currCell) $::tk::table::Priv(tablePrev) set i [split $::tk::table::Priv(tablePrev) ,] set MSB [string trimleft $::Binary::val([lindex $i 0],0) 0] set LSB [lindex $i 1] if {$LSB>=$cfg(lastCol)} {return} if {$MSB==""} {set MSB 0} set addr [expr [format %u 0x$MSB] + $LSB - 1] set ::Binary::cfg(addr) $addr set ::Binary::cfg(8b) [format %u 0x$val] if {[expr [lindex $i 1]+1]>16} { set 16b_LSB 1 set 16b_MSB [expr [lindex $i 0]+1] } { set 16b_LSB [expr [lindex $i 1]+1] set 16b_MSB [expr [lindex $i 0]] } set ::Binary::cfg(16b) "" if {[catch { if {$::Binary::val($16b_MSB,$16b_LSB)!=""} { set ::Binary::cfg(16b) [format %u 0x$val$::Binary::val($16b_MSB,$16b_LSB)] }}]} { set ::Binary::cfg(16b) $::Binary::cfg(8b) } } return } # -------------------------------------------------------- # load file proc ::Binary::load {f} { variable cfg if {$cfg(dbChanged)} { set ret [::Binary::saveChanges] if {$ret=="yes"} {::Binary::save2file} if {$ret=="cancel"} {return} } $cfg(parent) configure -cursor watch; update if {[file exists $f]} { if {[file size $f]>[format %u 0x$cfg(maxAddr)]} { $cfg(parent) configure -cursor "" tk_messageBox -parent $cfg(parent) -message "WARNING: filesize exceeds limit." -title "file not loaded" -icon warning -type ok return } set cfg(file) $f set st normal set cfg(data) [::Binary::readFile $cfg(file)] $cfg(editor).ctrls.butts.fn configure -text "file: [file tail $cfg(file)]" if {[catch {set s [file size $cfg(file)]}]} {set s 0} } { tk_messageBox -parent $cfg(parent) -message "WARNING: file [file tail $cfg(file)] not found?" -title "file not loaded" -icon warning -type ok set st disabled set s 0 $cfg(editor).ctrls.butts.fn configure -text "" } $cfg(editor).ctrls.butts.b0 configure -state $st $cfg(editor).ctrls.butts.fs.s configure -text $s set cfg(startCell) 0 set cfg(dbChanged) 0 ::Binary::displaySelBlock "" 1 $cfg(editor).e activate 1,1 $cfg(editor).e selection clear all set ::tk::table::Priv(tablePrev) 1,1 ::Binary::selAddress $cfg(parent) configure -cursor "" } # -------------------------------------------------------- # updates data buffer proc ::Binary::updateBuffer {} { variable cfg if {[info exists ::tk::table::Priv(tablePrev)] && ($::tk::table::Priv(tablePrev)!="")} { if {[catch {set val $::Binary::val($::tk::table::Priv(tablePrev))}]} {return 0} if {[string length $val]<2} {return 0} set cfg(dbChanged) 1 set addr [expr $::Binary::cfg(addr) / 2] set LSB [expr [lindex [split $::tk::table::Priv(tablePrev) ,] 1] - 1] if {[lindex [split [expr $LSB/2.0] .] end]==0} { set unchanged [string range [lindex $cfg(data) $addr] 2 3] set cfg(data) [lreplace $cfg(data) $addr $addr $::Binary::val($::tk::table::Priv(tablePrev))$unchanged] } { set unchanged [string range [lindex $cfg(data) $addr] 0 1] set cfg(data) [lreplace $cfg(data) $addr $addr $unchanged$::Binary::val($::tk::table::Priv(tablePrev))] } ::Binary::toReadableText [lindex [split $::tk::table::Priv(tablePrev) ,] 0] } return 0 } # -------------------------------------------------------- # checks if change occured before exit proc ::Binary::save2file {} { variable cfg $cfg(parent) configure -cursor watch; update foreach d $cfg(data) {append o [::Binary::Hword $d]} if {[string length [lindex $cfg(data) end]]==2} { set o [string range $o 0 end-2] append o [::Binary::Hbyte [lindex $cfg(data) end]] } if {[catch {::Binary::writeFile $cfg(file) $o}]} { $cfg(parent) configure -cursor "" tk_messageBox -parent $cfg(parent) -message "ERROR: failed to write to file?" -title "Failed to write to file" -icon error -type ok return 0 } unset o set cfg(dbChanged) 0 $cfg(parent) configure -cursor "" return 1 } # -------------------------------------------------------- # save before reload/exit proc ::Binary::saveChanges {} { variable cfg return [tk_messageBox -parent $cfg(parent) -message "Would you like to save the changes?" -title "Changes to db detected" -icon question -type yesnocancel] } # -------------------------------------------------------- # checks if change occured before exit proc ::Binary::exitHandle {} { variable cfg if {$cfg(dbChanged)} { set ret [::Binary::saveChanges] if {"$ret"=="yes"} { if {![::Binary::save2file]} { return } { unset cfg(data) destroy $cfg(parent) } } if {"$ret"=="cancel"} {return} } catch {unset cfg(data)} destroy $cfg(parent) } # -------------------------------------------------------- # checks cellinput for validity proc ::Binary::checkVal {S s} { variable cfg if {"$s"==""} {set ::Binary::val($::tk::table::Priv(tablePrev)) ""; return 0} ;# adding new bytes disabled if {$S==""} {set ::Binary::val($::tk::table::Priv(tablePrev)) 00; return [::Binary::updateBuffer]} if {[catch {set x [format %u 0x$S]}]} {return 0} if {[string length $S]>2} { set n [string range $S end end] foreach c [split $S ""] { if {[lsearch [split $s ""] $c]<0} {set n $c; break} } set ::Binary::val($::tk::table::Priv(tablePrev)) [string toupper $n] return [::Binary::updateBuffer] } set ::Binary::val($::tk::table::Priv(tablePrev)) [string toupper $S] return [::Binary::updateBuffer] } # -------------------------------------------------------- # checks cellinput for validity proc ::Binary::goto {} { variable cfg if {[string trim $cfg(goto)]==""} {return} $cfg(editor).e selection clear all set tstart [format %u 0x[string range $::Binary::val(1,0) 0 end-1]] if {[string trim $cfg(goto)]=="end"} { set end [expr [llength $::Binary::cfg(data)]*2] set row [format %x [expr $end - 2]] set cell [expr [format %u 0x[string range $end end end]] - 1] set end [format %u 0x[string range [format %x $end] 0 end-1]] ::Binary::displaySelBlock [expr $end - $tstart - [$cfg(editor).e cget -rows] + 2] set i 1 while {($i<[$cfg(editor).e cget -rows]) && ([string trimleft $::Binary::val($i,0) 0]!=$row)} {incr i} $cfg(editor).e activate $i,$cell set ::tk::table::Priv(tablePrev) $i,$cell ::Binary::selAddress } { if {[isInteger $cfg(goto)]} { if {[string first "0x" $cfg(goto)]<0} {set end 0x[format %x $cfg(goto)]} {set end $cfg(goto)} if {[string length $end]<4} {set end 0x00} ::Binary::displaySelBlock [expr [format %u [string range $end 0 end-1]] - $tstart] set cell [expr [format %u 0x[string range $end end end]] + 1] $cfg(editor).e activate 1,$cell set ::tk::table::Priv(tablePrev) 1,$cell ::Binary::selAddress } { tk_messageBox -parent $cfg(parent) -message "Invalid entry\n\nShould be an integer or 0x where\n should be a hex address." -title "Invalid address" -icon info -type ok } } focus -force $cfg(editor).e } # -------------------------------------------------------- # the editor interface proc ::Binary::hexEdit {file {tParent ""} {maxAddr "FFFFFF"}} { variable cfg set cfg(file) $file set cfg(update) 0 if {[package provide tile]==""} {set tl ""} {set tl "::ttk::"} if {($tParent=="") || ($tParent==".")} { set cfg(parent) .; set cfg(editor) .hexedit } { set cfg(parent) $tParent; set cfg(editor) $cfg(parent).hexedit if {![winfo exists $cfg(parent)]} {puts "parent $cfg(parent) does not exists!"; return} } if {[winfo exists $cfg(editor)]} {raise $cfg(parent); focus -force $cfg(parent); return} set cfg(data) "" ;# this holds the actual hex data of the file set cfg(selBlock) 0 set cfg(startCell) 0 set cfg(startAddr) "000000" set cfg(maxAddr) $maxAddr set cfg(dbChanged) 0 set cfg(currCell) 1,1 pack [${tl}labelframe $cfg(editor) -text "Hex Editor v$::wrapLug($::wrapper,version)"] -expand 1 -fill both -side left catch {unset ::Binary::val} array set ::Binary::t { rows 15 cols 18 array ::Binary::val } set cfg(lastCol) [expr $::Binary::t(cols)-1] table $cfg(editor).e \ -rows $::Binary::t(rows) \ -cols $::Binary::t(cols) \ -variable $::Binary::t(array) \ -width 20 \ -maxwidth 560 \ -height 120 \ -font {arial 10} \ -titlerows 1 \ -titlecols 1 \ -selectmode single \ -selecttitles 0 \ -colstretchmode none \ -rowstretchmode fill \ -resizeborders none \ -colwidth 3 \ -drawmode fast \ -relief flat \ -bg white \ -validate 1 \ -validatecommand {::Binary::checkVal %S %s} \ -rowseparator "\n" \ -colseparator "\n" pack $cfg(editor).e -side left -fill both -expand 1 $cfg(editor).e tag configure sel -fg blue $cfg(editor).e tag configure title -bg gray80 -fg gray40 -font {arial 10 bold} $cfg(editor).e tag configure active -bg darkblue -fg white $cfg(editor).e width 0 10 $cfg(editor).e width $cfg(lastCol) 20 set ::Binary::val(0,0) Address set ::Binary::val(0,$cfg(lastCol)) "ASCII equivalent" set j 1; foreach i {0 1 2 3 4 5 6 7 8 9 A B C D E F} {set ::Binary::val(0,$j) $i; incr j} $cfg(editor).e tag coltag ascii $cfg(lastCol) $cfg(editor).e tag configure ascii -fg gray60 -justify left -font {{courier new} 9} pack [frame $cfg(editor).ctrls] -side right -fill both -expand 1 pack [frame $cfg(editor).ctrls.scroll -bg SystemDisabledText] -side left -expand 0 -fill y pack [label $cfg(editor).ctrls.scroll.up0 -relief raised -width 12 -height 10 -image ::Binary::uparrow] -side top -anchor n pack [label $cfg(editor).ctrls.scroll.up1 -relief raised -width 12 -height 110 -image ::Binary::arrowMup] -side top -anchor n pack [label $cfg(editor).ctrls.scroll.dw0 -relief raised -width 12 -height 10 -image ::Binary::downarrow] -side bottom -anchor s pack [label $cfg(editor).ctrls.scroll.dw1 -relief raised -width 12 -height 110 -image ::Binary::arrowMdwn] -side bottom -anchor s pack [frame $cfg(editor).ctrls.butts] -side right -expand 1 -fill both pack [${tl}label $cfg(editor).ctrls.butts.fn -justify center] -side top -fill x -expand 0 -anchor center -pady 2 -padx 2 if {[file exists $cfg(file)]} { set st normal set cfg(data) [::Binary::readFile $cfg(file)] $cfg(editor).ctrls.butts.fn configure -text "file: [file tail $cfg(file)]" } { set st disabled $cfg(editor).ctrls.butts.fn configure -text "" } pack [${tl}labelframe $cfg(editor).ctrls.butts.fs -text "File size (bytes)"] -side top -fill x -anchor n -pady 2 -padx 2 if {[catch {set s [file size $cfg(file)]}]} {set s 0} pack [${tl}label $cfg(editor).ctrls.butts.fs.s -text $s] -side right -fill x -anchor n -pady 2 pack [${tl}button $cfg(editor).ctrls.butts.b0 -text {Reload file} -command {::Binary::load $::Binary::cfg(file)} -state $st] -side top -fill x -expand 0 -anchor n -pady 2 -padx 2 pack [${tl}button $cfg(editor).ctrls.butts.b1 -text {Save file} -command {::Binary::save2file}] -side top -fill x -anchor n -pady 2 -padx 2 pack [${tl}labelframe $cfg(editor).ctrls.butts.ca -text "Selected Address (dec)"] -side top -fill x -anchor n -pady 2 -padx 2 pack [${tl}entry $cfg(editor).ctrls.butts.ca.e1 -justify right -width 10 -textvariable ::Binary::cfg(addr)] -side top -fill x -anchor n -pady 2 -padx 2 foreach i {{1 8} {2 16}} { pack [frame $cfg(editor).ctrls.butts.ca.fr[lindex $i 0] -width 12] -side top -fill x -anchor n -pady 2 -padx 2 pack [${tl}label $cfg(editor).ctrls.butts.ca.fr[lindex $i 0].l -text "value ([lindex $i 1]bit)"] -side left -fill x -anchor n -pady 2 pack [${tl}entry $cfg(editor).ctrls.butts.ca.fr[lindex $i 0].e -justify right -width 12 -textvariable ::Binary::cfg([lindex $i 1]b)] -side right -fill x -anchor n -pady 2 } pack [${tl}labelframe $cfg(editor).ctrls.butts.gt -text "Go to..."] -side bottom -fill x -anchor n -pady 2 -padx 2 pack [${tl}button $cfg(editor).ctrls.butts.gt.b1 -width 2 -text Go -command {::Binary::goto}] -side left -fill x -anchor n -pady 2 -padx 2 pack [${tl}entry $cfg(editor).ctrls.butts.gt.e -justify right -width 20 -textvariable ::Binary::cfg(goto)] -side right -expand 1 -fill x -anchor n -pady 2 set ::Binary::cfg(goto) end ::Binary::setBindings ::Binary::displaySelBlock $cfg(editor).e activate 1,1 set ::tk::table::Priv(tablePrev) 1,1 ::Binary::selAddress focus -force $cfg(editor).e } } ;# namespace # ------------------------------------------------------------------------------ # from tG2's generic_tcl.tcl: proc luniq {L} { set t {} foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}} return $t } proc toASCII {char} {scan $char %c value; return $value} proc toChar {value} {return [format %c $value]} proc isInteger {theString} {string is integer -strict $theString} # ------------------------------------------------------------------------------ # tested on a wish.exe v8.4.19, Windows 10 # ------------------------------------------------------------------------------ set file2edit [file dirname [info script]]/_dummy_.txt catch {file copy [info script] $file2edit} ::Binary::hexEdit $file2edit ====== <>GUI | Widget