Tcl Source Code

Artifact e474740a2ba13e989f9a868af3e060382c67f1d5:

Attachment "extractPayload.tcl" to ticket [2992970fff] added by jgodfrey 2010-04-27 20:53:19.

---

proc main {} {
    catch {console show}
    
    set file "c:/test.bin"
    
    set before [clock clicks -milliseconds] 
    extractBinaryPayLoad $file   
    set after [clock clicks -milliseconds]
    
    set total [format %.4f [expr {($after - $before) / 1000.0}]]
    puts "Extract Time --> $total seconds"     
}

proc extractBinaryPayLoad {filename} {
     set fd [ open $filename r ]
     fconfigure $fd -encoding binary -translation binary

     binary scan [ read $fd 2 ] cc type nextlen

     if {$type != 75} {
        return -error "File does not appear to be in the correct format"
     }
     
     while {![append buffer [read $fd $nextlen] ; eof $fd]} {
        binary scan [read $fd 2] cc lastlen nextlen
        # convert to unsigned value
        set nextlen [expr {$nextlen & 0xff}]
        # 130 is the EOF marker
        if {$nextlen == 130} break
        # 129 is a special continuation marker (actually only 128 bytes)
        if {$nextlen == 129} {set nextlen 128}
     }
     close $fd
     
     return $buffer
}

main