用循环法，删除指定目录下某类型文件

自贡黄明儒

;;用循环法，删除指定目录下某类型文件

1. (defun GetFullPath (path)
   
2.   (if (wcmatch path "*\\")
   
3.     path
   
4.     (strcat path "\\")
   
5.   )
   
6. )
   
7. 
   
8. (defun C:a2d (/ A DIR DIRL F LST X)
   
9.   (if (not **Initdir**)
   
10.     (setq **Initdir** "D:\\")
    
11.   )
    
12.   ;;(setq LST (list (GetFolder3 "浏览文件夹" "包括子文件夹" **Initdir**)))
    
13.   (setq LST (list "D:\\0000\\"));本示例删除D:\\0000\\下所有指定类型文件文件，包括子目录
    
14.   (foreach filter '("*.dwg" "*.pdf" "*.tif" "*.jpg" "*.exb" "*.doc" "*.xlsx" "*.docx")
    
15.     (setq dirL LST)
    
16.     (while (setq dir (car dirL))
    
17.       (setq dirL (cdr dirL))
    
18.       (setq f (vl-directory-files dir filter 1))
    
19.       (setq f
    
20.        (mapcar '(lambda (x)
    
21.       (strcat (getfullpath dir) x)
    
22.           )
    
23.          f
    
24.        )
    
25.       )
    
26.       (vl-every 'vl-file-delete f)  ;此句可改为处理文件
    
27. 
    
28.       (setq a nil)
    
29.       (setq a (vl-remove-if
    
30.     '(lambda (subdir)
    
31.        (member subdir '("." ".."))
    
32.      )
    
33.     (vl-directory-files dir nil -1)
    
34.         )
    
35.       )
    
36.       (setq a (mapcar (function (lambda (x) (strcat dir x "\\"))) a))
    
37.       (setq dirL (append dirL a))
    
38.     )
    
39.   )
    
40.   (princ)
    
41. )

(defun GetFullPath (path)<br />   (if (wcmatch path "*\\")<br />     path<br />     (strcat path "\\")<br />   )<br /> )<br /> <br /> (defun C:a2d (/ A DIR DIRL F LST X)<br />   (if (not **Initdir**)<br />     (setq **Initdir** "D:\\")<br />   )<br />   ;;(setq LST (list (GetFolder3 "浏览文件夹" "包括子文件夹" **Initdir**)))<br />   (setq LST (list "D:\\0000\\"));本示例删除D:\\0000\\下所有指定类型文件文件，包括子目录<br />   (foreach filter '("*.dwg" "*.pdf" "*.tif" "*.jpg" "*.exb" "*.doc" "*.xlsx" "*.docx")<br />     (setq dirL LST)<br />     (while (setq dir (car dirL))<br />       (setq dirL (cdr dirL))<br />       (setq f (vl-directory-files dir filter 1))<br />       (setq f<br />        (mapcar '(lambda (x)<br />       (strcat (getfullpath dir) x)<br />           )<br />          f<br />        )<br />       )<br />       (vl-every 'vl-file-delete f)  ;此句可改为处理文件<br /> <br />       (setq a nil)<br />       (setq a (vl-remove-if<br />     '(lambda (subdir)<br />        (member subdir '("." ".."))<br />      )<br />     (vl-directory-files dir nil -1)<br />         )<br />       )<br />       (setq a (mapcar (function (lambda (x) (strcat dir x "\\"))) a))<br />       (setq dirL (append dirL a))<br />     )<br />   )<br />   (princ)<br /> )

guosheyang

感谢黄大师共享！

xj6019

感谢黄大师共享！

sunny_8848

可惜删除不了只读文件

czb203

感谢黄大师共享！

sunny_8848

谢谢分享，可惜不会结合修改