zark 发表于 2011-4-12 16:39:36

【求助】列出给定目录中的所有文件，包含二级三级N级目录【在线等急！谢谢】

VLISP 有个函数vl-directory-files       列出给定目录中的所有文件这个函数只列出当前目录下的文件，如果存在下一级目录就不支持了想了好久还是解决不了多级目录的问题在线请教高手高高手提供点思想或者现成的LISP在此不甚感激！！！

Andyhon 发表于 2011-4-12 17:41:42

is this help
http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/searching-a-directory-tree/m-p/1875326

yxl88168 发表于 2011-4-12 18:21:11

我有一个软件有那个功能，但没有lsp的，要的话和我联系

zark 发表于 2011-4-12 19:01:24

回复 Andyhon 的帖子

谢谢谢谢，这正是我需要的，好好学习，再好好研究，谢谢，感觉有你

highflybird 发表于 2011-4-13 00:02:44

本帖最后由 highflybird 于 2011-4-13 12:15 编辑

关于遍历文件夹的问题，其实我已经在我的ActiveX和脚本技术的那个帖子中讲到了，用的是Shell.application方法。
http://bbs.mjtd.com/thread-85042-1-1.html

这里我再给出一种API方法，速度相当快。需要DynamicWrapper 的支持。
另外我的帖子《CAD垃圾文件清理工具》中也用到了这样的方法。
http://bbs.mjtd.com/thread-85033-1-5.html

