URL编码转换URLencode

tryhi

1. ;;;函数名称:try-URLencode
   
2. ;;;函数说明:url编码
   
3. ;;;示    例try-URLencode "http://127.0.0.1/save/1/post上传文件.lsp")
   
4. (defun try-URLencode (str / _urlbianma lst utf-8lst)
   
5.   (defun _urlbianma(n / 10-16 m n16x x)
   
6.     (if (< n 128)
   
7.       (chr n);单字节
   
8.       (progn
   
9.         (setq x "" 10-16 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
   
10.         (while (/= 0 n)
    
11.           (setq
    
12.             m(rem n 16)
    
13.             n(/ n 16)
    
14.             n16x(nth m 10-16)
    
15.             x(strcat n16x x)
    
16.           )
    
17.         )
    
18.         (if (= x "")(setq x"0"))
    
19.         (if (= (strlen x)1) (setq x(strcat "0"x)))
    
20.         (strcat "%" x)
    
21.       )
    
22.       
    
23.     )
    
24.   )
    
25.   (setq utf-8lst(try-str2UTF-8  str))
    
26.   (setq lst (mapcar '_urlbianma utf-8lst))
    
27.   (apply 'strcat lst)
    
28. )
    
29. (defun try-str2UTF-8 (str / file_list fileget stream)
    
30.   (if (setq stream (vlax-create-object "Adodb.Stream"))
    
31.     (progn
    
32.       (vlax-put-property stream 'Type 2) ; 1二进制读取 2文本模式读取
    
33.       (vlax-put-property stream 'Mode 3) ; 1-读,2-写,3-读写
    
34.       (vlax-put-property stream 'Charset "utf-8") ; 设置编码为UTF-8
    
35.       (vlax-invoke stream 'Open)
    
36.       (vlax-invoke stream 'WriteText str)
    
37.       (vlax-put-property stream 'Position 0) ; 将位置重置为起始位置
    
38.       (vlax-put-property stream 'Type 1) ; 1二进制读取 2文本模式读取
    
39.       (setq FileGet(Vlax-Invoke-Method stream 'Read nil))
    
40.       (setq File_list (vlax-safearray->list (vlax-variant-value FileGet)))
    
41.       (vlax-release-object stream)
    
42.       (cdddr File_list);去除BOM
    
43.     )
    
44.     (princ"\n无法创建'Adodb.Stream'对象")
    
45.   )
    
46. )
    
47. 
    
48. (try-URLencode "http://127.0.0.1/save/1/post上传文件.lsp")
    
49. ;--> "http://127.0.0.1/save/1/post%E4%B8%8A%E4%BC%A0%E6%96%87%E4%BB%B6.lsp"

;;;函数名称:try-URLencode<br /> ;;;函数说明:url编码<br /> ;;;示    例<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />try-URLencode "http://127.0.0.1/save/1/post上传文件.lsp")<br /> (defun try-URLencode (str / _urlbianma lst utf-8lst)<br />   (defun _urlbianma(n / 10-16 m n16x x)<br />     (if (< n 128)<br />       (chr n);单字节<br />       (progn <br />         (setq x "" 10-16 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))<br />         (while (/= 0 n)<br />           (setq <br />             m(rem n 16)<br />             n(/ n 16)<br />             n16x(nth m 10-16)<br />             x(strcat n16x x)<br />           )<br />         )<br />         (if (= x "")(setq x"0"))<br />         (if (= (strlen x)1) (setq x(strcat "0"x)))<br />         (strcat "%" x)<br />       )<br />       <br />     )<br />   )<br />   (setq utf-8lst(try-str2UTF-8  str))<br />   (setq lst (mapcar '_urlbianma utf-8lst))<br />   (apply 'strcat lst)<br /> )<br /> (defun try-str2UTF-8 (str / file_list fileget stream)<br />   (if (setq stream (vlax-create-object "Adodb.Stream"))<br />     (progn<br />       (vlax-put-property stream 'Type 2) ; 1二进制读取 2文本模式读取<br />       (vlax-put-property stream 'Mode 3) ; 1-读,2-写,3-读写<br />       (vlax-put-property stream 'Charset "utf-8") ; 设置编码为UTF-8<br />       (vlax-invoke stream 'Open)<br />       (vlax-invoke stream 'WriteText str)<br />       (vlax-put-property stream 'Position 0) ; 将位置重置为起始位置<br />       (vlax-put-property stream 'Type 1) ; 1二进制读取 2文本模式读取<br />       (setq FileGet(Vlax-Invoke-Method stream 'Read nil))<br />       (setq File_list (vlax-safearray->list (vlax-variant-value FileGet)))<br />       (vlax-release-object stream)<br />       (cdddr File_list);去除BOM<br />     )<br />     (princ"\n无法创建'Adodb.Stream'对象")<br />   )<br /> )<br /> <br /> (try-URLencode "http://127.0.0.1/save/1/post上传文件.lsp")<br /> ;--> "http://127.0.0.1/save/1/post%E4%B8%8A%E4%BC%A0%E6%96%87%E4%BB%B6.lsp"

帮一个网友写的URL编码转换，用来带汉字对服务器进行传参
示例：(try-URLencode "http://127.0.0.1/save/1/post上传文件.lsp")
;--> "http://127.0.0.1/save/1/post%E4%B8%8A%E4%BC%A0%E6%96%87%E4%BB%B6.lsp"

dcl1214

1. (defun $URLencode$
   
2.        (str / $URLencode-sc$ $URLencode-vbs$ STRS $URLencode3$)
   
3.   (defun $URLencode3$
   
4.    (str / $jz10->jz16$ $str->utf-8$ 16jzs str-new utf-8s)
   
5.     (defun $str->UTF-8$  (str / file_list fileget stream)
   
6.       (if (and (setq stream (vl-catch-all-apply
   
7.             'vlax-create-object
   
8.             (list "Adodb.Stream")
   
9.           )
   
10.          )
    
11.          (not (vl-catch-all-error-p stream))
    
12.     )
    
13.   (progn
    
14.     (vlax-put-property stream 'Type 2)
    
15.           ; 1二进制读取 2文本模式读取
    
16.     (vlax-put-property stream 'Mode 3) ; 1-读,2-写,3-读写
    
17.     (vlax-put-property stream 'Charset "utf-8") ; 设置编码为UTF-8
    
18.     (vlax-invoke stream 'Open)
    
19.     (vlax-invoke stream 'WriteText str)
    
20.     (vlax-put-property stream 'Position 0) ; 将位置重置为起始位置
    
21.     (vlax-put-property stream 'Type 1)
    
22.           ; 1二进制读取 2文本模式读取
    
23.     (and (setq FileGet (Vlax-Invoke-Method stream 'Read nil))
    
24.          (setq FileGet (vl-catch-all-apply
    
25.              'vlax-variant-value
    
26.              (list FileGet)
    
27.            )
    
28.          )
    
29.          (setq File_list (vlax-safearray->list FileGet))
    
30.          (setq File_list (cdddr File_list)) ;去除BOM
    
31.     )
    
32.     (vl-catch-all-apply 'vlax-release-object (list stream))
    
33.   )
    
34.   (print "$URLencode3$无法创建'Adodb.Stream'对象")
    
35.       )
    
36.       File_list
    
37.     )
    
38.     (defun $jz10->jz16$  (int)
    
39.       (cond ((< int 10)
    
40.        (itoa int)
    
41.       )
    
42.       ((<= 10 int 15)
    
43.        (chr (+ int 55))
    
44.       )
    
45.       (t
    
46.        (strcat
    
47.          ($jz10->jz16$ (/ int 16))
    
48.          ($jz10->jz16$ (rem int 16))
    
49.        )
    
50.       )
    
51.       )
    
52.     )
    
53.     (setq utf-8s ($str->UTF-8$ str))
    
54.     (setq 16jzs  (mapcar  (function (lambda (a) ($jz10->jz16$ a)))
    
55.       utf-8s
    
56.     )
    
57.     )
    
58.     (setq
    
59.       str-new
    
60.        (apply 'strcat
    
61.         (mapcar (function (lambda (x) (strcat "%" x))) 16jzs)
    
62.        )
    
63.     )
    
64.     (if  str-new
    
65.       (setq str str-new)
    
66.     )
    
67.     str
    
68.   )
    
69.   (defun $URLencode-sc$  (str / SC url)
    
70.           ;($URLencode$ "213j 213 2 3 %20")
    
71.           ;这个方法写出来了，还没应用到具体场景，应该是没问题，20201112
    
72.     (if  (or
    
73.     (and (setq SC
    
74.           (vl-catch-all-apply
    
75.       'vlax-get-or-create-object
    
76.       (list
    
77.         "MSScriptControl.ScriptControl"
    
78.       )
    
79.           )
    
80.          )
    
81.          (not (vl-catch-all-error-p SC))
    
82.     )
    
83.     (and (setq SC
    
84.           (vl-catch-all-apply
    
85.       'vlax-get-or-create-object
    
86.       (list
    
87.         "Aec32BitAppServer.AecScriptControl.1"
    
88.       )
    
89.           )
    
90.          )
    
91.          (not (vl-catch-all-error-p SC))
    
92.     )
    
93.     (and (setq SC
    
94.           (vl-catch-all-apply
    
95.       'vlax-get-or-create-object
    
96.       (list
    
97.         "ScriptControl"
    
98.       )
    
99.           )
    
100.          )
     
101.          (not (vl-catch-all-error-p SC))
     
102.     )
     
103.     (and (setq SC
     
104.           (vl-catch-all-apply
     
105.       'vlax-get-or-create-object
     
106.       (list
     
107.         "{e8540e26-d20e-483f-9fd5-a5a3553a7556}"
     
108.       )
     
109.           )
     
110.          )
     
111.          (not (vl-catch-all-error-p SC))
     
112.     )
     
113.     (and (setq SC
     
114.           (vl-catch-all-apply
     
115.       'vlax-get-or-create-object
     
116.       (list
     
117.         "{0e59f1d5-1fbe-11d0-8ff2-00a0d10038bc}"
     
118.       )
     
119.           )
     
120.          )
     
121.          (not (vl-catch-all-error-p SC))
     
122.     )
     
123.   )
     
124.       (progn
     
125.   (vl-catch-all-apply
     
126.     'vlax-put
     
127.     (list SC 'Language "JScript")
     
128.   )
     
129.   (setq url (vl-catch-all-apply
     
130.         'vlax-invoke
     
131.         (list SC 'run "encodeURI" str)
     
132.       )
     
133.   )
     
134.       )
     
135.     )
     
136.     (if  sc
     
137.       (vlax-release-object sc)
     
138.     )
     
139.     (IF  (vl-catch-all-error-p url)  ;如果出错
     
140.       (setq url nil)
     
141.     )
     
142.     (if  url
     
143.       url
     
144.       str
     
145.     )
     
146.   )
     
147.   (defun $URLencode-vbs$
     
148.        (str / code *SCR DATA new)
     
149.           ;($URLencode$  "http://192.168.0.107:8848/download?filename=中国.png")  
     
150.     (if  STR
     
151.       (if (or
     
152.       *SCR
     
153.       (setq
     
154.         *SCR (vlax-create-object
     
155.          "Aec32BitAppServer.AecScriptControl.1"
     
156.        )
     
157.       )
     
158.       (setq *SCR (vlax-create-object "ScriptControl"))
     
159.     )
     
160.   (progn
     
161.     (vlax-put *SCR 'language "VBScript")
     
162.     (setq  code
     
163.      "Function UTF8Encode(szString)
     
164.         Dim szChar,szTemp,szCode
     
165.         Dim szHex,szBin
     
166.         Dim iCount1,iCount2
     
167.         Dim iStrLen1,iStrLen2
     
168.         Dim lResult
     
169.         Dim lAscVal
     
170.         exclude=\"-_.!~*'();/?&=+$,#\"
     
171.         szString = Trim(szString)
     
172.         iStrLen1 = Len(szString)
     
173.         For iCount1 = 1 To iStrLen1
     
174.             szChar = Mid(szString, iCount1, 1)
     
175.             lAscVal = AscW(szChar)
     
176.             If lAscVal >= &H0 And lAscVal <= &HFF Then
     
177.                 If (lAscVal >= &H30 And lAscVal <= &H39) Or (lAscVal >= &H41 And lAscVal <= &H5A) Or (lAscVal >= &H61 And lAscVal <= &H7A) Or InStr(exclude,szChar) >0 Then
     
178.                     szCode = szCode & szChar
     
179.                 Else
     
180.                     szCode = szCode & \"%\" & Hex(AscW(szChar))
     
181.                 End If
     
182.             Else
     
183.                 szHex = Hex(AscW(szChar))
     
184.                 iStrLen2 = Len(szHex)
     
185.                 For iCount2 = 1 To iStrLen2
     
186.                     szChar = Mid(szHex, iCount2, 1)
     
187.                     szBin = szBin & Mid(\"0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;\", CLng(\"&H\" & szChar) * 5 + 1, 4)
     
188.                 Next
     
189.                 szTemp = \"1110\" & Left(szBin, 4) & \"10\" & Mid(szBin, 5, 6) & \"10\" & Right(szBin, 6)
     
190.                 For iCount2 = 1 To 24
     
191.                     If Mid(szTemp, iCount2, 1) = \"1\" Then
     
192.                         lResult = lResult + 1 * 2 ^ (24 - iCount2)
     
193.                     Else
     
194.                         lResult = lResult + 0 * 2 ^ (24 - iCount2)
     
195.                     End If
     
196.                 Next
     
197.                 szTemp = Hex(lResult)
     
198.                 szCode = szCode & \"%\" & Left(szTemp, 2) & \"%\" & Mid(szTemp, 3, 2) & \"%\" & Right(szTemp, 2)
     
199.             End If
     
200.             szBin = vbNullString
     
201.             lResult = 0
     
202.         Next
     
203.         UTF8Encode = szCode
     
204.     End Function"
     
205.     )
     
206.     (if (and
     
207.     (not (vl-catch-all-error-p
     
208.            (vl-catch-all-apply
     
209.        'vlax-invoke
     
210.        (list *SCR
     
211.              'addcode
     
212.              code
     
213.        )
     
214.            )
     
215.          )
     
216.     )
     
217.     (not (vl-catch-all-error-p
     
218.            (setq new (vl-catch-all-apply
     
219.            'vlax-invoke
     
220.            (list *SCR
     
221.            'run
     
222.            "UTF8Encode"
     
223.            str
     
224.            )
     
225.          )
     
226.            )
     
227.          )
     
228.     )
     
229.         )
     
230.       ()
     
231.       (setq new nil)
     
232.     )
     
233.     (if *SCR
     
234.       (vlax-release-object *SCR)
     
235.     )
     
236.   )
     
237.   (progn (print "调用VBScript转码失败，组件未找到"))
     
238.       )
     
239.     )
     
240.     new
     
241.   )
     
242.   (if (and STR
     
243.      (setq strs (vl-string->list str))
     
244.      (vl-some (function (lambda (a)
     
245.         (> a 128)
     
246.             )
     
247.         )
     
248.         strs
     
249.      )
     
250.       )
     
251.     (or  (setq url ($URLencode3$ str))
     
252.   (setq url ($URLencode-sc$ str))
     
253.   (setq url ($URLencode-vbs$ str))
     
254.   (setq url str)      ;如果上面两个都转码失败了，直接返回原始字串
     
255.     )
     
256.     (setq url str)
     
257.   )
     
258.   url
     
259. )

(defun $URLencode$<br />        (str / $URLencode-sc$ $URLencode-vbs$ STRS $URLencode3$)<br />   (defun $URLencode3$<br />    (str / $jz10->jz16$ $str->utf-8$ 16jzs str-new utf-8s)<br />     (defun $str->UTF-8$  (str / file_list fileget stream)<br />       (if (and (setq stream (vl-catch-all-apply<br />             'vlax-create-object<br />             (list "Adodb.Stream")<br />           )<br />          )<br />          (not (vl-catch-all-error-p stream))<br />     )<br />   (progn<br />     (vlax-put-property stream 'Type 2)<br />           ; 1二进制读取 2文本模式读取<br />     (vlax-put-property stream 'Mode 3) ; 1-读,2-写,3-读写<br />     (vlax-put-property stream 'Charset "utf-8") ; 设置编码为UTF-8<br />     (vlax-invoke stream 'Open)<br />     (vlax-invoke stream 'WriteText str)<br />     (vlax-put-property stream 'Position 0) ; 将位置重置为起始位置<br />     (vlax-put-property stream 'Type 1)<br />           ; 1二进制读取 2文本模式读取<br />     (and (setq FileGet (Vlax-Invoke-Method stream 'Read nil))<br />          (setq FileGet (vl-catch-all-apply<br />              'vlax-variant-value<br />              (list FileGet)<br />            )<br />          )<br />          (setq File_list (vlax-safearray->list FileGet))<br />          (setq File_list (cdddr File_list)) ;去除BOM<br />     )<br />     (vl-catch-all-apply 'vlax-release-object (list stream))<br />   )<br />   (print "$URLencode3$无法创建'Adodb.Stream'对象")<br />       )<br />       File_list<br />     )<br />     (defun $jz10->jz16$  (int)<br />       (cond ((< int 10)<br />        (itoa int)<br />       )<br />       ((<= 10 int 15)<br />        (chr (+ int 55))<br />       )<br />       (t<br />        (strcat<br />          ($jz10->jz16$ (/ int 16))<br />          ($jz10->jz16$ (rem int 16))<br />        )<br />       )<br />       )<br />     )<br />     (setq utf-8s ($str->UTF-8$ str))<br />     (setq 16jzs  (mapcar  (function (lambda (a) ($jz10->jz16$ a)))<br />       utf-8s<br />     )<br />     )<br />     (setq<br />       str-new<br />        (apply 'strcat<br />         (mapcar (function (lambda (x) (strcat "%" x))) 16jzs)<br />        )<br />     )<br />     (if  str-new<br />       (setq str str-new)<br />     )<br />     str<br />   )<br />   (defun $URLencode-sc$  (str / SC url)<br />           ;($URLencode$ "213j 213 2 3 %20")<br />           ;这个方法写出来了，还没应用到具体场景，应该是没问题，20201112<br />     (if  (or<br />     (and (setq SC<br />           (vl-catch-all-apply<br />       'vlax-get-or-create-object<br />       (list<br />         "MSScriptControl.ScriptControl"<br />       )<br />           )<br />          )<br />          (not (vl-catch-all-error-p SC))<br />     )<br />     (and (setq SC<br />           (vl-catch-all-apply<br />       'vlax-get-or-create-object<br />       (list<br />         "Aec32BitAppServer.AecScriptControl.1"<br />       )<br />           )<br />          )<br />          (not (vl-catch-all-error-p SC))<br />     )<br />     (and (setq SC<br />           (vl-catch-all-apply<br />       'vlax-get-or-create-object<br />       (list<br />         "ScriptControl"<br />       )<br />           )<br />          )<br />          (not (vl-catch-all-error-p SC))<br />     )<br />     (and (setq SC<br />           (vl-catch-all-apply<br />       'vlax-get-or-create-object<br />       (list<br />         "{e8540e26-d20e-483f-9fd5-a5a3553a7556}"<br />       )<br />           )<br />          )<br />          (not (vl-catch-all-error-p SC))<br />     )<br />     (and (setq SC<br />           (vl-catch-all-apply<br />       'vlax-get-or-create-object<br />       (list<br />         "{0e59f1d5-1fbe-11d0-8ff2-00a0d10038bc}"<br />       )<br />           )<br />          )<br />          (not (vl-catch-all-error-p SC))<br />     )<br />   )<br />       (progn<br />   (vl-catch-all-apply<br />     'vlax-put<br />     (list SC 'Language "JScript")<br />   )<br />   (setq url (vl-catch-all-apply<br />         'vlax-invoke<br />         (list SC 'run "encodeURI" str)<br />       )<br />   )<br />       )<br />     )<br />     (if  sc<br />       (vlax-release-object sc)<br />     )<br />     (IF  (vl-catch-all-error-p url)  ;如果出错<br />       (setq url nil)<br />     )<br />     (if  url<br />       url<br />       str<br />     )<br />   )<br />   (defun $URLencode-vbs$<br />        (str / code *SCR DATA new)<br />           ;($URLencode$  "http://192.168.0.107:8848/download?filename=中国.png")  <br />     (if  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 />      "Function UTF8Encode(szString)<br />         Dim szChar,szTemp,szCode<br />         Dim szHex,szBin<br />         Dim iCount1,iCount2<br />         Dim iStrLen1,iStrLen2<br />         Dim lResult<br />         Dim lAscVal<br />         exclude=\"-_.!~*'();/?<img src="static/image/smiley/default/huffy.gif" smilieid="5" border="0" alt="" />&=+$,#\"<br />         szString = Trim(szString)<br />         iStrLen1 = Len(szString)<br />         For iCount1 = 1 To iStrLen1<br />             szChar = Mid(szString, iCount1, 1)<br />             lAscVal = AscW(szChar)<br />             If lAscVal >= &H0 And lAscVal <= &HFF Then<br />                 If (lAscVal >= &H30 And lAscVal <= &H39) Or (lAscVal >= &H41 And lAscVal <= &H5A) Or (lAscVal >= &H61 And lAscVal <= &H7A) Or InStr(exclude,szChar) >0 Then<br />                     szCode = szCode & szChar<br />                 Else<br />                     szCode = szCode & \"%\" & Hex(AscW(szChar))<br />                 End If<br />             Else<br />                 szHex = Hex(AscW(szChar))<br />                 iStrLen2 = Len(szHex)<br />                 For iCount2 = 1 To iStrLen2<br />                     szChar = Mid(szHex, iCount2, 1)<br />                     szBin = szBin & Mid(\"0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;\", CLng(\"&H\" & szChar) * 5 + 1, 4)<br />                 Next<br />                 szTemp = \"1110\" & Left(szBin, 4) & \"10\" & Mid(szBin, 5, 6) & \"10\" & Right(szBin, 6)<br />                 For iCount2 = 1 To 24<br />                     If Mid(szTemp, iCount2, 1) = \"1\" Then<br />                         lResult = lResult + 1 * 2 ^ (24 - iCount2)<br />                     Else<br />                         lResult = lResult + 0 * 2 ^ (24 - iCount2)<br />                     End If<br />                 Next<br />                 szTemp = Hex(lResult)<br />                 szCode = szCode & \"%\" & Left(szTemp, 2) & \"%\" & Mid(szTemp, 3, 2) & \"%\" & Right(szTemp, 2)<br />             End If<br />             szBin = vbNullString<br />             lResult = 0<br />         Next<br />         UTF8Encode = szCode<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 new (vl-catch-all-apply<br />            'vlax-invoke<br />            (list *SCR<br />            'run<br />            "UTF8Encode"<br />            str<br />            )<br />          )<br />            )<br />          )<br />     )<br />         )<br />       ()<br />       (setq new nil)<br />     )<br />     (if *SCR<br />       (vlax-release-object *SCR)<br />     )<br />   )<br />   (progn (print "调用VBScript转码失败，组件未找到"))<br />       )<br />     )<br />     new<br />   )<br />   (if (and STR<br />      (setq strs (vl-string->list str))<br />      (vl-some (function (lambda (a)<br />         (> a 128)<br />             )<br />         )<br />         strs<br />      )<br />       )<br />     (or  (setq url ($URLencode3$ str))<br />   (setq url ($URLencode-sc$ str))<br />   (setq url ($URLencode-vbs$ str))<br />   (setq url str)      ;如果上面两个都转码失败了，直接返回原始字串<br />     )<br />     (setq url str)<br />   )<br />   url<br /> )

收集的

tryhi

jun353835273 发表于 2025-12-26 11:04
"%u+4f60%u+597d%u+4e16%u+754c"
_$ B
"%u+4f60%u+597d%u+4e16%u+754c"

1. ;; 使用MyMemory API的完整代码
   
2. (defun getxml (url / xml http)
   
3.   (if (setq http (vlax-create-object "WinHTTP.WinHTTPRequest.5.1"))
   
4.     (progn
   
5.       (vlax-invoke-method http "open" "GET" url :vlax-false)
   
6.       (vlax-invoke-method http "send")
   
7.       (vlax-invoke-method http "WaitForResponse" 5)
   
8.       (setq xml (vlax-get-property http "ResponseText"))
   
9.       (vlax-release-object http)
   
10.       xml
    
11.     )
    
12.   )
    
13. )
    
14. (defun fy (word / url result start end str translated)
    
15.   ;; 构建请求URL
    
16.   (setq url (strcat
    
17.     "https://api.mymemory.translated.net/get"
    
18.     "?q=" (vl-string-translate " " "%20" word)
    
19.     "&langpair=en|zh"
    
20.     "&de=" "your-email@example.com"  ;; 可选，提高免费额度
    
21.   ))
    
22.   
    
23.   ;; 获取结果
    
24.   (setq result (getxml url))
    
25.   
    
26.   (if (and result (> (strlen result) 10))
    
27.     (progn
    
28.       ;; 查找翻译结果
    
29.       (setq start (vl-string-search "\"translatedText\":\"" result))
    
30.       (if start
    
31.         (progn
    
32.           (setq str (substr result (+ start 19)))
    
33.           (setq end1 (vl-string-search "\"" str))
    
34.           (if end1
    
35.             (progn
    
36.               (setq translated (substr str 1 end1))
    
37.               
    
38.               ;; 解码URL编码
    
39.               (setq translated (vl-string-translate "%20" " " translated))
    
40.               (setq translated (vl-string-translate "%25" "%" translated))
    
41.               (setq translated (vl-string-translate "%0A" "\n" translated))
    
42.               (setq translated (vl-string-translate "%0D" "\r" translated))
    
43.               
    
44.               ;; 解码JSON转义
    
45.               (setq translated (vl-string-translate "\\\"" "\"" translated))
    
46.               (setq translated (vl-string-translate "\\\\" "\\" translated))
    
47.               (setq translated (vl-string-translate "\\/" "/" translated))
    
48.               (setq translated (vl-string-translate "\\b" "\b" translated))
    
49.               (setq translated (vl-string-translate "\\f" "\f" translated))
    
50.               (setq translated (vl-string-translate "\\n" "\n" translated))
    
51.               (setq translated (vl-string-translate "\\r" "\r" translated))
    
52.               (setq translated (vl-string-translate "\\t" "\t" translated))
    
53.               
    
54.               ;; 清理空白字符
    
55.               (setq translated (vl-string-trim " \t\n\r" translated))
    
56.               
    
57.               ;; 如果结果包含 %% 且不是正常的百分号，可能是解析问题
    
58.               (if (and (vl-string-search "%%" translated)
    
59.                        (not (vl-string-search "%" word)))  ;; 原文本没有%
    
60.                 (progn
    
61.                   ;; 尝试修复可能的解析错误
    
62.                   (setq translated (vl-string-subst "%" "%%" translated))
    
63.                 )
    
64.               )
    
65.               
    
66.               translated
    
67.             )
    
68.             word  ;; 没有找到结束引号
    
69.           )
    
70.         )
    
71.         word  ;; 没有找到翻译文本
    
72.       )
    
73.     )
    
74.     word  ;; 结果无效
    
75.   )
    
76. )
    
77. 
    
78. 
    
79. ;; 主命令函数
    
80. (defun c:TTR (/ ss n e dt txt oldtxt newtxt)
    
81.   (setvar "cmdecho" 0)
    
82.   (princ "\n选择要翻译的文本对象: ")
    
83.   
    
84.   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    
85.     (progn
    
86.       (setq n 0)
    
87.       (repeat (sslength ss)
    
88.         (setq e (ssname ss n)
    
89.               n (1+ n)
    
90.               dt (entget e)
    
91.               oldtxt (cdr (assoc 1 dt))
    
92.         )
    
93.         
    
94.         (princ (strcat "\n翻译: \"" oldtxt "\""))
    
95.         
    
96.         ;; 调用翻译函数
    
97.         (setq newtxt (fy oldtxt))
    
98.         
    
99.         (if (and newtxt (not (equal newtxt oldtxt)))
    
100.           (progn
     
101.             (entmod (subst (cons 1 newtxt) (assoc 1 dt) dt))
     
102.             (princ (strcat " -> \"" newtxt "\""))
     
103.           )
     
104.           (princ " [翻译失败或未改变]")
     
105.         )
     
106.       )
     
107.     )
     
108.   )
     
109.   (princ)
     
110. )
     
111. (defun T-string-subst (old new str / n)
     
112.   (setq n (- (strlen new)))
     
113.     (while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))
     
114.       (setq str (vl-string-subst new old str n))
     
115.     )
     
116.   str
     
117. )
     
118. 
     
119. (defun Unicode (translated / a b)
     
120. 
     
121. ;(setq translated "\"u4f60\"u597d\"u4e16\"u754c")
     
122. (setq a (T-string-subst "\"u" "\\U+" translated))
     
123. (setq b(read (strcat "\""a"\"")))
     
124.         (vl-princ-to-string b)
     
125. )
     
126. 
     
127. ;; 测试命令
     
128. (defun c:TEST ()
     
129.   (princ (Unicode(fy "hello-world")))
     
130.   (princ)
     
131. )
     
132. 
     
133. (Unicode(fy "the sea"))
     

;; 使用MyMemory API的完整代码<br /> (defun getxml (url / xml http)<br />   (if (setq http (vlax-create-object "WinHTTP.WinHTTPRequest.5.1"))<br />     (progn<br />       (vlax-invoke-method http "open" "GET" url :vlax-false)<br />       (vlax-invoke-method http "send")<br />       (vlax-invoke-method http "WaitForResponse" 5)<br />       (setq xml (vlax-get-property http "ResponseText"))<br />       (vlax-release-object http)<br />       xml<br />     )<br />   )<br /> )<br /> (defun fy (word / url result start end str translated)<br />   ;; 构建请求URL<br />   (setq url (strcat <br />     "https://api.mymemory.translated.net/get"<br />     "?q=" (vl-string-translate " " "%20" word)<br />     "&langpair=en|zh"<br />     "&de=" "your-email@example.com"  ;; 可选，提高免费额度<br />   ))<br />   <br />   ;; 获取结果<br />   (setq result (getxml url))<br />   <br />   (if (and result (> (strlen result) 10))<br />     (progn<br />       ;; 查找翻译结果<br />       (setq start (vl-string-search "\"translatedText\":\"" result))<br />       (if start<br />         (progn<br />           (setq str (substr result (+ start 19)))<br />           (setq end1 (vl-string-search "\"" str))<br />           (if end1<br />             (progn<br />               (setq translated (substr str 1 end1))<br />               <br />               ;; 解码URL编码<br />               (setq translated (vl-string-translate "%20" " " translated))<br />               (setq translated (vl-string-translate "%25" "%" translated))<br />               (setq translated (vl-string-translate "%0A" "\n" translated))<br />               (setq translated (vl-string-translate "%0D" "\r" translated))<br />               <br />               ;; 解码JSON转义<br />               (setq translated (vl-string-translate "\\\"" "\"" translated))<br />               (setq translated (vl-string-translate "\\\\" "\\" translated))<br />               (setq translated (vl-string-translate "\\/" "/" translated))<br />               (setq translated (vl-string-translate "\\b" "\b" translated))<br />               (setq translated (vl-string-translate "\\f" "\f" translated))<br />               (setq translated (vl-string-translate "\\n" "\n" translated))<br />               (setq translated (vl-string-translate "\\r" "\r" translated))<br />               (setq translated (vl-string-translate "\\t" "\t" translated))<br />               <br />               ;; 清理空白字符<br />               (setq translated (vl-string-trim " \t\n\r" translated))<br />               <br />               ;; 如果结果包含 %% 且不是正常的百分号，可能是解析问题<br />               (if (and (vl-string-search "%%" translated)<br />                        (not (vl-string-search "%" word)))  ;; 原文本没有%<br />                 (progn<br />                   ;; 尝试修复可能的解析错误<br />                   (setq translated (vl-string-subst "%" "%%" translated))<br />                 )<br />               )<br />               <br />               translated<br />             )<br />             word  ;; 没有找到结束引号<br />           )<br />         )<br />         word  ;; 没有找到翻译文本<br />       )<br />     )<br />     word  ;; 结果无效<br />   )<br /> )<br /> <br /> <br /> ;; 主命令函数<br /> (defun c:TTR (/ ss n e dt txt oldtxt newtxt)<br />   (setvar "cmdecho" 0)<br />   (princ "\n选择要翻译的文本对象: ")<br />   <br />   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))<br />     (progn<br />       (setq n 0)<br />       (repeat (sslength ss)<br />         (setq e (ssname ss n)<br />               n (1+ n)<br />               dt (entget e)<br />               oldtxt (cdr (assoc 1 dt))<br />         )<br />         <br />         (princ (strcat "\n翻译: \"" oldtxt "\""))<br />         <br />         ;; 调用翻译函数<br />         (setq newtxt (fy oldtxt))<br />         <br />         (if (and newtxt (not (equal newtxt oldtxt)))<br />           (progn<br />             (entmod (subst (cons 1 newtxt) (assoc 1 dt) dt))<br />             (princ (strcat " -> \"" newtxt "\""))<br />           )<br />           (princ " [翻译失败或未改变]")<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> (defun T-string-subst (old new str / n)<br />   (setq n (- (strlen new)))<br />     (while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))<br />       (setq str (vl-string-subst new old str n))<br />     )<br />   str<br /> )<br /> <br /> (defun Unicode (translated / a b)<br /> <br /> ;(setq translated "\"u4f60\"u597d\"u4e16\"u754c")<br /> (setq a (T-string-subst "\"u" "\\U+" translated))<br /> (setq b(read (strcat "\""a"\"")))<br />         (vl-princ-to-string b)<br /> )<br /> <br /> ;; 测试命令<br /> (defun c:TEST ()<br />   (princ (Unicode(fy "hello-world")))<br />   (princ)<br /> )<br /> <br /> (Unicode(fy "the sea"))<br />

jun353835273

1. ;; 使用MyMemory API的完整代码
   
2. (defun getxml (url / xml http)
   
3.   (if (setq http (vlax-create-object "WinHTTP.WinHTTPRequest.5.1"))
   
4.     (progn
   
5.       (vlax-invoke-method http "open" "GET" url :vlax-false)
   
6.       (vlax-invoke-method http "send")
   
7.       (vlax-invoke-method http "WaitForResponse" 5)
   
8.       (setq xml (vlax-get-property http "ResponseText"))
   
9.       (vlax-release-object http)
   
10.       xml
    
11.     )
    
12.   )
    
13. )
    
14. (defun fy (word / url result start end str translated)
    
15.   ;; 构建请求URL
    
16.   (setq url (strcat
    
17.     "https://api.mymemory.translated.net/get"
    
18.     "?q=" (vl-string-translate " " "%20" word)
    
19.     "&langpair=zh|en"
    
20.     "&de=" "your-email@example.com"  ;; 可选，提高免费额度
    
21.   ))
    
22.   
    
23.   ;; 获取结果
    
24.   (setq result (getxml url))
    
25.   
    
26.   (if (and result (> (strlen result) 10))
    
27.     (progn
    
28.       ;; 查找翻译结果
    
29.       (setq start (vl-string-search "\"translatedText\":\"" result))
    
30.       (if start
    
31.         (progn
    
32.           (setq str (substr result (+ start 19)))
    
33.           (setq end1 (vl-string-search "\"" str))
    
34.           (if end1
    
35.             (progn
    
36.               (setq translated (substr str 1 end1))
    
37.               
    
38.               ;; 解码URL编码
    
39.               (setq translated (vl-string-translate "%20" " " translated))
    
40.               (setq translated (vl-string-translate "%25" "%" translated))
    
41.               (setq translated (vl-string-translate "%0A" "\n" translated))
    
42.               (setq translated (vl-string-translate "%0D" "\r" translated))
    
43.               
    
44.               ;; 解码JSON转义
    
45.               (setq translated (vl-string-translate "\\\"" "\"" translated))
    
46.               (setq translated (vl-string-translate "\\\\" "\\" translated))
    
47.               (setq translated (vl-string-translate "\\/" "/" translated))
    
48.               (setq translated (vl-string-translate "\\b" "\b" translated))
    
49.               (setq translated (vl-string-translate "\\f" "\f" translated))
    
50.               (setq translated (vl-string-translate "\\n" "\n" translated))
    
51.               (setq translated (vl-string-translate "\\r" "\r" translated))
    
52.               (setq translated (vl-string-translate "\\t" "\t" translated))
    
53.               
    
54.               ;; 清理空白字符
    
55.               (setq translated (vl-string-trim " \t\n\r" translated))
    
56.               
    
57.               ;; 如果结果包含 %% 且不是正常的百分号，可能是解析问题
    
58.               (if (and (vl-string-search "%%" translated)
    
59.                        (not (vl-string-search "%" word)))  ;; 原文本没有%
    
60.                 (progn
    
61.                   ;; 尝试修复可能的解析错误
    
62.                   (setq translated (vl-string-subst "%" "%%" translated))
    
63.                 )
    
64.               )
    
65.               
    
66.               translated
    
67.             )
    
68.             word  ;; 没有找到结束引号
    
69.           )
    
70.         )
    
71.         word  ;; 没有找到翻译文本
    
72.       )
    
73.     )
    
74.     word  ;; 结果无效
    
75.   )
    
76. )
    
77. 
    
78. 
    
79. ;; 主命令函数
    
80. (defun c:TTR (/ ss n e dt txt oldtxt newtxt)
    
81.   (setvar "cmdecho" 0)
    
82.   (princ "\n选择要翻译的文本对象: ")
    
83.   
    
84.   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    
85.     (progn
    
86.       (setq n 0)
    
87.       (repeat (sslength ss)
    
88.         (setq e (ssname ss n)
    
89.               n (1+ n)
    
90.               dt (entget e)
    
91.               oldtxt (cdr (assoc 1 dt))
    
92.         )
    
93.         
    
94.         (princ (strcat "\n翻译: \"" oldtxt "\""))
    
95.         
    
96.         ;; 调用翻译函数
    
97.         (setq newtxt (fy oldtxt))
    
98.         
    
99.         (if (and newtxt (not (equal newtxt oldtxt)))
    
100.           (progn
     
101.             (entmod (subst (cons 1 newtxt) (assoc 1 dt) dt))
     
102.             (princ (strcat " -> \"" newtxt "\""))
     
103.           )
     
104.           (princ " [翻译失败或未改变]")
     
105.         )
     
106.       )
     
107.     )
     
108.   )
     
109.   (princ)
     
110. )
     
111. 
     
112. ;; 测试命令
     
113. (defun c:TEST ()
     
114.   (princ (fy "你好世界"))
     
115.   (princ)
     
116. )
     
117. 
     

;; 使用MyMemory API的完整代码<br /> (defun getxml (url / xml http)<br />   (if (setq http (vlax-create-object "WinHTTP.WinHTTPRequest.5.1"))<br />     (progn<br />       (vlax-invoke-method http "open" "GET" url :vlax-false)<br />       (vlax-invoke-method http "send")<br />       (vlax-invoke-method http "WaitForResponse" 5)<br />       (setq xml (vlax-get-property http "ResponseText"))<br />       (vlax-release-object http)<br />       xml<br />     )<br />   )<br /> )<br /> (defun fy (word / url result start end str translated)<br />   ;; 构建请求URL<br />   (setq url (strcat <br />     "https://api.mymemory.translated.net/get"<br />     "?q=" (vl-string-translate " " "%20" word)<br />     "&langpair=zh|en"<br />     "&de=" "your-email@example.com"  ;; 可选，提高免费额度<br />   ))<br />   <br />   ;; 获取结果<br />   (setq result (getxml url))<br />   <br />   (if (and result (> (strlen result) 10))<br />     (progn<br />       ;; 查找翻译结果<br />       (setq start (vl-string-search "\"translatedText\":\"" result))<br />       (if start<br />         (progn<br />           (setq str (substr result (+ start 19)))<br />           (setq end1 (vl-string-search "\"" str))<br />           (if end1<br />             (progn<br />               (setq translated (substr str 1 end1))<br />               <br />               ;; 解码URL编码<br />               (setq translated (vl-string-translate "%20" " " translated))<br />               (setq translated (vl-string-translate "%25" "%" translated))<br />               (setq translated (vl-string-translate "%0A" "\n" translated))<br />               (setq translated (vl-string-translate "%0D" "\r" translated))<br />               <br />               ;; 解码JSON转义<br />               (setq translated (vl-string-translate "\\\"" "\"" translated))<br />               (setq translated (vl-string-translate "\\\\" "\\" translated))<br />               (setq translated (vl-string-translate "\\/" "/" translated))<br />               (setq translated (vl-string-translate "\\b" "\b" translated))<br />               (setq translated (vl-string-translate "\\f" "\f" translated))<br />               (setq translated (vl-string-translate "\\n" "\n" translated))<br />               (setq translated (vl-string-translate "\\r" "\r" translated))<br />               (setq translated (vl-string-translate "\\t" "\t" translated))<br />               <br />               ;; 清理空白字符<br />               (setq translated (vl-string-trim " \t\n\r" translated))<br />               <br />               ;; 如果结果包含 %% 且不是正常的百分号，可能是解析问题<br />               (if (and (vl-string-search "%%" translated)<br />                        (not (vl-string-search "%" word)))  ;; 原文本没有%<br />                 (progn<br />                   ;; 尝试修复可能的解析错误<br />                   (setq translated (vl-string-subst "%" "%%" translated))<br />                 )<br />               )<br />               <br />               translated<br />             )<br />             word  ;; 没有找到结束引号<br />           )<br />         )<br />         word  ;; 没有找到翻译文本<br />       )<br />     )<br />     word  ;; 结果无效<br />   )<br /> )<br /> <br /> <br /> ;; 主命令函数<br /> (defun c:TTR (/ ss n e dt txt oldtxt newtxt)<br />   (setvar "cmdecho" 0)<br />   (princ "\n选择要翻译的文本对象: ")<br />   <br />   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))<br />     (progn<br />       (setq n 0)<br />       (repeat (sslength ss)<br />         (setq e (ssname ss n)<br />               n (1+ n)<br />               dt (entget e)<br />               oldtxt (cdr (assoc 1 dt))<br />         )<br />         <br />         (princ (strcat "\n翻译: \"" oldtxt "\""))<br />         <br />         ;; 调用翻译函数<br />         (setq newtxt (fy oldtxt))<br />         <br />         (if (and newtxt (not (equal newtxt oldtxt)))<br />           (progn<br />             (entmod (subst (cons 1 newtxt) (assoc 1 dt) dt))<br />             (princ (strcat " -> \"" newtxt "\""))<br />           )<br />           (princ " [翻译失败或未改变]")<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;; 测试命令<br /> (defun c:TEST ()<br />   (princ (fy "你好世界"))<br />   (princ)<br /> )<br /> <br /> <blockquote>

kozmosovia 发表于 2025-12-25 20:56
CAD内创建一个临时文本再获取内容，CAD会自动转码Unicode字符的。
这个免费翻译接口，不过英语翻译为汉语没有研究出来
长老牛逼，我ai搞半天没有解决的问题，你这几行代码解决了。

kozmosovia

不需要那么长的代码，JavaScript搞定
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=193178

qifeifei

很有办法 学会了

jun353835273

"\"u4f60\"u597d\"u554a"这个转汉字呢

kozmosovia

jun353835273 发表于 2025-12-25 20:42
"\"u4f60\"u597d\"u554a"这个转汉字呢

CAD内创建一个临时文本再获取内容，CAD会自动转码Unicode字符的。

2. (setq txt "123\U+4f60999\U+597dzzz\U+554a")
   
3. (entmake (list (cons 0 "text") (cons 1 txt) (list 10 0 0 0) (cons 40 1)))
   
4. (princ (cdr (assoc 1 (entget (entlast)))))
   
5. (entdel (entlast))

(setq txt "123\U+4f60999\U+597dzzz\U+554a")<br /> (entmake (list (cons 0 "text") (cons 1 txt) (list 10 0 0 0) (cons 40 1)))<br /> (princ (cdr (assoc 1 (entget (entlast)))))<br /> (entdel (entlast))

jun353835273

(princ "123\U+4f60999\U+597dzzz\U+554a") 123你999好zzz啊

tryhi

jun353835273 发表于 2025-12-25 20:42
"\"u4f60\"u597d\"u554a"这个转汉字呢

(defun T-string-subst (old new str / n)
  (setq n (- (strlen new)))
    (while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))
      (setq str (vl-string-subst new old str n))
    )
  str
)
(setq translated "\"u4f60\"u597d\"u4e16\"u754c")
(setq a (T-string-subst "\"u" "\\U+" translated))
        b(read (strcat "\""a"\""))
)
;;->"你好世界"

jun353835273

tryhi 发表于 2025-12-26 10:16
(defun T-string-subst (old new str / n)
  (setq n (- (strlen new)))
    (while (setq n (vl-strin ...

"\U+4f60\U+597d\U+4e16\U+754c"
_$ B
"\U+4f60\U+597d\U+4e16\U+754c"
_$ 编辑器状态还是这个编码，还是得输出才行