|
- (defun $lie-chu-mu-lu-xia-suo-you-wen-jian$
- (lst / fs-all ns wjs kzm f wj a)
- ;列出目录下所有文件,含子级目录,所有目录下的文件
- ;($lie-chu-mu-lu-xia-suo-you-wen-jian$ (list(cons "目录" "C:")(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))
- )
- (and
- ;;; (PROGN
- ;;; (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)
- (strcat f "/" a)
- )
- )
- ns
- )
- )
- (SETQ fs-all (APPEND fs-all NS))
- (setq fs (append fs ns))
- (setq fs (cdr fs))
- )
- )
- )
- (setq wjs nil)
- (while (setq a (car fs-all))
- (setq wj nil)
- (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))
- (setq wjs (cons wj wjs))
- (setq fs-all (cdr fs-all))
- )
- (setq wjs (vl-remove nil wjs))
- wjs
- )
复制代码 |
|