纯lisp实现更高效的base64编码解码

9609759

大海发了个纯算法实现base64编码解码，我也凑凑热闹，发一个更高效的base64编码解码。

9609759

tryhi 发表于 2024-6-17 19:33
确实，除非很特殊的环境下没法使用组件，否则还是调用系统组卷更快更可靠

通过base64_encode加密一下，多了一个77u/，而这个东西就是传说中的Bom头了，正常情况下这个头是不会显示出来的，如果显示出来就固定的移除4位字符串就行



转载至 ： https://blog.csdn.net/qq_38421226/article/details/106264751

dcl1214

原谅我给你做了一下容错处理(预防系统组件调用失败)

1. (defun $Base64Encode$ (str / onode oxml value $Stream_StringToBinary$)
   
2. ;;;调用示例$Base64Encode$ "龙哥威武")
   
3.   (defun $Stream_StringToBinary$ (str / ado var)
   
4.     (setq ADO (vl-catch-all-apply
   
5.                 'vlax-get-or-create-object
   
6.                 (list "ADODB.Stream")
   
7.               )
   
8.     )
   
9.     (if        (not (vl-catch-all-error-p ADO))
   
10.       (progn
    
11.         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 2))
    
12.         (vl-catch-all-apply
    
13.           'vlax-put-property
    
14.           (list ADO 'CharSet "utf-8")
    
15.         )
    
16.         (vl-catch-all-apply 'Vlax-Invoke (list ADO 'Open))
    
17.         (vl-catch-all-apply 'vlax-invoke (list ADO 'WriteText str))
    
18.         (vl-catch-all-apply
    
19.           'vlax-put-property
    
20.           (list ADO 'Position 0)
    
21.         )
    
22.         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 1))
    
23.         (vl-catch-all-apply
    
24.           'vlax-put-property
    
25.           (list ADO 'Position 0)
    
26.         )
    
27.         (setq var (vl-catch-all-apply
    
28.                     'vlax-invoke-method
    
29.                     (list ADO 'read -1)
    
30.                   )
    
31.         )
    
32.         (if (vl-catch-all-error-p var)
    
33.           (setq var nil)
    
34.         )
    
35.         (vl-catch-all-apply 'vlax-release-object (list ADO))
    
36.       )
    
37.     )
    
38.     var
    
39.   )
    