;;;测试程序------------------------------------------------------------
(defun c:test(/ DIRPATH HWND LST *PATH *SHELL)
(setq hwnd (vla-get-hwnd (vlax-get-acad-object)))
(setq *shell (vlax-create-object "Shell.Application"))
(setq *path(vlax-invoke *shell 'BrowseForFolder 0 "请选择一个文件夹" 4471))
(if (setq DIrPath (vlax-get (vlax-get *path 'self) 'path))
    (setq lst (ForeachFolder DirPath))
)
(vlax-release-object *path)
(vlax-release-object *shell)
(princ)
)
;;;搜索程序-------------------------------------------------------------
(defun ForeachFolder(path / DWX buffer fLst fSize NumDir SINFO SNUMD SNUMF TIME)
(setq DWX (vlax-create-object "DynamicWrapperX"))   ;创建DynamicWrapperX
;; File find operation
(vlax-invoke DWX 'Register "KERNEL32" "FindFirstFileW" "i=wp" "r=l")
(vlax-invoke DWX 'Register "KERNEL32" "FindNextFileW" "i=lp" "r=l")
(vlax-invoke DWX 'Register "KERNEL32" "FindClose" "i=l" "r=l")
(vlax-invoke DWX 'Register "SHLWAPI" "PathFileExistsW" "i=w" "r=l")
;; memory
(vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
(vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
(vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
;; search get started
(if (/= (vlax-invoke DWX 'PathFileExistsW path) 0)   ;如果目录名有效
    (progn
      (setq FLst nil)       ;文件名列表
      (setq fSize 0.)       ;文件总大小
      (setq NumDir 1)       ;目录总数，加上开始部分目录
      (setq time (getvar "TDUSRTIMER"))   ;开始计时
      (setq buffer (vlax-invoke DWX 'calloc 1 592))    ;为文件搜索数据开辟缓冲区
      (if (/= (substr path (strlen path)) "\\")
      (setq path (strcat path "\\"))
      )
      (Search path)
      (vlax-invoke DWX 'free buffer)   ;释放缓冲区
      (setq time(rtos (* (- (getvar "TDUSRTIMER") time) 86400))) ;结束计时
      (setq time(strcat "\n搜索时间: " time " 秒."))
      (setq sNumF (strcat "找到: " (itoa (length FLst)) " 个文件. "))
      (setq sNumD (strcat (itoa NumDir) " 个目录."))
      (setq fSize (/ fSize 1048576))
      (setq fSize (strcat "总大小: " (rtos fSize) " M."))
      (setq sInfo (strcat Time sNumF sNumD fSize))   ;统计信息
      (princ sInfo)
      (and DWX (vlax-release-object DWX))    ;释放DynamicWrapperX
      (setq FLst (reverse FLst))
    )
)         
)
;;;搜索符合过滤条件的文件-----------------------------------------------
;;;FLST,FSIZE,NumDir,buffer are global varialbes------------------------
(defun Search (Folder / DLst H Cont fName att lSize hSize)
(setq H (vlax-invoke DWX 'FindFirstFileW (strcat Folder "*") buffer)) ;找第一个文件的句柄
(if (/= H -1)      ;如果找到了
    (progn               
      (while (/= Cont 0)         ;开始重复下面的步骤
(setq fName (vlax-invoke DWX 'StrGet (+ buffer 44)));获取文件名
(if (and (/= fName ".") (/= fName ".."))   ;不能是.和..(根目录，子目录)两个特殊的目录名
   (progn
   (setq att (vlax-invoke DWX 'NumGet buffer))   ;文件的属性
   (if (= (logand att 16) 0)   ;符合这样的是文件名，在这里你可以加入自己的检查
       (progn
(setq hSize (vlax-invoke DWX 'NumGet buffer 28)) ;高字节为超过4G的文件尺寸
         (setq lSize (vlax-invoke DWX 'NumGet buffer 32)) ;低字节为小于4G的文件尺寸
(setq fName (strcat Folder fName))   ;则把路径也连起来
(setq FLst (cons fName FLst))    ;加入文件表
(if (= hSize 0)
    (setq fSize (+ lSize fSize))    ;小于4G的文件
    (setq fSize (+ lSize (* hSize 4294967296) fSize)) ;大于4G的文件
)
       )
       (progn
(setq fName (strcat Folder fName "\\"))   ;后面加上\
         (setq DLst (cons fName DLst))
(setq NumDir (1+ NumDir))    ;目录计数加1
       )
   )
   )
)
(setq Cont (vlax-invoke DWX 'FindNextFileW H buffer));查找下一个
      )
      (setq Cont (vlax-invoke DWX 'FindClose H))   ;查找关闭
    )
)      
(foreach Dir (reverse DLst)      ;如果要递归查找
    (Search Dir)
)
)




啵浪鼓 发表于 2011-4-13 00:26:46

楼上的为何执行后:
命令: test ; 错误: 参数类型错误: VLA-OBJECT nil

highflybird 发表于 2011-4-13 07:28:56

回复 啵浪鼓 的帖子

我已经说明了，需要DynamicWrapperX的支持。


这两个文件随便下载一个就可以了，只要注册一下就行。

zark 发表于 2011-4-13 08:07:07

回复 highflybird 的帖子

谢谢~！
(defun TreeSearch (root pattern / Recurse Result)
(defun Recurse (root pattern / Files Directories)
    (setq Files              (mapcar '(lambda (x) (strcat root "\\" x))
                              (vl-directory-files root pattern 1)
                      )
          Directories (mapcar '(lambda (x) (strcat root "\\" x))
                              (vl-remove-if
                                '(lambda (x) (member x '("." "..")))
                                (vl-directory-files root nil -1)
                              )
                      )
    )
    (foreach file Files (setq Result (cons (strcase file) Result)))
    (foreach directory Directories (Recurse directory pattern))
)
(Recurse root pattern)
Result
)

zml84 发表于 2011-4-27 13:06:49

http://zml84.blog.sohu.com/161181681.html

yyszpp 发表于 2011-6-3 23:57:56

回复 highflybird 的帖子

又是你，，，顶坚决顶 ，，看见你头像我就兴奋，，，，谢谢 这个也是我要找的，，，
页: [1]
查看完整版本: 【求助】列出给定目录中的所有文件，包含二级三级N级目录【在线等急！谢谢】