[原创.源码]让strlen跟substr支持中文汉字等双字节文字

tryhi

大家都知道，由于汉字是双字节字符，所以用strlen跟subst的时候一个汉字当成两个字符计算，有时候我们想要按常规做法(像excel的left公式一样)来处理，这时就容易出错，所以写个子函数来调用

2. ;;例子(try-substr "数1数456" 2 3) => "1数4"
   
3. ;;截取字符串，仿substr，但是支持中文
   
4. ;;参数3 nil表示后面全部保留
   
5. (defun try-substr(str start len / lst)
   
6.     (setq lst ( _Str2List str))
   
7.     (setq lst (try-lst-move-head lst (1- start)))
   
8.     (if (not len)nil(setq lst (try-lst-read-head lst len)))
   
9.     (apply 'strcat lst)
   
10. )
    
11. ;;例子(try-strlen "数一数123") => 6
    
12. ;;返回一个字符串中的字符数量（支持中文）
    
13. (defun try-strlen(str / i strx)
    
14.     (setq i 0)
    
15.     (setq strx(vl-string->list str))
    
16.     (if (not(= str ""))
    
17.         (while
    
18.             (if(<(car strx)129)
    
19.                 (setq i (1+ i) strx(cdr strx))
    
20.                 (setq i (1+ i) strx(cddr strx))
    
21.             )
    
22.         )
    
23.     )
    
24.     i
    
25. )

;;例子(try-substr "数1数456" 2 3) => "1数4"<br /> ;;截取字符串，仿substr，但是支持中文<br /> ;;参数3 nil表示后面全部保留<br /> (defun try-substr(str start len / lst)<br />     (setq lst ( _Str2List str))<br />     (setq lst (try-lst-move-head lst (1- start)))<br />     (if (not len)nil(setq lst (try-lst-read-head lst len)))<br />     (apply 'strcat lst)<br /> )<br /> ;;例子(try-strlen "数一数123") => 6<br /> ;;返回一个字符串中的字符数量（支持中文）<br /> (defun try-strlen(str / i strx)<br />     (setq i 0)<br />     (setq strx(vl-string->list str))<br />     (if (not(= str ""))<br />         (while<br />             (if(<(car strx)129)<br />                 (setq i (1+ i) strx(cdr strx))<br />                 (setq i (1+ i) strx(cddr strx))<br />             )<br />         )<br />     )<br />     i<br /> )

2. 
   
3. ;;字符串拆分为单一的表(支持单双字节混合)
   
4. (defun _Str2List(str / a);注：引用73的函数
   
5.   (setq str(vl-string->list str))
   
6.   (while
   
7.         (if(<(car str)129)
   
8.             (setq a(cons(chr(car str))a)str(cdr str))
   
9.             (setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
   
10.   (reverse a)
    
11. )
    
12. 
    
13. (defun try-lst-move-head (lst i)
    
14.   (if (<= i 0)lst
    
15.         (repeat i (setq lst (cdr lst))))
    
16. )
    
17. (defun try-lst-read-head(lst i / lstt)
    
18.   (if (<= i 0)lst
    
19.         (progn
    
20.             (setq lstt '())
    
21.             (repeat i
    
22.                 (setq lstt (cons (car lst) lstt))
    
23.                 (setq lst(cdr lst))
    
24.             )
    
25.             (reverse lstt)
    
26.             
    
27.         )
    
28.   )
    
29. )

<br /> ;;字符串拆分为单一的表(支持单双字节混合)<br /> (defun _Str2List(str / a);注：引用73的函数<br />   (setq str(vl-string->list str))<br />   (while <br />         (if(<(car str)129)<br />             (setq a(cons(chr(car str))a)str(cdr str))<br />             (setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))<br />   (reverse a)<br /> )<br /> <br /> (defun try-lst-move-head (lst i) <br />   (if (<= i 0)lst <br />         (repeat i (setq lst (cdr lst))))<br /> )<br /> (defun try-lst-read-head(lst i / lstt)<br />   (if (<= i 0)lst <br />         (progn<br />             (setq lstt '())<br />             (repeat i<br />                 (setq lstt (cons (car lst) lstt))<br />                 (setq lst(cdr lst))<br />             )<br />             (reverse lstt)<br />             <br />         )<br />   )<br /> )

llsheng_73

1. (defun Str2lst(a / c)
   
2.   (setq a(vl-string->list a))
   
3.   (while(if(<(car a)129)
   
4.           (setq c(cons(chr(car a))c)a(cdr a))
   
5.           (setq c(cons(strcat(chr(car a))(chr(cadr a)))c)a(cddr a))))
   
6.   (reverse c))
   
7. (defun CharsOfStr(a)(length(Str2lst a)));;字符串中的字符个数，双字节字符与单字节字符均计为一个字符
   
8. (defun Substrs(a s l / i)
   
9.   (mapcar'set'(l i)(list(if l(+ s l -1)(strlen a))0))
   
10.   (apply'strcat(vl-remove-if-not'(lambda(x)(<= s(setq i(1+ i))l))(Str2lst a))))

(defun Str2lst(a / c)<br />   (setq a(vl-string->list a))<br />   (while(if(<(car a)129)<br />           (setq c(cons(chr(car a))c)a(cdr a))<br />           (setq c(cons(strcat(chr(car a))(chr(cadr a)))c)a(cddr a))))<br />   (reverse c))<br /> (defun CharsOfStr(a)(length(Str2lst a)));;字符串中的字符个数，双字节字符与单字节字符均计为一个字符<br /> (defun Substrs(a s l / i)<br />   (mapcar'set'(l i)(list(if l(+ s l -1)(strlen a))0))<br />   (apply'strcat(vl-remove-if-not'(lambda(x)(<= s(setq i(1+ i))l))(Str2lst a))))

先前对长度的处理有问题，谢谢各位指出

yoyoho

感谢 tryhi 分享程序!

czcxxx

感谢 tryhi 分享程序!

伪书虫86

不错，赞一个

mj0000

llsheng_73 发表于 2015-10-9 10:43

Substrs返回的位置和长度都不对

llsheng_73

mj0000 发表于 2015-10-9 13:40
Substrs返回的位置和长度都不对

这个和CAD系统的算法有点不一样的是，只要是字符都按一个计算的，不管是否双字节字符。。。。跟楼主的一样，虽然我也觉得这样自成一套有点不太好

ivde

不要纠结这，alisp一直就是char，计算机先有，宽字符是都要用计算机结果

tryhi

llsheng_73 发表于 2015-10-9 10:43

代码很简洁
可惜好像有点问题
(Substrs "1234567890" 4 2); => ""
这句返回空值


(try-Substr "1234567890" 4 2);=> "45"
我的返回是的"45
(Substr "1234567890" 4 2);=> "45"
系统函数也是"45"

tryhi

llsheng_73    不知道保留双字节字符长度为2这个习惯好些还是计为1更好

因为我接触过的，不管BAT也好，其他脚本也好，office也好，双字节字符的处理都是按一个处理的，所以就我习惯而言，是没必要保留了