pro base64encode.txt

使用TCL实现BASE64的编码和解码功能

#code by hengry My blog :http//:hyhgd.blog.51cto.com
proc Base64Encode {data} {
# ASCIIEncode
    set asc_list {}
    set data_list [split $data ""]
    foreach byte $data_list {
        binary scan  $byte c var
        lappend asc_list $var
    }

# Create the table of CodingBase64
    set Base64Table {
        A B C D E F G H I J K L M N O P
        Q R S T U V W X Y Z a b c d e f
        g h i j k l m n o p q r s t u v 
        w x y z 0 1 2 3 4 5 6 7 8 9 + /
        =
    }
    for {set i 0} {$i<65} {incr i } {
        set CodingBase64($i) [lindex $Base64Table $i]
    }

    set code ""
    set list_length [llength $asc_list]
    for {set i 0 } {$i<$list_length} {incr i 3} {
        set asc_1 [lindex $asc_list $i]
        set asc_2 [lindex $asc_list $i+1]
        set asc_3 [lindex $asc_list $i+2]
        
        append code $CodingBase64([expr $asc_1>>2]);#Append the first base64code
        set code2(34) [expr ($asc_1<<4)&0x30];#set the 3th and 4th code of the seconde
        if {$i+1<$list_length} {
            set code2(58) [expr $asc_2>>4];#set code from 4th to 8th for the seconde code
            set code3(36) [expr ($asc_2<<2)&0x3C];#set code form 3th to 6th for the third code
            if {$i+2<$list_length} {
                set code3(78) [expr $asc_3>>6];
                set code4 [expr $asc_3&0x3F]
            } else {
                set code3(78) 0x00
                set code4 [expr 0x40]
            }
            set code03 [expr $code3(36)|$code3(78)]
        } else {
            set code2(58) 0x00
            set code03 [expr 0x40]
            set code4 [expr 0x40]
        }
        set code02 [expr $code2(34)|$code2(58)]
        
        append code $CodingBase64($code02)
        append code $CodingBase64($code03)
        append code $CodingBase64($code4)
    }
    return $code
}