[原创]：珍贵的编程学习资料－超级搜索令a版 源码

雨箭风刀

这个是本人参考了论坛上的帖子，结合自己的理解和需求，重新编写的超级搜索令a版的源码，现拿出来给大家切磋。因为是测试性质，所以重点没有考虑编程的效率及程序的“好看”上。
在此感谢论坛上常常发出金子光芒般智慧的编程爱好者们。
超级搜索令的b版，重新写了内核，速度超快,提速几十上百倍，不是吹的。效果可参
http://www.xdcad.net/forum/showt ... amp;threadid=553068
不多说，自己看吧。涉及多方编程技巧：自动写dcl文件，调用windows文件选择对话框，。。。。

两个命令可以调用：
xfindf 搜索目录下找到的第一个文件，没有返回nil
xfindall 搜索目录下找到的所有符合通配符的文件。返回列表对话框，可执行相应操作。

dhxf

运行命令XFINDALL
更感兴趣的是(xdcl-create-xfindf)
可以不编写DCL;
很帅的程序

biechen

不能下载！
浪费了很多爱心～痛啊

zxyz

请问a、b版有什么区别

eachy

2. 
   
3. ;;**************************************FindFilePath*********************************
   
4. ;;Author:   Michael Kolomiyets
   
5. ;;Function: Finds full path of any file in hard drive.
   
6. ;Usage:    (FindFilePath "filename.ext")
   
7. ;;Examlpe:  Run on command prompt: (FindFilePath "acad.exe")
   
8. ;;Return:   "C:\\Program Files\\AutoCAD 2000i\\acad.exe"
   
9. ;;Note:     Does not search network drives
   
10. 
    
11. (vl-load-com)
    
