马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
![](source/plugin/imc_colorcode/images/loading.gif) - (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
- )
|