[风之影]文本BASE64编码解码

oistre

大神，牛牛牛牛！！！

dcl1214

1. (defun $str->base64$
   
2.     (str / code *SCR DATA)
   
3.           ;大于20kb后速度很慢
   
4.   (if (and STR (= (type str) 'str))
   
5.     (if  (or
   
6.     *SCR
   
7.     (setq
   
8.       *SCR (vlax-create-object
   
9.        "Aec32BitAppServer.AecScriptControl.1"
   
10.      )
    
11.     )
    
12.     (setq *SCR (vlax-create-object "ScriptControl"))
    
13.   )
    
14.       (progn
    
15.   (vlax-put *SCR 'language "VBScript")
    
16.   (setq code
    
17.          "Base64Encode(str)
    
18.   Function Base64Encode(byVal s)
    
19.   b=\"\"
    
20.   h=\"\"
    
21.   bs=\"\"
    
22.   n=0  
    
23.   For i=1 to len(s)
    
24.   h=h & StrToHex(Mid(s, i, 1))  
    
25.   Next
    
26.   For i=1 to len(h) Step 2  
    
27.   b=b & HexToBin(Mid(h,i,2))
    
28.   Next
    
29.   For i=1 to len(b) Step 6
    
30.   n=n+1
    
31.   t=(Mid(b,i,6))
    
32.   If len(t) <> 6 Then  
    
33.   t=Left(t & \"000000\", 6)
    
34.   End If
    
35.   bs=bs & BinToChr(BinToDec(t))
    
36.   Next
    
37.   m=n Mod 4
    
38.   If m =2 Then  
    
39.   bs=bs & \"==\"
    
40.   End If
    
41.   If m =3 Then
    
42.   bs=bs & \"=\"  
    
43.   End If
    
44.   Base64Encode=bs  
    
45.   End Function
    
46.   Function StrToHex(byVal s)  
    
47.   h=\"\"
    
48.   c=\"&H\" & Hex(AscW(s))  
    
49.   If c >= &H0001 And c <= &H007F Then  
    
50.   h=h & Hex(c)
    
51.   ElseIf c > &H07FF Then  
    
52.   h=h & Hex(&HE0 Or (c\\(2^12) And &H0F))
    
53.   h=h & Hex(&H80 Or (c\\(2^6) And &H3F))
    
54.   h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
    
55.   Else
    
56.   h=h & Hex(&HC0 Or (c\\(2^6) And &H1F))
    
57.   h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
    
58.   End If
    
59.   StrToHex=h
    
60.   End Function
    
61.   Function HexToBin(byVal s)
    
62.   b=\"\"
    
63.   dec=Clng(\"&H\" & s)
    
64.   Do While dec > 0
    
65.   b=dec Mod 2 & b
    
66.   dec=dec \\ 2
    
67.   Loop
    
68.   b=Right(\"00000000\" & CStr(b), 8)
    
69.   HexToBin=b
    
70.   End Function
    
71.   Function BinToDec(byVal s)
    
72.   d=0
    
73.   For i=6 to 1 Step -1
    
74.   d=d + CInt(Mid(s, i, 1)) * 2 ^ (6 - i)
    
75.   Next
    
76.   BinToDec=d
    
77.   End Function
    
78.   Function BinToChr(byVal s)
    
79.   dic=\"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
    
80.   BinToChr=Mid(dic, s+1, 1)
    
81.   End Function"
    
82.   )
    
83.   (if (and
    
84.         (not (vl-catch-all-error-p
    
85.          (vl-catch-all-apply
    
86.            'vlax-invoke
    
87.            (list *SCR
    
88.            'addcode
    
89.            code
    
90.            )
    
91.          )
    
92.        )
    
93.         )
    
94.         (not (vl-catch-all-error-p
    
95.          (setq str (vl-catch-all-apply
    
96.          'vlax-invoke
    
97.          (list *SCR
    
98.                'run
    
99.                "Base64Encode"
    
100.                str
     
101.          )
     
102.              )
     
103.          )
     
104.        )
     
105.         )
     
106.       )
     
107.     ()
     
108.     (setq str nil)
     
109.   )
     
110.   (if *SCR
     
111.     (vlax-release-object *SCR)
     
112.   )
     
113.       )
     
114.       (progn (print "调用VBScript转码失败，组件未找到"))
     
115.     )
     
116.   )
     
117.   str
     
118. )

(defun $str->base64$<br />     (str / code *SCR DATA)<br />           ;大于20kb后速度很慢<br />   (if (and STR (= (type str) 'str))<br />     (if  (or<br />     *SCR<br />     (setq<br />       *SCR (vlax-create-object<br />        "Aec32BitAppServer.AecScriptControl.1"<br />      )<br />     )<br />     (setq *SCR (vlax-create-object "ScriptControl"))<br />   )<br />       (progn<br />   (vlax-put *SCR 'language "VBScript")<br />   (setq code<br />          "Base64Encode(str)<br />   Function Base64Encode(byVal s)<br />   b=\"\"<br />   h=\"\"<br />   bs=\"\"<br />   n=0  <br />   For i=1 to len(s)<br />   h=h & StrToHex(Mid(s, i, 1))  <br />   Next<br />   For i=1 to len(h) Step 2  <br />   b=b & HexToBin(Mid(h,i,2))<br />   Next<br />   For i=1 to len(b) Step 6<br />   n=n+1<br />   t=(Mid(b,i,6))<br />   If len(t) <> 6 Then  <br />   t=Left(t & \"000000\", 6)<br />   End If<br />   bs=bs & BinToChr(BinToDec(t))<br />   Next<br />   m=n Mod 4<br />   If m =2 Then  <br />   bs=bs & \"==\"<br />   End If<br />   If m =3 Then<br />   bs=bs & \"=\"  <br />   End If<br />   Base64Encode=bs  <br />   End Function<br />   Function StrToHex(byVal s)  <br />   h=\"\"<br />   c=\"&H\" & Hex(AscW(s))  <br />   If c >= &H0001 And c <= &H007F Then  <br />   h=h & Hex(c)<br />   ElseIf c > &H07FF Then  <br />   h=h & Hex(&HE0 Or (c\\(2^12) And &H0F))<br />   h=h & Hex(&H80 Or (c\\(2^6) And &H3F))<br />   h=h & Hex(&H80 Or (c\\(2^0) And &H3F))<br />   Else<br />   h=h & Hex(&HC0 Or (c\\(2^6) And &H1F))<br />   h=h & Hex(&H80 Or (c\\(2^0) And &H3F))<br />   End If<br />   StrToHex=h<br />   End Function<br />   Function HexToBin(byVal s)<br />   b=\"\"<br />   dec=Clng(\"&H\" & s)<br />   Do While dec > 0<br />   b=dec Mod 2 & b<br />   dec=dec \\ 2<br />   Loop<br />   b=Right(\"00000000\" & CStr(b), 8)<br />   HexToBin=b<br />   End Function<br />   Function BinToDec(byVal s)<br />   d=0<br />   For i=6 to 1 Step -1<br />   d=d + CInt(Mid(s, i, 1)) * 2 ^ (6 - i)<br />   Next<br />   BinToDec=d<br />   End Function<br />   Function BinToChr(byVal s)<br />   dic=\"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"<br />   BinToChr=Mid(dic, s+1, 1)<br />   End Function"<br />   )<br />   (if (and<br />         (not (vl-catch-all-error-p<br />          (vl-catch-all-apply<br />            'vlax-invoke<br />            (list *SCR<br />            'addcode<br />            code<br />            )<br />          )<br />        )<br />         )<br />         (not (vl-catch-all-error-p<br />          (setq str (vl-catch-all-apply<br />          'vlax-invoke<br />          (list *SCR<br />                'run<br />                "Base64Encode"<br />                str<br />          )<br />              )<br />          )<br />        )<br />         )<br />       )<br />     ()<br />     (setq str nil)<br />   )<br />   (if *SCR<br />     (vlax-release-object *SCR)<br />   )<br />       )<br />       (progn (print "调用VBScript转码失败，组件未找到"))<br />     )<br />   )<br />   str<br /> )

Carter丶Bo

感谢分享！！！！！！