非递归法列出目录下所有文件

dcl1214 · 发表于 2021-5-11 23:28:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun $lie-chu-mu-lu-xia-suo-you-wen-jian$ (lst / fs-all ns wjs kzm f)
;列出目录下所有文件，含子级目录，所有目录下的文件
;;; ($lie-chu-mu-lu-xia-suo-you-wen-jian$
;;; (list
;;; (cons
;;; "目录"
;;; "C:\\uploads"
;;; )
;;; (cons "扩展名" "*.dwg")
;;; )
;;; )
(or (and lst
(= (type lst) 'list)
(setq kzm (cdr (assoc "扩展名" lst)))
(> (strlen kzm)0)
(wcmatch kzm "[,`*.*,]")
)
(setq kzm "*.*")
)
(or (and lst
(= (type lst) 'list)
(setq f (cdr (assoc "目录" lst)))
)
(and lst (= (type lst) 'str) (setq f lst))
)
(if (and
(and f (findfile f))
(NOT (OR (and f (wcmatch f "[A-Z]:"))
(and f (wcmatch f "[a-z]:"))
)
) ;不允许整个磁盘扫描
)
(progn
(while (and f (wcmatch f "*`\\*"))
(setq f (vl-string-subst "/" "\\" f))
)
(setq fs-all nil)
(setq fs-all (cons f fs-all))
(setq fs (vl-directory-files f "*.*" -1))
(setq fs (vl-remove ".." fs))
(setq fs (vl-remove "." fs))
(setq fs (mapcar (function (lambda (a) (strcat f "/" a))) fs))
(setq fs-all (APPEND fs-all fs))
(while (AND fs (setq f (car fs)) (< (LENGTH fs-all) 10000))
(setq ns nil)
(setq ns (vl-directory-files f "*.*" -1))
(setq ns (vl-remove ".." ns))
(setq ns (vl-remove "." ns))
(setq ns (mapcar (function (lambda (a / n)
(setq n (strcat f "/" a))
(set 'fs-all (cons n fs-all))
n
)
)
ns
)
)
(setq fs (append fs ns))
(setq fs (cdr fs))
)
)
)
(setq wjs nil)
(mapcar (function
(lambda (a / wj)
(setq wj (vl-directory-files a kzm 1))
(setq wj (vl-remove ".." wj))
(setq wj (vl-remove "." wj))
(setq wj (mapcar (function (lambda (b) (strcat a "/" b))) wj))
(set 'wjs (append wjs wj))
)
)
fs-all
)
wjs
)

(defun $lie-chu-mu-lu-xia-suo-you-wen-jian$ (lst / fs-all ns wjs kzm f) 
  ;列出目录下所有文件，含子级目录，所有目录下的文件 
;;;  ($lie-chu-mu-lu-xia-suo-you-wen-jian$ 
;;;    (list 
;;;      (cons 
;;;  "目录" 
;;;  "C:\\uploads" 
;;;      ) 
;;;      (cons "扩展名" "*.dwg") 
;;;    ) 
;;;  ) 
   (or (and lst 
     (= (type lst) 'list) 
     (setq kzm (cdr (assoc "扩展名" lst))) 
     (> (strlen kzm)0) 
     (wcmatch kzm "[,`*.*,]") 
      ) 
      (setq kzm "*.*") 
  ) 
  (or (and lst 
     (= (type lst) 'list) 
     (setq f (cdr (assoc "目录" lst))) 
      ) 
      (and lst (= (type lst) 'str) (setq f lst)) 
  ) 
  (if (and 
  (and f (findfile f)) 
  (NOT (OR (and f (wcmatch f "[A-Z]:")) 
     (and f (wcmatch f "[a-z]:")) 
       ) 
  )        ;不允许整个磁盘扫描 
      ) 
    (progn 
      (while (and f (wcmatch f "*`\\*")) 
  (setq f (vl-string-subst "/" "\\" f)) 
      ) 
      (setq fs-all nil) 
      (setq fs-all (cons f fs-all)) 
      (setq fs (vl-directory-files f "*.*" -1)) 
      (setq fs (vl-remove ".." fs)) 
      (setq fs (vl-remove "." fs)) 
      (setq fs (mapcar (function (lambda (a) (strcat f "/" a))) fs)) 
      (setq fs-all (APPEND fs-all fs)) 
      (while (AND fs (setq f (car fs)) (< (LENGTH fs-all) 10000)) 
  (setq ns nil) 
  (setq ns (vl-directory-files f "*.*" -1)) 
  (setq ns (vl-remove ".." ns)) 
  (setq ns (vl-remove "." ns)) 
  (setq ns (mapcar (function (lambda (a / n) 
             (setq n (strcat f "/" a)) 
             (set 'fs-all (cons n fs-all)) 
             n 
           ) 
       ) 
       ns 
     ) 
  ) 
  (setq fs (append fs ns)) 
  (setq fs (cdr fs)) 
      ) 
    ) 
  ) 
  (setq wjs nil) 
  (mapcar (function 
      (lambda (a / wj) 
        (setq wj (vl-directory-files a kzm 1)) 
        (setq wj (vl-remove ".." wj)) 
        (setq wj (vl-remove "." wj)) 
        (setq wj (mapcar (function (lambda (b) (strcat a "/" b))) wj)) 
        (set 'wjs (append wjs wj)) 
      ) 
    ) 
    fs-all 
  ) 
  wjs 
)

hh_lj007 · 发表于 2021-5-12 08:28:45

感谢分享！

huangpc27 · 发表于 2021-5-12 08:36:34

试试看怎么样

红糖∠※豆浆 · 发表于 2021-5-12 10:15:21

学习一下感觉不错

SHUNDocker · 发表于 2021-5-12 10:31:24

感谢楼主分享学习！！！

aisong220 · 发表于 2021-5-13 00:01:37

janshyl · 发表于 2021-5-14 08:03:15

學習了感謝樓主的分享

红糖∠※豆浆 · 发表于 2021-5-24 13:18:40

楼主能上个演示

账号		自动登录	找回密码
密码			立即注册

[源码] 非递归法列出目录下所有文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。