40.   (if (and str (= (type str) 'str))
    
41.     (progn
    
42.       (setq oXML (vl-catch-all-apply
    
43.                    'vlax-get-or-create-object
    
44.                    (list "Msxml2.DOMDocument.3.0")
    
45.                  )
    
46.       )
    
47.       (if (not (vl-catch-all-error-p oXML))
    
48.         (progn
    
49.           (setq        oNode (vl-catch-all-apply
    
50.                         'vlax-invoke-method
    
51.                         (list oXML 'CreateElement "base64")
    
52.                       )
    
53.           )
    
54.           (vl-catch-all-apply
    
55.             'vlax-put-property
    
56.             (list oNode 'dataType "bin.base64")
    
57.           )
    
58.           (vl-catch-all-apply
    
59.             'vlax-put-property
    
60.             (list
    
61.               oNode
    
62.               'nodeTypedValue
    
63.               ($Stream_StringToBinary$ str)
    
64.             )
    
65.           )
    
66.           (setq        value
    
67.                  (vl-catch-all-apply 'vlax-get-property (list oNode 'text))
    
68.           )
    
69.           (if (vl-catch-all-error-p value)
    
70.             (setq value "")
    
71.           )
    
72.           (vl-catch-all-apply 'vlax-release-object (list oNode))
    
73.           (vl-catch-all-apply 'vlax-release-object (list oXML))
    
74.         )
    
75.       )
    
76.     )
    
77.   )
    
78.   value
    
79. )
    
80. (defun $Base64Decode$ (str / onode oxml str-new)
    
81. ;;;调用示例$Base64Decode$ ($Base64Encode$ "龙哥威武"))
    
82.   (defun $Stream_BinaryToString$ (var / ado var)
    
83.     (setq ADO (vl-catch-all-apply
    
84.                 'vlax-get-or-create-object
    
85.                 (list "ADODB.Stream")
    
86.               )
    
87.     )
    
88.     (if        (not (vl-catch-all-error-p ADO))
    
89.       (progn
    
90.         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 1))
    
91.         (vl-catch-all-apply 'Vlax-Invoke (list ADO 'Open))
    
92.         (vl-catch-all-apply
    
93.           'vlax-invoke-method
    
94.           (list ADO 'Write var)
    
95.         )
    
96.         (vl-catch-all-apply
    
97.           'vlax-put-property
    
98.           (list ADO 'Position 0)
    
99.         )
    
100.         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 2))
     
101.         (vl-catch-all-apply
     
102.           'vlax-put-property
     
103.           (list ADO 'CharSet "utf-8")
     
104.         )
     
105.         (setq str (vl-catch-all-apply
     
106.                     'vlax-invoke-method
     
107.                     (list ADO 'ReadText -1)
     
108.                   )
     
109.         )
     
110.         (vl-catch-all-apply 'vlax-release-object (list ADO))
     
111.       )
     
112.     )
     
113.     str
     
114.   )
     
115.   (setq        oXML (vl-catch-all-apply
     
116.                'vlax-get-or-create-object
     
117.                (list "Msxml2.DOMDocument.3.0")
     
118.              )
     
119.   )
     
120.   (if (not (vl-catch-all-error-p oXML))
     
121.     (progn
     
122.       (setq oNode (vl-catch-all-apply
     
123.                     'vlax-invoke-method
     
124.                     (list oXML 'CreateElement "base64")
     
125.                   )
     
126.       )
     
127.       (vl-catch-all-apply
     
128.         'vlax-put-property
     
129.         (list oNode 'dataType "bin.base64")
     
130.       )
     
131.       (vl-catch-all-apply
     
132.         'vlax-put-property
     
133.         (list oNode 'text str)
     
134.       )
     
135.       (setq str-new ($Stream_BinaryToString$
     
136.                       (vlax-get-property oNode 'nodeTypedValue)
     
137.                     )
     
138.       )
     
139.       (if (vl-catch-all-error-p str-new)
     
140.         (setq str-new "")
     
141.       )
     
142.       (if str-new
     
143.         (setq str str-new)
     
144.       )
     
145.       (vl-catch-all-apply 'vlax-release-object (list oNode))
     
146.       (vl-catch-all-apply 'vlax-release-object (list oXML))
     
147.     )
     
148.   )
     
149.   str
     
150. )
     
151. 
     

(defun $Base64Encode$ (str / onode oxml value $Stream_StringToBinary$)<br /> ;;;调用示例<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />$Base64Encode$ "龙哥威武")<br />   (defun $Stream_StringToBinary$ (str / ado var)<br />     (setq ADO (vl-catch-all-apply<br />                 'vlax-get-or-create-object<br />                 (list "ADODB.Stream")<br />               )<br />     )<br />     (if        (not (vl-catch-all-error-p ADO))<br />       (progn<br />         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 2))<br />         (vl-catch-all-apply<br />           'vlax-put-property<br />           (list ADO 'CharSet "utf-8")<br />         )<br />         (vl-catch-all-apply 'Vlax-Invoke (list ADO 'Open))<br />         (vl-catch-all-apply 'vlax-invoke (list ADO 'WriteText str))<br />         (vl-catch-all-apply<br />           'vlax-put-property<br />           (list ADO 'Position 0)<br />         )<br />         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 1))<br />         (vl-catch-all-apply<br />           'vlax-put-property<br />           (list ADO 'Position 0)<br />         )<br />         (setq var (vl-catch-all-apply<br />                     'vlax-invoke-method<br />                     (list ADO 'read -1)<br />                   )<br />         )<br />         (if (vl-catch-all-error-p var)<br />           (setq var nil)<br />         )<br />         (vl-catch-all-apply 'vlax-release-object (list ADO))<br />       )<br />     )<br />     var<br />   )<br />   (if (and str (= (type str) 'str))<br />     (progn<br />       (setq oXML (vl-catch-all-apply<br />                    'vlax-get-or-create-object<br />                    (list "Msxml2.DOMDocument.3.0")<br />                  )<br />       )<br />       (if (not (vl-catch-all-error-p oXML))<br />         (progn<br />           (setq        oNode (vl-catch-all-apply<br />                         'vlax-invoke-method<br />                         (list oXML 'CreateElement "base64")<br />                       )<br />           )<br />           (vl-catch-all-apply<br />             'vlax-put-property<br />             (list oNode 'dataType "bin.base64")<br />           )<br />           (vl-catch-all-apply<br />             'vlax-put-property<br />             (list<br />               oNode<br />               'nodeTypedValue<br />               ($Stream_StringToBinary$ str)<br />             )<br />           )<br />           (setq        value<br />                  (vl-catch-all-apply 'vlax-get-property (list oNode 'text))<br />           )<br />           (if (vl-catch-all-error-p value)<br />             (setq value "")<br />           )<br />           (vl-catch-all-apply 'vlax-release-object (list oNode))<br />           (vl-catch-all-apply 'vlax-release-object (list oXML))<br />         )<br />       )<br />     )<br />   )<br />   value<br /> )<br /> (defun $Base64Decode$ (str / onode oxml str-new)<br /> ;;;调用示例<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />$Base64Decode$ ($Base64Encode$ "龙哥威武"))<br />   (defun $Stream_BinaryToString$ (var / ado var)<br />     (setq ADO (vl-catch-all-apply<br />                 'vlax-get-or-create-object<br />                 (list "ADODB.Stream")<br />               )<br />     )<br />     (if        (not (vl-catch-all-error-p ADO))<br />       (progn<br />         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 1))<br />         (vl-catch-all-apply 'Vlax-Invoke (list ADO 'Open))<br />         (vl-catch-all-apply<br />           'vlax-invoke-method<br />           (list ADO 'Write var)<br />         )<br />         (vl-catch-all-apply<br />           'vlax-put-property<br />           (list ADO 'Position 0)<br />         )<br />         (vl-catch-all-apply 'vlax-put-property (list ADO 'Type 2))<br />         (vl-catch-all-apply<br />           'vlax-put-property<br />           (list ADO 'CharSet "utf-8")<br />         )<br />         (setq str (vl-catch-all-apply<br />                     'vlax-invoke-method<br />                     (list ADO 'ReadText -1)<br />                   )<br />         )<br />         (vl-catch-all-apply 'vlax-release-object (list ADO))<br />       )<br />     )<br />     str<br />   )<br />   (setq        oXML (vl-catch-all-apply<br />                'vlax-get-or-create-object<br />                (list "Msxml2.DOMDocument.3.0")<br />              )<br />   )<br />   (if (not (vl-catch-all-error-p oXML))<br />     (progn<br />       (setq oNode (vl-catch-all-apply<br />                     'vlax-invoke-method<br />                     (list oXML 'CreateElement "base64")<br />                   )<br />       )<br />       (vl-catch-all-apply<br />         'vlax-put-property<br />         (list oNode 'dataType "bin.base64")<br />       )<br />       (vl-catch-all-apply<br />         'vlax-put-property<br />         (list oNode 'text str)<br />       )<br />       (setq str-new ($Stream_BinaryToString$<br />                       (vlax-get-property oNode 'nodeTypedValue)<br />                     )<br />       )<br />       (if (vl-catch-all-error-p str-new)<br />         (setq str-new "")<br />       )<br />       (if str-new<br />         (setq str str-new)<br />       )<br />       (vl-catch-all-apply 'vlax-release-object (list oNode))<br />       (vl-catch-all-apply 'vlax-release-object (list oXML))<br />     )<br />   )<br />   str<br /> )<br /> <br />

tryhi

kozmosovia 发表于 2024-6-16 18:36
调用组件感觉上不应该比直接内部数学运算更快。

理论上这样讲确实没错，但是CAD的alisp的运算速度真的非常非常慢，从而导致根本打不过调用组件

另外楼主的函数都是UTF-8编码，如果要用ANSI编码的话，参数改为gb2312即可

烟盒迷唇

有啥不一样的地方

dcl1214

这个调用了系统组件，可能速度要比lisp快一点

dcl1214

BASE64加盐试试

kozmosovia

dcl1214 发表于 2024-6-16 17:24
这个调用了系统组件，可能速度要比lisp快一点

调用组件感觉上不应该比直接内部数学运算更快。

迷失1786

看看不说话........

guosheyang

感谢大佬们的研究和分享！

Bao_lai

哈哈，感谢分享，就稀罕这样的神仙打架。