12. (defun FindFilePath (InputFile           /                 PCDrives
    
13.                      PCDrive           PCDriveChoice PCDriveLetter
    
14.                      PCFolder           PCFolderPath         i
    
15.                     )
    
16.   (if (/= (vl-string-trim " " InputFile) "")
    
17.     (progn
    
18.       (setq ReturnFolder nil)
    
19.       (setq ContProc T)
    
20.       (setq FlSysObj (vlax-create-object "scripting.filesystemobject"))
    
21.       (setq PCDrives (vlax-get-property FlSysObj 'Drives))
    
22.       (vlax-for        PCDrive        PCDrives
    
23.         (setq PCDriveChoice (vlax-get-property PCDrive 'DriveLetter))
    
24.         (if (/= PCDriveChoice "A")
    
25.           (setq PCDriveLetter (cons PCDriveChoice PCDriveLetter))
    
26.         )                                ;if
    
27.       )                                        ;vlax
    
28.       (setq i 0)
    
29.       (while (and (<= i (1- (length PCDriveLetter))) ContProc)
    
30.         (setq PCDrive (vlax-get-property
    
31.                         PCDrives
    
32.                         'Item
    
33.                         (nth i PCDriveLetter)
    
34.                       )
    
35.         )
    
36.         (if (and
    
37.               (= (vlax-get-property PCDrive 'DriveType) 2)
    
38.               (= (vlax-get-property PCDrive 'IsReady) :vlax-true)
    
39.             )                                ;and
    
40.           (progn
    
41.             (setq PCFolder (vlax-get-property PCDrive 'RootFolder))
    
42.             (setq PCFolderPath (vlax-get-property PCFolder 'Path))
    
43.             (MainProc InputFile PCFolderPath)
    
44.           )                                ;progn
    
45.         )                                ;if
    
46.         (setq i (1+ i))
    
47.       )                                        ;while
    
48.       ReturnFolder
    
49.     )                                        ;progn
    
50.   )                                        ;if
    
51. )                                        ;defun
    
52. 
    
53. (defun MainProc        (SearchFile         SearchFolder         /
    
54.                  PCFolder         PCSubFolders         PCLoopFolder
    
55.                  PCFolderPath         FullPath
    
56.                 )
    
57.   (if (/= (substr SearchFolder (strlen SearchFolder) 1) "\")
    
58.     (setq SearchFolder (strcat SearchFolder "\"))
    
59.   )                                        ;if
    
60.   (setq FullPath (strcat SearchFolder SearchFile))
    
61.   (if (= (vlax-invoke-method FlSysObj 'FileExists FullPath)
    
62.          :vlax-true
    
63.       )
    
64.     (progn
    
65.       (setq ReturnFolder FullPath)
    
66.       (setq ContProc nil)
    
67.     )                                        ;progn
    
68.     (progn
    
69.       (if
    
70.         (not (vl-catch-all-error-p
    
71.                (setq PCFolder (vl-catch-all-apply
    
72.                                 'vlax-invoke-method
    
73.                                 (list FlSysObj 'GetFolder SearchFolder)
    
74.                               )
    
75.                )
    
76.              )
    
77.         )
    
78.          (progn
    
79.            (setq PCSubFolders (vlax-get-property PCFolder 'SubFolders))
    
80.            (vlax-for PCLoopFolder PCSubFolders
    
81.              (if ContProc
    
82.                (progn
    
83.                  (setq PCFolderPath
    
84.                         (vlax-get-property PCLoopFolder 'Path)
    
85.                  )
    
86.                  (MainProc SearchFile PCFolderPath)
    
87.                )                        ;progn
    
88.              )                                ;if
    
89.            )                                ;vlax
    
90.          )                                ;progn
    
91.       )                                        ;if
    
92.     )                                        ;progn
    
93.   )                                        ;if
    
94. )                                        ;defun
    
95. 
    

<br /> ;;**************************************FindFilePath*********************************<br /> ;;Author:   Michael Kolomiyets<br /> ;;Function: Finds full path of any file in hard drive.<br /> ;Usage:    (FindFilePath "filename.ext")<br /> ;;Examlpe:  Run on command prompt: (FindFilePath "acad.exe")<br /> ;;Return:   "C:\\Program Files\\AutoCAD 2000i\\acad.exe"<br /> ;;Note:     Does not search network drives<br /> <br /> (vl-load-com)<br /> (defun FindFilePath (InputFile           /                 PCDrives<br />                      PCDrive           PCDriveChoice PCDriveLetter<br />                      PCFolder           PCFolderPath         i<br />                     )<br />   (if (/= (vl-string-trim " " InputFile) "")<br />     (progn<br />       (setq ReturnFolder nil)<br />       (setq ContProc T)<br />       (setq FlSysObj (vlax-create-object "scripting.filesystemobject"))<br />       (setq PCDrives (vlax-get-property FlSysObj 'Drives))<br />       (vlax-for        PCDrive        PCDrives<br />         (setq PCDriveChoice (vlax-get-property PCDrive 'DriveLetter))<br />         (if (/= PCDriveChoice "A")<br />           (setq PCDriveLetter (cons PCDriveChoice PCDriveLetter))<br />         )                                ;if<br />       )                                        ;vlax<br />       (setq i 0)<br />       (while (and (<= i (1- (length PCDriveLetter))) ContProc)<br />         (setq PCDrive (vlax-get-property<br />                         PCDrives<br />                         'Item<br />                         (nth i PCDriveLetter)<br />                       )<br />         )<br />         (if (and<br />               (= (vlax-get-property PCDrive 'DriveType) 2)<br />               (= (vlax-get-property PCDrive 'IsReady) :vlax-true)<br />             )                                ;and<br />           (progn<br />             (setq PCFolder (vlax-get-property PCDrive 'RootFolder))<br />             (setq PCFolderPath (vlax-get-property PCFolder 'Path))<br />             (MainProc InputFile PCFolderPath)<br />           )                                ;progn<br />         )                                ;if<br />         (setq i (1+ i))<br />       )                                        ;while<br />       ReturnFolder<br />     )                                        ;progn<br />   )                                        ;if<br /> )                                        ;defun<br /> <br /> (defun MainProc        (SearchFile         SearchFolder         /<br />                  PCFolder         PCSubFolders         PCLoopFolder<br />                  PCFolderPath         FullPath<br />                 )<br />   (if (/= (substr SearchFolder (strlen SearchFolder) 1) "\")<br />     (setq SearchFolder (strcat SearchFolder "\"))<br />   )                                        ;if<br />   (setq FullPath (strcat SearchFolder SearchFile))<br />   (if (= (vlax-invoke-method FlSysObj 'FileExists FullPath)<br />          :vlax-true<br />       )<br />     (progn<br />       (setq ReturnFolder FullPath)<br />       (setq ContProc nil)<br />     )                                        ;progn<br />     (progn<br />       (if<br />         (not (vl-catch-all-error-p<br />                (setq PCFolder (vl-catch-all-apply<br />                                 'vlax-invoke-method<br />                                 (list FlSysObj 'GetFolder SearchFolder)<br />                               )<br />                )<br />              )<br />         )<br />          (progn<br />            (setq PCSubFolders (vlax-get-property PCFolder 'SubFolders))<br />            (vlax-for PCLoopFolder PCSubFolders<br />              (if ContProc<br />                (progn<br />                  (setq PCFolderPath<br />                         (vlax-get-property PCLoopFolder 'Path)<br />                  )<br />                  (MainProc SearchFile PCFolderPath)<br />                )                        ;progn<br />              )                                ;if<br />            )                                ;vlax<br />          )                                ;progn<br />       )                                        ;if<br />     )                                        ;progn<br />   )                                        ;if<br /> )                                        ;defun<br /> <br />