[LISP函数]：几个Scripting.FileSystemObject应用函数

hqd9639

2. 
   
3.   [FONT=courier new]
   
4. 1.  查找指定目录特定文件列表
   
5.    ;;;(FindFiles_lst "c:\\hqd9639" "*`.dwg")
   
6.   (defun findfiles_lst (dir Pattern / FILSYS pattern folderobj Files result)
   
7.     (vl-load-com)
   
8.     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
   
9.     (if (/= (vlax-invoke-method FILSYS "FolderExists" dir) :vlax-false)
   
10.         (progn
    
11.            (setq pattern (strcase pattern))
    
12.            (setq folderobj (vlax-invoke-method FILSYS "GetFolder" dir))
    
13.            (setq Files (vlax-get-property folderobj "Files"))
    
14.            (vlax-for file files
    
15.                  (if (wcmatch (strcase (vla-get-name file)) pattern)
    
16.                      (setq result (cons (vla-get-path file) result))
    
17.                  )
    
18.                  (vlax-release-object file)
    
19.            )
    
20.            (vlax-release-object files)
    
21.            (vlax-release-object folderobj)
    
22.            (vlax-release-object FILSYS)
    
23.            result
    
24.         )
    
25.         (progn
    
26.            (vlax-release-object FILSYS)
    
27.            nil
    
28.         )
    
29.     )
    
30.   )
    
31.   ;;;
    
32. 2. 用VLISP重命名文件夹
    
33.   ;;;(ren_folder "c:\\hqd9639" "hqd")
    
34.   (defun ren_folder (oldfolder newname / FILSYS folderobj)
    
35.     (vl-load-com)
    
36.     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
    
37.     (if (/= (vlax-invoke-method FILSYS "FolderExists" oldfolder) :vlax-false)
    
38.         (progn
    
39.             (setq folderobj (vlax-invoke-method FILSYS "GetFolder" oldfolder))
    
40.             (if (/= (vla-get-Name folderobj) newname)
    
41.                 (progn
    
42.                    (vla-put-Name folderobj newname)
    
43.                    T
    
44.                 )
    
45.                 nil
    
46.             )
    
47.         )
    
48.         nil
    
49.     )
    
50.   )
    
51. ;;;
    
52. 
    
53. 3.   用VLISP获取硬盘系列号
    
54.   ;;;(GET_DRIVE_SN "c")
    
55.   (defun get_drive_sn (drive / FILSYS driveobj)
    
56.     (vl-load-com)
    
57.     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
    
58.     (if (/= (vlax-invoke-method FILSYS "DriveExists" drive) :vlax-false)
    
59.         (progn
    
60.            (setq driveobj (vlax-invoke-method FILSYS "GetDrive" drive))
    
61.            (vlax-get-property driveobj "SerialNumber")
    
62.         )
    
63.         nil
    
64.     )
    
65.   )
    
66.   [/FONT]
    

<br />   [FONT=courier new]<br /> 1.  查找指定目录特定文件列表<br />    ;;;(FindFiles_lst "c:\\hqd9639" "*`.dwg")<br />   (defun findfiles_lst (dir Pattern / FILSYS pattern folderobj Files result)<br />     (vl-load-com)<br />     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))<br />     (if (/= (vlax-invoke-method FILSYS "FolderExists" dir) :vlax-false)<br />         (progn<br />            (setq pattern (strcase pattern))<br />            (setq folderobj (vlax-invoke-method FILSYS "GetFolder" dir))<br />            (setq Files (vlax-get-property folderobj "Files"))<br />            (vlax-for file files<br />                  (if (wcmatch (strcase (vla-get-name file)) pattern)<br />                      (setq result (cons (vla-get-path file) result))<br />                  )<br />                  (vlax-release-object file)<br />            )<br />            (vlax-release-object files)<br />            (vlax-release-object folderobj)<br />            (vlax-release-object FILSYS)<br />            result<br />         )<br />         (progn <br />            (vlax-release-object FILSYS)<br />            nil<br />         )<br />     )<br />   )<br />   ;;;<br /> 2. 用VLISP重命名文件夹<br />   ;;;(ren_folder "c:\\hqd9639" "hqd")<br />   (defun ren_folder (oldfolder newname / FILSYS folderobj)<br />     (vl-load-com)<br />     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))<br />     (if (/= (vlax-invoke-method FILSYS "FolderExists" oldfolder) :vlax-false)<br />         (progn<br />             (setq folderobj (vlax-invoke-method FILSYS "GetFolder" oldfolder))<br />             (if (/= (vla-get-Name folderobj) newname)<br />                 (progn<br />                    (vla-put-Name folderobj newname)<br />                    T<br />                 )<br />                 nil <br />             )<br />         )<br />         nil<br />     )<br />   )<br /> ;;;<br /> <br /> 3.   用VLISP获取硬盘系列号<br />   ;;;(GET_DRIVE_SN "c")<br />   (defun get_drive_sn (drive / FILSYS driveobj)<br />     (vl-load-com)<br />     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))<br />     (if (/= (vlax-invoke-method FILSYS "DriveExists" drive) :vlax-false)<br />         (progn<br />            (setq driveobj (vlax-invoke-method FILSYS "GetDrive" drive))<br />            (vlax-get-property driveobj "SerialNumber")<br />         )<br />         nil<br />     )<br />   )<br />   [/FONT]<br />

aeo

http://www.xdcad.net/forum/showt ... d=668699#post668699

看第一个站.

playboy

斑竹为什么我把程序拿回去调试的时候总是提示 “错误: 参数太少”呢
用VLISP获取硬盘系列号这个东西很有用可以用来作加密程序。
我以前只知道可以取到mac地址可是mac可以改
难道还有人能够吧用硬盘系列号也改掉吗

tuger

获取序列号的好像以前龙龙仔写过。结果和doslib的两样的是数字的

playboy

这个东东我还没有调试好，请大家帮帮忙好吗