URL编码转换URLencode_CAD中文技术交流网

URL编码转换URLencode

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

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

帮一个网友写的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 于 2025-12-25 17:22 编辑

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

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

收集的

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

网友答: 很有办法学会了

上一篇：没有了

下一篇：没有了