tryhi 发表于 2024-6-15 23:34:27

纯算法实现base64编码解码

本帖最后由 tryhi 于 2024-6-15 23:55 编辑





(setq *base64lst* (vl-string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))


(defun try-lst-addlast (a lst)
      (reverse(cons a (reverse lst)))
)
(defun try-string-div (str nn / m n r)
      (setq n(strlen str)
                m(/ n nn)
                re(rem n nn)
                ci(if (zerop re)m (1+ m));循环次数
                r nil
      )
      (repeat ci
                (setq r(cons (substr str 1 nn) r)
                        str (substr str (1+ nn))
                )
               
      )
      (reverse r)
)
(defun try-lst-move-last (lst i)
      (if (<= i 0)lst
                (progn
                        (setq lst (reverse lst))
                        (repeat i (setq lst (cdr lst)))
                        (reverse lst)
                )
      )
)

;;十进制表编码为base64字符串(二进制的十进制表现)
;;实例:(try-base64<-lst10 '(65 66 67 68 69)) ;->"QUJDREU="
(defun try-base64<-lst10 (hex10 / base64 bin binlong binlst lst10 n= remx st)
      (setq remx (rem (length hex10)3))
      (cond
                ((= remx 2)(setq hex10(try-lst-addlast 0 hex10)n= 1)) ;补齐到3字节
                ((= remx 1)(setq hex10(append hex10 '(0 0))n= 2)) ;补齐到3字节
                (T (setq n= 0))
      )
      
      (setq
                bin(mapcar '(lambda(x)(sy-itoa x 2 8 48))hex10)
                binlong(apply 'strcat bin)
                binlong(substr binlong 1 (-(strlen binlong)(* n= 6))) ;删除多补的0
                binlst(try-string-div binlong 6);按6位长度取值,即3/4字节
                lst10(mapcar '(lambda(x)(sy-atoi x 2))binlst)
                st(mapcar '(lambda(x)(nth x *base64lst*))lst10)
                base64(vl-list->string st)
      )
      
      (repeat n=
                (setq base64(strcat base64"="))
      )
      base64
)

;;普通字符串编码为base64(ANSI编码)
;;实例:(try-base64<-str "ABCDE") ;->"QUJDREU="
(defun try-base64<-str (str)
      (try-base64<-lst10 (vl-string->list str))
)

;;base64字符串解码为十进制表(二进制的十进制表现)
;;实例:(try-base64->lst10 "QUJDREU=") ;->(65 66 67 68 69)
(defun try-base64->lst10 (base64 / bin binlong binlst lst lst10 mw n= tem wz)

        (setq n=(cond
                                                ((wcmatch base64 "*==")2)
                                                ((wcmatch base64 "*=")1)
                                                (t 0)
                                        ))
      (setq mw(substr base64 1 (-(strlen base64)n=)))
      (setq lst (vl-string->list mw)
                wz(mapcar '(lambda(x)(vl-position x *base64lst*))lst)
                bin(mapcar '(lambda(x)(sy-itoa x 2 6 48))wz)
                binlong(apply 'strcat bin)
                binlong(strcat binlong (sy-itoa 0 2 (* n= 6) 48))
                binlst(try-string-div binlong 8)
                ;len(length binlst)
                lst10(mapcar '(lambda(x)(sy-atoi x 2))binlst)
      )
      (try-lst-move-last lst10 n=)
      
)

;;base64字符串解码为普通字符串(ANSI编码)
;;实例:(try-base64->str "QUJDREU=") ;->"ABCDE"
(defun try-base64->str (base64 / lst)
      (setq lst(reverse(try-base64->lst10 base64)))
      (if (zerop (car lst))(setq lst(cdr lst)));;去除末尾的0,兼容结尾无=的非标准base64
      (if (zerop (car lst))(setq lst(cdr lst)));;去除末尾的0,兼容结尾无=的非标准base64
      (vl-list->string (reverse lst))
)

;;下面是使用例子,之所以分开为4个函数是因为不仅仅字符串可以用来编码,任何数据均可编码

(setq 原始字符串 "今天的天气很nice12345")
(princ (strcat"\n原始字符串为:"原始字符串))
(setq 加密字符串(try-base64<-str 原始字符串))
(princ (strcat"\n加密后为:"加密字符串))
(setq 解码字符串(try-base64->str 加密字符串))
(princ (strcat"\n解码后为:"解码字符串))
(princ)





(注:由于CAD用的是ANSI编码,所以中文编码后很多在线解码平台是解不出来的,因为大多平台用的是UTF-8编码)


YmFzZTY0Ynl0cnloaQ==
此字符是用上面函数编码出来的,感兴趣的可以解出来看看,这是一个支付宝口令红包



为了图方便(也为了速度),二进制转换用了内部函数itoa跟atoi,需要加载内部函数fas,如果接受不了内部函数可以自己编写二进制与十进制转换函数代替文中的sy-itoa、sy-atoi







dcl1214 发表于 2024-6-16 10:20:15

本帖最后由 dcl1214 于 2024-6-16 10:26 编辑

不需要转换为base64,我经常搞数据库,这个问题以前碰到过,后来发现微软系统自己能消化,不需要cad来处理,主要是cad处理大数据的时候,很慢的,所以,借助微软来处理,速度很快的
(DEFUN $xmlhttp$ (lst)
(cond
    ((and (= (getenv "zx-xmlhttp") "1")
          (setq objHttp (vlax-create-object "Msxml2.XMLHTTP"))
                                        ;有缓存速度快,用这个的时候,报文头里面如果有中文,服务器不会乱码
   )
   t
    )
    ((and (= (getenv "zx-xmlhttp") "2")
          (setq objHttp (vlax-create-object "Microsoft.XMLHTTP"))
                                        ;这个是2.0的
   )
   t
    )
    ((and (= (getenv "zx-xmlhttp") "3")
          (setq objHttp (vlax-create-object "winhttp.winhttprequest.5.1"))
                                        ;这个没用过,先记录这里
   )
   t
    )
    ((and (= (getenv "zx-xmlhttp") "4")
          (setq objHttp (vlax-create-object "Msxml2.ServerXMLHTTP"))
                                        ;没有缓存,报文头里面如果有中文服务器会乱码
   )
   t
    )
    (t
   (setq objHttp (vlax-create-object "Msxml2.XMLHTTP"))
                                        ;有缓存速度快,用这个的时候,报文头里面如果有中文,服务器不会乱码
    )
)
objHttp
)


如果你是搞远程通信,你可以用下面方法告知服务器,需要什么编码,如果要UTF-8的,你就告诉服务器即可

(if (not (assoc "Response-Charset" hs))
    (setq hs (cons (cons "Response-Charset" "UTF8") hs))
      )


可以通过下面语句获取远程服务器返回来的是啥字符集

(= (vl-catch-all-apply
         'vlax-invoke-method
         (list objHttp
             'getResponseHeader
             "Response-Charset"
         )
         )            ;获取Response-Charset头文件的值
         "UTF8"
          )

可以通过下面方法将远程服务器返回来的UTF8强转为ansi

(setq value-text
             (vl-catch-all-apply
               'vlax-get-property
               (list objHttp 'responseText)
             )
          )

这个语句依赖微软的对象

tryhi 发表于 2024-6-17 09:46:10

dcl1214 发表于 2024-6-16 10:20
不需要转换为base64,我经常搞数据库,这个问题以前碰到过,后来发现微软系统自己能消化,不需要cad来处理 ...

并没有具体目的,只是单纯的研究一下base64编码的底层逻辑,其实是两年前不知道是谁在问(忘了),然后随手写了个半成品一直丢在桌面,直到今天清理桌面纠结删还是留,觉得写了一半代码弃之可惜就把它写完

dcl1214 发表于 2024-6-17 11:09:53

kozmosovia 发表于 2024-6-16 10:59
转base64的主要用处恐怕主要是为了能应对ANSI和UTF的编译。

据我遇到的,网络通信最多了

lxl217114 发表于 2024-6-16 06:12:20

厉害了,厉害了

guosheyang 发表于 2024-6-16 07:41:20

感谢大海大佬的分享!

kzd2004 发表于 2024-6-16 07:46:34


感谢大海大佬的分享!

自贡黄明儒 发表于 2024-6-16 09:18:49

大海大佬厉害!

Bao_lai 发表于 2024-6-16 09:34:00

这个厉害了,不知道速度怎么样。

kozmosovia 发表于 2024-6-16 10:59:12

转base64的主要用处恐怕主要是为了能应对ANSI和UTF的编译。
页: [1] 2
查看完整版本: 纯算法实现base64编码解码