base64_lib.tcl

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

package provide base640 1.0
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
}
proc Base64Decode {code} {
#Creat the Base64 Decoding table
     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 + /
        =
     }
     set i 0
     foreach byte $Base64Table {
         set DecodingBase64($byte) $i
         incr i 
     }


     set list [split $code ""]

     if {[lindex $list end]=={}} {set list [lrange $list 0 end-1]}
     set length [expr [llength $list]-1]
     set DecodeList ""
     set Base64Code ""
     for {set i 0} {$i<$length} {incr i 4} {
                               
            set BaseCode_0 $DecodingBase64([lindex $list $i])
            set BaseCode_1 $DecodingBase64([lindex $list $i+1])
            set BaseCode_2 $DecodingBase64([lindex $list $i+2])
            set BaseCode_3 $DecodingBase64([lindex $list $i+3])


           set code_16 [expr $BaseCode_0<<2]
           set code_78 [expr {$i+1<$length?(($BaseCode_1>>4)&0x03):0x00}]

#Add the first code
           lappend DecodeList [expr $code_16|$code_78]

           set code_14 [expr {$i+1<$length?[expr [expr $BaseCode_1<<4]&0xF0]:0x00}]
           if {$i+2>$length || [lindex $list $i+2]=={=}} {
                set code1 0x00
           } else {
                set code_58 [expr ($BaseCode_2>>2) &0x0F]
                set code1 [expr $code_14|$code_58]
#Add the second code
                if {$code1!=0x00} {
                    lappend DecodeList $code1
                }
                if {$i+2>$length || [lindex $list $i+2]=={=}} {
                set code2 0x00
                } else {
                     set code_12 [expr [expr $BaseCode_2<<6]&0xC0]
                }
                if {$i+3>$length || [lindex $list $i+3]=={=}} {
                     set code_38 0x00
                } else {
                     set code_38 [expr  $BaseCode_3&0x3F]
                }
                 set code2 [expr $code_12|$code_38]
                if {$code2!=0x00} {
                    lappend DecodeList $code2
                }
           }     
    }

#ASCIIDecoding
    set data {}
    foreach byte $DecodeList {
    append data [binary format c $byte]
    }
    return $data
}