另类高速历遍指定目录下所有子目录[调用系统tree命令]

tryhi

在历遍目录下所有子目录的大部分方法，对于多层大数量的情况一般耗时都非常长，我通过调用CMD下的tree命令来读取，可以极大的提高速度，虽然代码繁琐，但是速度却提高了5倍以上，我历遍了自己的整个C盘只耗时7秒左右

2. (defun try-tree(pathx / data ff file m m0 n nn path path-lst tem tou tou1 tou2 zhan)
   
3.   (setq file (vl-filename-mktemp "try.txt"));临时文件名
   
4.   (command "SHELL"  (strcat "tree " """ pathx "" >"file "&echo shop>>"file));生成文件
   
5.   (while (/= (_read_last file) "shop"));等待文件生成成功
   
6.   (setq ff (open file "R");读取文件
   
7.     data (read-line ff);读取第一行
   
8.     tem(substr data 1 2);取得第一个字符
   
9.   )
   
10.   (while (/= tem "├");判断是否到了真正开始的位置
    
11.     (setq data (read-line ff)tem(substr data 1 2))
    
12.   )
    
13.   (setq
    
14.     m0 -1;原始级数为-1，第一个目录为0
    
15.     path-lst'();存放最终结果
    
16.     zhan(list "");栈，修改此处可以加上目录前缀
    
17.   )
    
18.   (while data
    
19.     (setq tou(try-StringSplit data "├─"));分隔
    
20.     (if (= (length tou)1) (setq tou(try-StringSplit data "└─")));
    
21.     (if (> (length tou)1)
    
22.       (progn
    
23.         (setq tou1(try-StringReplace (car tou) "|" "  ");把目录前面的|替换成两个空格
    
24.           tou2 (strcat (cadr tou) "\"));把目录加上\
    
25.         (setq n(strlen tou1);目录前面的空格数量
    
26.           m(/ n 4);空格数量除以4=m级数
    
27.         )
    
28.         (setq path
    
29.           (cond
    
30.             ((= m m0);跟上一个目录同级
    
31.               (setq zhan(cons tou2 (cdr zhan)));删掉栈的第一个后把目录入栈
    
32.               (apply 'strcat (reverse zhan));把栈合并成一个字符串
    
33.             )
    
34.             ((> m m0);级数大于上一个目录
    
35.               (setq zhan(cons tou2 zhan);把目录入栈
    
36.                 m0 m);修改m0的级别
    
37.               (apply 'strcat (reverse zhan));合并栈
    
38.             )
    
39.             ((< m m0);级数小于上一个目录
    
40.               (setq nn(- m0 m -1)
    
41.               zhan(try-lst-move-head zhan nn);删掉栈的前n+1个
    
42.               zhan(cons tou2 zhan);把目录入栈
    
43.               m0 m);修改m0的级别
    
44.               (apply 'strcat (reverse zhan));合并栈
    
45.             )
    
46.           ))
    
47.         (setq path-lst(cons path path-lst));目录入表
    
48.       )
    
49.     )
    
50.     (setq data (read-line ff));读取下一行
    
51.   )
    
52.   (close ff)
    
53.   (reverse path-lst)
    
54. )
    
55. ;;读取文件的最后一行
    
56. (defun _read_last(file / data ff la)
    
57.         (setq ff (open file "R"))
    
58.         (if ff
    
59.                 (progn(while (setq data (read-line ff))
    
60.                                                 (setq la data)
    
61.                                         )
    
62.                         (close ff))
    
63.         )
    
64.         la
    
65. )
    
66. (defun try-StringSplit(str char / a b i )
    
67.         (if (= "" char)(_Str2List str)
    
68.                 (progn
    
69.                         (while (setq i(vl-string-search char str))
    
70.                                 (setq a(substr str 1 i)
    
71.                                         b(cons a b)
    
72.                                         str(substr str (+ i (strlen char)1)))
    
73.                         )
    
74.                         (reverse(cons str b))
    
75.                 )
    
76.         )
    
77. )
    
78. (defun _Str2List(str / a);注：引用73的函数
    
79.   (setq str(vl-string->list str))
    
80.   (while
    
81.                 (if(<(car str)129)
    
82.                         (setq a(cons(chr(car str))a)str(cdr str))
    
83.                         (setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
    
84.   (reverse a)
    
85. )
    
86. (defun _Str2List(str / a);注：引用73的函数
    
87.   (setq str(vl-string->list str))
    
88.   (while
    
89.                 (if(<(car str)129)
    
90.                         (setq a(cons(chr(car str))a)str(cdr str))
    
91.                         (setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
    
92.   (reverse a)
    
93. )
    
94. (defun try-lst-move-head (lst i)
    
95.     (if (<= i 0)lst
    
96.         (repeat i (setq lst (cdr lst))))
    
97. )
    
98. (defun try-StringReplace(str a b)
    
99.   (if(and(setq 论坛抽风这句代码发不出(= 'str (type str)))
    
100.              (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq a(if(=(type a)'list)a(list a)))))
     
101.              (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq b(if(=(type b)'list)b(mapcar'(lambda(x)b)a))))))
     
102.     (setq str(_strsplit str a nil)
     
103.             str(apply'strcat(mapcar'strcat(car str)(mapcar'(lambda(x)(if(=""x)x(nth(vl-position x a)b)))(last str)))))
     
104.     str))
     
105. 
     
106. (setq lst-path(try-tree "C:\"))
     
107. 
     

(defun try-tree(pathx / data ff file m m0 n nn path path-lst tem tou tou1 tou2 zhan)<br />   (setq file (vl-filename-mktemp "try.txt"));临时文件名<br />   (command "SHELL"  (strcat "tree " """ pathx "" >"file "&echo shop>>"file));生成文件<br />   (while (/= (_read_last file) "shop"));等待文件生成成功<br />   (setq ff (open file "R");读取文件<br />     data (read-line ff);读取第一行<br />     tem(substr data 1 2);取得第一个字符<br />   )<br />   (while (/= tem "├");判断是否到了真正开始的位置<br />     (setq data (read-line ff)tem(substr data 1 2))<br />   )<br />   (setq<br />     m0 -1;原始级数为-1，第一个目录为0<br />     path-lst'();存放最终结果<br />     zhan(list "");栈，修改此处可以加上目录前缀<br />   )<br />   (while data<br />     (setq tou(try-StringSplit data "├─"));分隔<br />     (if (= (length tou)1) (setq tou(try-StringSplit data "└─")));<br />     (if (> (length tou)1)<br />       (progn<br />         (setq tou1(try-StringReplace (car tou) "|" "  ");把目录前面的|替换成两个空格<br />           tou2 (strcat (cadr tou) "\"));把目录加上\<br />         (setq n(strlen tou1);目录前面的空格数量<br />           m(/ n 4);空格数量除以4=m级数<br />         )<br />         (setq path<br />           (cond <br />             ((= m m0);跟上一个目录同级<br />               (setq zhan(cons tou2 (cdr zhan)));删掉栈的第一个后把目录入栈<br />               (apply 'strcat (reverse zhan));把栈合并成一个字符串<br />             )<br />             ((> m m0);级数大于上一个目录<br />               (setq zhan(cons tou2 zhan);把目录入栈<br />                 m0 m);修改m0的级别<br />               (apply 'strcat (reverse zhan));合并栈<br />             )<br />             ((< m m0);级数小于上一个目录<br />               (setq nn(- m0 m -1)<br />               zhan(try-lst-move-head zhan nn);删掉栈的前n+1个<br />               zhan(cons tou2 zhan);把目录入栈<br />               m0 m);修改m0的级别<br />               (apply 'strcat (reverse zhan));合并栈<br />             )<br />           ))<br />         (setq path-lst(cons path path-lst));目录入表<br />       )<br />     )<br />     (setq data (read-line ff));读取下一行<br />   )<br />   (close ff)<br />   (reverse path-lst)<br /> )<br /> ;;读取文件的最后一行<br /> (defun _read_last(file / data ff la)<br />         (setq ff (open file "R"))<br />         (if ff<br />                 (progn(while (setq data (read-line ff))<br />                                                 (setq la data)<br />                                         )<br />                         (close ff))<br />         )<br />         la<br /> )<br /> (defun try-StringSplit(str char / a b i )<br />         (if (= "" char)(_Str2List str)<br />                 (progn<br />                         (while (setq i(vl-string-search char str))<br />                                 (setq a(substr str 1 i)<br />                                         b(cons a b)<br />                                         str(substr str (+ i (strlen char)1)))<br />                         )<br />                         (reverse(cons str b))<br />                 )<br />         )<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 /> (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 /> (defun try-lst-move-head (lst i) <br />     (if (<= i 0)lst <br />         (repeat i (setq lst (cdr lst))))<br /> )<br /> (defun try-StringReplace(str a b)<br />   (if(and(setq 论坛抽风这句代码发不出(= 'str (type str)))<br />              (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq a(if(=(type a)'list)a(list a)))))<br />              (apply'and(mapcar'(lambda(x)(=(type x)'str))(setq b(if(=(type b)'list)b(mapcar'(lambda(x)b)a))))))<br />     (setq str(_strsplit str a nil)<br />             str(apply'strcat(mapcar'strcat(car str)(mapcar'(lambda(x)(if(=""x)x(nth(vl-position x a)b)))(last str)))))<br />     str))<br /> <br /> (setq lst-path(try-tree "C:\"))<br /> <br />

注：代码跟附件的内容是一样的，不过附件多了一点点注释，不知道为什么，发源码一直提示非法参数，然后我试着把注释删掉一下，就通过了

ou67169488

回帖是一种美德！感谢楼主的无私分享 谢谢

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

pengfei2010

感谢楼主的无私分享 谢谢

wzg356

函数呢?_strsplit

shh1980

感谢楼主的无私奉献！好好研究和学习，谢谢！来自: Android客户端

tryhi

wzg356 发表于 2016-3-21 20:04
函数呢?_strsplit

不好意思，缺了一个LLSheng_73的函数，主贴已经更新

2. ;;超级字符串分割
   
3. ;;用一个表对字符串进行分割，返回两个表
   
4. ;;表1：分割后的字符串表
   
5. ;;表2：被分割的字符串表
   
6. ;(_STRSPLIT "12+34分隔35-454,22,33-45" '("+""-""*"","";"" ""=""分隔") nil)
   
7. ;==>(("12" "34" "35" "454" "22" "33" "45") ("+" "分隔" "-" "," "," "-" ""))
   
8. (defun _strsplit(str splits f / i a b l );;BY：LLSheng_73
   
9.   (if f(setq str(vl-list->string(vl-remove 32(vl-string->list str)))))
   
10.   (while(<""str)
    
11.     (if(vl-remove'nil(mapcar'(lambda(x)(vl-string-search x str))splits))
    
12.       (setq i(car(vl-sort(vl-remove'nil(mapcar'(lambda(x)(if(setq l(vl-string-search x str))(cons l x)))splits))
    
13.                                                                          '(lambda(s1 s2)(<(car s1)(car s2)))))
    
14.                                 a(cons(substr str 1(car i))a)b(cons(cdr i)b)
    
15.                                 str(substr str(+(car i)(strlen(cdr i))1)))
    
16.       (setq a(cons str a)b(cons "" b)str"")))
    
17.   (list(reverse a)(reverse b)))

;;超级字符串分割<br /> ;;用一个表对字符串进行分割，返回两个表<br /> ;;表1：分割后的字符串表<br /> ;;表2：被分割的字符串表<br /> ;(_STRSPLIT "12+34分隔35-454,22,33-45" '("+""-""*"","";"" ""=""分隔") nil)<br /> ;==>(("12" "34" "35" "454" "22" "33" "45") ("+" "分隔" "-" "," "," "-" ""))<br /> (defun _strsplit(str splits f / i a b l );;BY：LLSheng_73<br />   (if f(setq str(vl-list->string(vl-remove 32(vl-string->list str)))))<br />   (while(<""str)<br />     (if(vl-remove'nil(mapcar'(lambda(x)(vl-string-search x str))splits))<br />       (setq i(car(vl-sort(vl-remove'nil(mapcar'(lambda(x)(if(setq l(vl-string-search x str))(cons l x)))splits))<br />                                                                          '(lambda(s1 s2)(<(car s1)(car s2)))))<br />                                 a(cons(substr str 1(car i))a)b(cons(cdr i)b)<br />                                 str(substr str(+(car i)(strlen(cdr i))1)))<br />       (setq a(cons str a)b(cons "" b)str"")))<br />   (list(reverse a)(reverse b)))

crtrccrt

TRY-STRINGREPLACE
函数呢?

tryhi

crtrccrt 发表于 2016-3-26 07:49
TRY-STRINGREPLACE
函数呢?

论坛抽风，这个函数发不了，最后没办法改了下源码

aihuyujian

支持一下 看看

水仙的错

这个看看好用不