[风之影]文本BASE64编码解码
本帖最后由 cabinsummer 于 2017-10-31 12:51 编辑近期用到BASE64编码，用XMLDOM加ADODB.Stream的方法没试成功。百度了一些LISP方法，觉得效率太低，所以自己写了一个文本BASE64编码的函数。数字lsh和logand确实比十进制转二进制再查表快不知多少倍，顺便用了一下gcd函数。
因为LISP不能直接操作二进制数据，所以只好先拿文本来试试。函数如下：
(defun Base64Encode (str / strlst n i map ad y base64 a b c s)
(setq map "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(setq strlst (vl-string->list str))
(setq n (/ (length strlst) 3))
(setq ad "")
(if (= (gcd (length strlst) 3) 1)(setq n (1+ n)))
(setq i 0)
(repeat n
(if (< i (length strlst))(setq a (append a (list (nth i strlst)))))
(if (< (1+ i) (length strlst))(setq b (append b (list (nth (1+ i) strlst)))))
(if (< (+ i 2) (length strlst))(setq c (append c (list (nth (+ i 2) strlst)))))
(setq i (+ i 3))
)
(if (< (length b)(length a))(setq ad (strcat ad "=") b (append b (list 0))))
(if (< (length c)(length a))(setq ad (strcat ad "=") c (append c (list 0))))
(setq s (apply 'strcat (mapcar '(lambda(x)(substr map (1+ x) 1)) (foreach x (mapcar '(lambda(x)(alter34 x)) (mapcar '(lambda(x y z)(list x y z)) a b c)) (setq y (append y x))))))
(setq s (strcat (substr s 1 (- (strlen s)(strlen ad))) ad))
(setq base64 "" i 1)
(if (zerop (rem (strlen s) 76))(/ (strlen s) 76)(1+ (/ (strlen s) 76)))
(repeat (if (zerop (rem (strlen s) 76))(/ (strlen s) 76)(1+ (/ (strlen s) 76)))
(setq base64 (strcat base64 "\n" (substr s i 76)) i (+ i 76))
)
(substr base64 2)
)
(defun alter34 (lst3 / n1 n2 n3 m1 m2 m3 m4)
(setq n1 (car lst3) n2 (cadr lst3) n3 (last lst3))
(setq m1 (lsh n1 -2) m2 (+ (lsh (logand n1 3) 4) (lsh (logand n2 240) -4)) m3 (+ (lsh (logand n2 15) 2) (lsh (logand n3 192) -6)) m4 (logand n3 63))
(list m1 m2 m3 m4)
)
测试：
(setq txt "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure.")
(base64encode txt)
结果已经把\n显示为换行
TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz
IHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg
dGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu
dWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo
ZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=
Base64解码函数
(defun Base64Decode (str / map ad s1 i lst a b c d ss)
(setq map "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(setq lst (vl-remove-if '(lambda(x)(= x 10)) (vl-string->list str)))
(if (member 61 lst)
(setq ad (length (member 61 lst)))
(setq ad 0)
)
(setq lst (mapcar '(lambda(x)(vl-string-position (ascii x) map)) (mapcar 'chr (subst 65 61 lst))))
(setq i 0)
(repeat (/ (length lst) 4)
(setq a (append a (list (nth i lst))))
(setq b (append b (list (nth (1+ i) lst))))
(setq c (append c (list (nth (+ i 2) lst))))
(setq d (append d (list (nth (+ i 3) lst))))
(setq i (+ i 4))
)
(setq ss (apply 'strcat (mapcar 'vl-list->string (mapcar '(lambda(u)(alter43 u)) (mapcar '(lambda(w x y z)(list w x y z)) a b c d)))))
(substr ss 1 (- (strlen ss) ad))
)
(defun alter43 (lst4 / n1 n2 n3 n4 m1 m2 m3)
(setq n1 (car lst4))
(setq n2 (cadr lst4))
(setq n3 (caddr lst4))
(setq n4 (last lst4))
(setq m1 (+ (lsh n1 2)(lsh (logand n2 48) -4)))
(setq m2 (+ (lsh (logand n2 15) 4) (lsh (logand n3 60) -2)))
(setq m3 (+ (lsh (logand n3 3) 6) n4))
(list m1 m2 m3)
) (defun $str->base64$
(str / code *SCR DATA)
;大于20kb后速度很慢
(if (and STR (= (type str) 'str))
(if(or
*SCR
(setq
*SCR (vlax-create-object
"Aec32BitAppServer.AecScriptControl.1"
)
)
(setq *SCR (vlax-create-object "ScriptControl"))
)
(progn
(vlax-put *SCR 'language "VBScript")
(setq code
"Base64Encode(str)
Function Base64Encode(byVal s)
b=\"\"
h=\"\"
bs=\"\"
n=0
For i=1 to len(s)
h=h & StrToHex(Mid(s, i, 1))
Next
For i=1 to len(h) Step 2
b=b & HexToBin(Mid(h,i,2))
Next
For i=1 to len(b) Step 6
n=n+1
t=(Mid(b,i,6))
If len(t) <> 6 Then
t=Left(t & \"000000\", 6)
End If
bs=bs & BinToChr(BinToDec(t))
Next
m=n Mod 4
If m =2 Then
bs=bs & \"==\"
End If
If m =3 Then
bs=bs & \"=\"
End If
Base64Encode=bs
End Function
Function StrToHex(byVal s)
h=\"\"
c=\"&H\" & Hex(AscW(s))
If c >= &H0001 And c <= &H007F Then
h=h & Hex(c)
ElseIf c > &H07FF Then
h=h & Hex(&HE0 Or (c\\(2^12) And &H0F))
h=h & Hex(&H80 Or (c\\(2^6) And &H3F))
h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
Else
h=h & Hex(&HC0 Or (c\\(2^6) And &H1F))
h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
End If
StrToHex=h
End Function
Function HexToBin(byVal s)
b=\"\"
dec=Clng(\"&H\" & s)
Do While dec > 0
b=dec Mod 2 & b
dec=dec \\ 2
Loop
b=Right(\"00000000\" & CStr(b), 8)
HexToBin=b
End Function
Function BinToDec(byVal s)
d=0
For i=6 to 1 Step -1
d=d + CInt(Mid(s, i, 1)) * 2 ^ (6 - i)
Next
BinToDec=d
End Function
Function BinToChr(byVal s)
dic=\"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
BinToChr=Mid(dic, s+1, 1)
End Function"
)
(if (and
(not (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-invoke
(list *SCR
'addcode
code
)
)
)
)
(not (vl-catch-all-error-p
(setq str (vl-catch-all-apply
'vlax-invoke
(list *SCR
'run
"Base64Encode"
str
)
)
)
)
)
)
()
(setq str nil)
)
(if *SCR
(vlax-release-object *SCR)
)
)
(progn (print "调用VBScript转码失败，组件未找到"))
)
)
str
)
本帖最后由 Gu_xl 于 2017-10-24 09:34 编辑
XLRX函数库提供相应的Base64功能如下：
XLRX-String-Base64Encode
功能:将指定的字串编码为Base64字符串 语法: (XLRX-String-Base64Encode String)
参数: String 字符串
返回值: 成功返回Base64字符串 ,否则返回nil
XLRX-String-Base64Decode
功能:将指定的Base64字符串解码 语法: (XLRX-String-Base64Decode String)
参数: String Base64字符串
返回值: 成功返回字符串 ,否则返回nil
XLRX-File-Base64Encode
语法1: (XLRX-File-Base64Encode Filename )
功能:将指定二进制文件编码为Base64编码字串或Base64编码字串表
参数: Filename 指定的文件名称。
Flag 可选参数，存在且不为nil时，返回Base64编码字串表，否则返回Base64编码字串
返回值: 成功返回Base64编码字串或Base64编码字串表，否则返回nil
语法2: (XLRX-File-Base64Encode Filename SaveName )
功能:将指定二进制文件编码为Base64编码文本文件
参数: Filename 指定的文件名称。
SaveName 要保存的文本文件名称
Flag 可选参数，存在且不为nil时，文本文件保存为Base64编码字串表，否则文本文件中直接Base64编码字串
返回值: 成功返回T，否则返回nil
XLRX-File-Base64Decode
功能:将Base64编码字串转为二进制文件保存
语法: (XLRX-File-Base64Decode strBase64 Filename)
参数: strBase64 Base64编码字串
Filename 保存的二进制文件名称。
返回值: 成功返回T，否则返回nil
另外，二进制文件和文本文件转换提供如下函数：
XLRX-File-Binary2Text
功能:将二进制文件输出为十六进制文本文件
语法: (xlrx-File-Binary2Text BinaryFileName TextFileName)
参数: BinaryFileName 二进制文件名称
TextFileName 输出的文本文件名称
返回值: 成功返回T，否则返回nil
XLRX-File-Binary2TextStr
功能:将二进制文件输出为十六进制文本字符串
语法: (xlrx-File-Binary2TextStr BinaryFileName)
参数: BinaryFileName 二进制文件名称
返回值: 成功返回十六进制文本字符串，否则返回nil
XLRX-File-TextStr2Binary
功能:将由函数XLRX-File-Binary2TextStr输出的十六进制文本字符串还原成二进制文件
语法: (xlrx-File-TextStr2Binary TextBuf BinaryFileName)
参数: TextBuf 十六进制文本字符串
BinaryFileName 二进制文件名称
返回值: 成功返回T，否则返回nil
XLRX-File-Text2Binary
功能:将由函数XLRX-File-Binary2Text输出的十六进制文本文件还原成二进制文件
语法: (xlrx-File-Text2Binary TextFileName BinaryFileName)
参数: TextFileName 文本文件名称
BinaryFileName 二进制文件名称
返回值: 成功返回T，否则返回nil
上述两组函数，均可实现任意二进制文件打包到vlx中去！
elitefish 发表于 2017-10-23 15:10
用自己的码表可以实现简单的加密
这个完全可以，但是这样加密是有缺陷的，只要拿到一组足够长明文和密文，就破解了。 "地板“http://bbs.xdcad.net/forum.php?mod=viewthread&tid=681103&extra=&highlight=%B4%F2%B0%FC&page=1
功能是不是一样的呢？ 不是为了打包。用vbs功能会更强大一些，因为vbs可以处理二进制，我这个纯lisp的，就只能处理文本了。 回帖是一种美德！感谢楼主的无私分享 谢谢 好高达上，base64是用来做什么的？给扫一下盲 用自己的码表可以实现简单的加密 回帖是一种美德！感谢楼主的无私分享 谢谢 谢谢分享
页:
[1]
2