另类高速历遍指定目录下所有子目录[调用系统tree命令]
本帖最后由 tryhi 于 2016-3-27 18:36 编辑在历遍目录下所有子目录的大部分方法，对于多层大数量的情况一般耗时都非常长，我通过调用CMD下的tree命令来读取，可以极大的提高速度，虽然代码繁琐，但是速度却提高了5倍以上，我历遍了自己的整个C盘只耗时7秒左右
(defun try-tree(pathx / data ff file m m0 n nn path path-lst tem tou tou1 tou2 zhan)
(setq file (vl-filename-mktemp "try.txt"));临时文件名
(command "SHELL"(strcat "tree " "\"" pathx "\" >"file "&echo shop>>"file));生成文件
(while (/= (_read_last file) "shop"));等待文件生成成功
(setq ff (open file "R");读取文件
data (read-line ff);读取第一行
tem(substr data 1 2);取得第一个字符
)
(while (/= tem "├");判断是否到了真正开始的位置
(setq data (read-line ff)tem(substr data 1 2))
)
(setq
m0 -1;原始级数为-1，第一个目录为0
path-lst'();存放最终结果
zhan(list "");栈，修改此处可以加上目录前缀
)
(while data
(setq tou(try-StringSplit data "├─"));分隔
(if (= (length tou)1) (setq tou(try-StringSplit data "└─")));
(if (> (length tou)1)
(progn
(setq tou1(try-StringReplace (car tou) "|" "");把目录前面的|替换成两个空格
tou2 (strcat (cadr tou) "\\"));把目录加上\
(setq n(strlen tou1);目录前面的空格数量
m(/ n 4);空格数量除以4=m级数
)
(setq path
(cond
((= m m0);跟上一个目录同级
(setq zhan(cons tou2 (cdr zhan)));删掉栈的第一个后把目录入栈
(apply 'strcat (reverse zhan));把栈合并成一个字符串
)
((> m m0);级数大于上一个目录
(setq zhan(cons tou2 zhan);把目录入栈
m0 m);修改m0的级别
(apply 'strcat (reverse zhan));合并栈
)
((< m m0);级数小于上一个目录
(setq nn(- m0 m -1)
zhan(try-lst-move-head zhan nn);删掉栈的前n+1个
zhan(cons tou2 zhan);把目录入栈
m0 m);修改m0的级别
(apply 'strcat (reverse zhan));合并栈
)
))
(setq path-lst(cons path path-lst));目录入表
)
)
(setq data (read-line ff));读取下一行
)
(close ff)
(reverse path-lst)
)
;;读取文件的最后一行
(defun _read_last(file / data ff la)
(setq ff (open file "R"))
(if ff
(progn(while (setq data (read-line ff))
(setq la data)
)
(close ff))
)
la
)
(defun try-StringSplit(str char / a b i )
(if (= "" char)(_Str2List str)
(progn
(while (setq i(vl-string-search char str))
(setq a(substr str 1 i)
b(cons a b)
str(substr str (+ i (strlen char)1)))
)
(reverse(cons str b))
)
)
)
(defun _Str2List(str / a);注：引用73的函数
(setq str(vl-string->list str))
(while
(if(<(car str)129)
(setq a(cons(chr(car str))a)str(cdr str))
(setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
(reverse a)
)
(defun _Str2List(str / a);注：引用73的函数
(setq str(vl-string->list str))
(while
(if(<(car str)129)
(setq a(cons(chr(car str))a)str(cdr str))
(setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
(reverse a)
)
(defun try-lst-move-head (lst i)
(if (<= i 0)lst
(repeat i (setq lst (cdr lst))))
)
(defun try-StringReplace(str a b)
(if(and(setq 论坛抽风这句代码发不出(= 'str (type str)))
(apply'and(mapcar'(lambda(x)(=(type x)'str))(setq a(if(=(type a)'list)a(list a)))))
(apply'and(mapcar'(lambda(x)(=(type x)'str))(setq b(if(=(type b)'list)b(mapcar'(lambda(x)b)a))))))
(setq str(_strsplit str a nil)
str(apply'strcat(mapcar'strcat(car str)(mapcar'(lambda(x)(if(=""x)x(nth(vl-position x a)b)))(last str)))))
str))
(setq lst-path(try-tree "C:\\"))
注：代码跟附件的内容是一样的，不过附件多了一点点注释，不知道为什么，发源码一直提示非法参数，然后我试着把注释删掉一下，就通过了 回帖是一种美德！感谢楼主的无私分享 谢谢
回帖是一种美德！感谢楼主的无私分享 谢谢 感谢楼主的无私分享 谢谢 函数呢?_strsplit 感谢楼主的无私奉献！好好研究和学习，谢谢！ wzg356 发表于 2016-3-21 20:04 static/image/common/back.gif
函数呢?_strsplit
不好意思，缺了一个LLSheng_73的函数，主贴已经更新;;超级字符串分割
;;用一个表对字符串进行分割，返回两个表
;;表1：分割后的字符串表
;;表2：被分割的字符串表
;(_STRSPLIT "12+34分隔35-454,22,33-45" '("+""-""*"","";"" ""=""分隔") nil)
;==>(("12" "34" "35" "454" "22" "33" "45") ("+" "分隔" "-" "," "," "-" ""))
(defun _strsplit(str splits f / i a b l );;BY：LLSheng_73
(if f(setq str(vl-list->string(vl-remove 32(vl-string->list str)))))
(while(<""str)
(if(vl-remove'nil(mapcar'(lambda(x)(vl-string-search x str))splits))
(setq i(car(vl-sort(vl-remove'nil(mapcar'(lambda(x)(if(setq l(vl-string-search x str))(cons l x)))splits))
'(lambda(s1 s2)(<(car s1)(car s2)))))
a(cons(substr str 1(car i))a)b(cons(cdr i)b)
str(substr str(+(car i)(strlen(cdr i))1)))
(setq a(cons str a)b(cons "" b)str"")))
(list(reverse a)(reverse b))) TRY-STRINGREPLACE
函数呢? crtrccrt 发表于 2016-3-26 07:49 static/image/common/back.gif
TRY-STRINGREPLACE
函数呢?
论坛抽风，这个函数发不了，最后没办法改了下源码 支持一下 看看 这个看看好用不
页:
[1]
2