明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 303|回复: 3

[源码] LISP非递归深度遍历文件夹查找文件

[复制链接]
发表于 2024-7-10 10:13 | 显示全部楼层 |阅读模式
见过一些递归的查找文件,我来一个非递归的,我想不到递归怎么写,代码如下:

  1. (defun $lie-chu-mu-lu-xia-suo-you-wen-jian$
  2.        (lst / fs-all ns wjs kzm f wj a)
  3.           ;列出目录下所有文件,含子级目录,所有目录下的文件
  4.   ;($lie-chu-mu-lu-xia-suo-you-wen-jian$  (list(cons "目录" "C:")(cons "扩展名" "*.dwg")))
  5.   (or (and lst
  6.      (= (type lst) 'list)
  7.      (setq kzm (cdr (assoc "扩展名" lst)))
  8.      (> (strlen kzm) 0)
  9.      (wcmatch kzm "[,`*.*,]")
  10.       )
  11.       (setq kzm "*.*")
  12.   )
  13.   (or (and lst
  14.      (= (type lst) 'list)
  15.      (setq f (cdr (assoc "目录" lst)))
  16.       )
  17.       (and lst (= (type lst) 'str) (setq f lst))
  18.   )
  19.   (and
  20. ;;;    (PROGN
  21. ;;;     (NOT  (OR (and f (wcmatch f "[A-Z]:"))
  22. ;;;        (and f (wcmatch f "[a-z]:"))
  23. ;;;    )
  24. ;;;     )        ;注释这里允许遍历整个磁盘
  25. ;;;    )
  26.     (progn
  27.       (while (and f (wcmatch f "*`\\*"))
  28.   (setq f (vl-string-subst "/" "\\" f))
  29.       )
  30.       (setq fs-all nil)
  31.       (setq fs-all (cons f fs-all))
  32.       (setq fs (vl-directory-files f "*.*" -1))
  33.       (setq fs (vl-remove ".." fs))
  34.       (setq fs (vl-remove "." fs))
  35.       (setq fs (mapcar (function (lambda (a) (strcat f "/" a))) fs))
  36.       (setq fs-all (APPEND fs-all fs))
  37.       (while (AND fs (setq f (car fs)) (< (LENGTH fs-all) 10000));文件夹超过十万就不继续遍历了
  38.   (setq ns nil)
  39.   (setq ns (vl-directory-files f "*.*" -1))
  40.   (setq ns (vl-remove ".." ns))
  41.   (setq ns (vl-remove "." ns))
  42.   (setq ns (mapcar (function (lambda (a / n)
  43.              (strcat f "/" a)
  44.            )
  45.        )
  46.        ns
  47.      )
  48.   )
  49.   (SETQ fs-all (APPEND fs-all NS))
  50.   (setq fs (append fs ns))
  51.   (setq fs (cdr fs))
  52.       )
  53.     )
  54.   )
  55.   (setq wjs nil)
  56.   (while (setq a (car fs-all))
  57.     (setq wj nil)
  58.     (setq wj (vl-directory-files a kzm 1))
  59.     (setq wj (vl-remove ".." wj))
  60.     (setq wj (vl-remove "." wj))
  61.     (setq wj (mapcar (function (lambda (b) (strcat a "/" b))) wj))
  62.     (setq wjs (cons wj wjs))
  63.     (setq fs-all (cdr fs-all))
  64.   )
  65.   (setq wjs (vl-remove nil wjs))
  66.   wjs
  67. )

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2024-7-10 11:33 | 显示全部楼层
不错,不错。学习到了。要是可以选择包含“某些字符”就更好了。
发表于 2024-7-10 12:56 | 显示全部楼层
thanks for sharing ... learning
发表于 2024-7-10 19:42 | 显示全部楼层
感谢杜总的分享!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-7-13 05:51 , Processed in 0.220802 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表