[TB-LISP函数]：文本的BASE64编码与解码

tengteb

  ;参数：txt -- 文本；mode: nil -- 解码，其它 -- 编码

(defun TBC:Base64 (txt mode / Char Index Code Decode n m s ss a b c d zs lst)
  (defun Char (i)
    (cond
      ((<= 0 i 25) (+ i 65)) ;大写字母
      ((<= 26 i 51) (+ i 71)) ;小写字母
      ((<= 52 i 61) (- i 4)) ;数字
      ((= i 62) 43) ;+
      ((= i 63) 47) ;/
    ) ;cond
  ) ;defun
  (defun Index (a)
    (cond
      ((<= 65 a 90) (- a 65)) ;大写字母
      ((<= 97 a 122) (- a 71)) ;小写字母
      ((<= 48 a 57) (+ a 4)) ;数字
      ((= a 43) 62) ;+
      ((= a 47) 63) ;/
    ) ;cond
  ) ;defun
  (defun Code (n1 n2 n3)
    (list
      (lsh n1 -2)
      (+ (lsh (logand n1 3) 4) (lsh (logand n2 240) -4))
      (+ (lsh (logand n2 15) 2) (lsh (logand n3 192) -6))
      (logand n3 63)
    )
  ) ;defun
  (defun Decode (n1 n2 n3 n4)
    (list
      (+ (lsh n1 2) (lsh (logand n2 48) -4))
      (+ (lsh (logand n2 15) 4) (lsh (logand n3 60) -2))
      (+ (lsh (logand n3 3) 6) n4)
    )
  ) ;defun
  (setq lst (vl-string->list txt))
  (if mode ;nil:解码；else 编码
    (progn
      (setq n (length lst)
            m (rem n 3)
            n (/ n 3)
      )
      (or (= m 0) (setq n (1+ n)))
      (setq ss "")
      (repeat (- 3 m)
        (setq ss (strcat ss "=")
              zs (cons 0 zs)
        )
      ) ;repeat
      (setq lst (append lst zs))
      (setq s "")
      (repeat n
        (setq a   (car lst)
              b   (cadr lst)
              c   (caddr lst)
              lst (cdddr lst)
              s   (strcat s (vl-list->string (mapcar 'Char (Code a b c))))
        )
      ) ;repeat
      (setq n (strlen s))
      (strcat (substr s 1 (- n m)) ss)
    ) ;progn/else
    (progn
      (setq lst (vl-remove-if '(lambda (x) (= x 10)) lst)) ;允许编码中出现无用的换行符
      (setq m (length (member 61 lst))) ;"="及后面的长度
      (setq lst (mapcar 'Index (subst 65 61 lst))) ;"="替换为"A"
      (setq s "")
      (repeat (/ (length lst) 4)
        (setq a   (car lst)
              b   (cadr lst)
              c   (caddr lst)
              d   (cadddr lst)
              lst (cddddr lst)
              s   (strcat s (vl-list->string (Decode a b c d)))
        )
      )
      (setq n (strlen s))
      (substr s 1 (- n m))
    ) ;progn
  ) ;if
)

229096767

感谢分享!