[原创]列出给定路径下所有路径名(包含子目录)或者文件名(包含子目录)

xshrimp · 发表于 2008-3-7 22:42:00

;-------------------------------------------------------------------------------
; Program Name: directory.lsp
; Created By: xshrimp (Email: )
;             (URL: )
; Date Created: 3-7-08
; Function: 列出给定路径下所有路径名(包含子目录)或者文件名(包含子目录)
;-------------------------------------------------------------------------------
;|函数类似vl-directory-files
语法
(gps->directory-files  directory pattern directories)
功能
列出给定路径下所有路径名(包含子目录)或者文件名(包含子目录)
说明
  1)参数 directory 为字符串，指定要收集文件的目录。
若未指定该参数或参数为 nil，那么gps->directory-files 使用当前目录。
  2)参数 pattern 为字符串，包含文件名的 DOS 方式。
如果未指定该参数或参数为 nil，gps->directory-files 假定为 "*.*"。
  3)directories 为整数型，指定返回的表中是否包含路径名。可以指定下列值之一：
-1 仅列出目录。
   0 列出文件和目录（缺省值）。
   1 仅列出文件。
返回值：
文件和路径列表。若没有符合指定方式的文件，则返回 nil。
;测试
(gps->directory-files "D:\\xx" nil  1)
(gps->directory-files "D:\\Downloads" "*.exe" 1)

copy


(defun gps->directory-files  (directory pattern directories / allpathlst gps->get-path lst n pathlst x y)
(if (null pattern)     (setq pattern "*.*"))
(if (null directories) (setq directories 0))
;返回目录下的所有子目录
;(gps->get-allpath "E:\\Program Files")
;(gps->get-allpath "f:\\tu")
(defun gps->get-allpath(directory pattern / allpathlst lst n pathlst x gps->get-path)
(if (= (type directory) 'STR)
(progn
(setq directory (vl-string-right-trim  "\\/ " directory))
(setq allpathlst (list directory))
(defun gps->get-path (directory / lst n pathlst x)
(if (and (setq lst (vl-directory-files directory nil -1));仅目录 
         (setq lst (vl-remove-if '(lambda (x) (or (= "." x)(= ".." x))) lst))  
     ) 
      (progn
       (setq pathlst (mapcar '(lambda(x)(strcat directory "" x) )  lst))
       (setq allpathlst (append allpathlst pathlst))
       (foreach n pathlst (gps->get-path n ))             
      ) 
);end if
)
(gps->get-path directory)
allpathlst
))
)
;返回目录下的所有目录及子目录的文件
;(gps->get-allfile directory pattern)
;(gps->get-allfile "D:\\Downloads" "*.exe")
(defun gps->get-allfile(directory pattern / x y)
(apply
  'append
  (mapcar
    '(lambda (x)
       (mapcar
  '(lambda (y)
     (strcat x "" y)
   )
  (vl-directory-files x pattern 1);仅仅文件
       )
     )
    (gps->get-allpath directory pattern)
  )
)
)
(cond 
((= -1 directories) (if (= pattern "*.*")(gps->get-allpath directory pattern)));仅列出目录
((=  0 directories)
(if (/= pattern "*.*")
     (gps->get-allfile directory pattern)
     
      (apply
 'append
 (list
   (gps->get-allpath directory pattern)
   (gps->get-allfile directory pattern)
 )
      )
      
 )
)
((=  1 directories) (gps->get-allfile directory pattern));仅列出文件
)
)