[转贴]：Which Drives are Available?

eachy

Which Drives are Available?

From time to time you might want your AutoLISP application to be able to write to a specific drive or drives in a specific order if you are working with a group of users that might do some travelling.  If you want to test to see which drives are available through AutoLISP, you could use the function vl-directory-files.  This would force you to test each letter combination which can take time and it doesn't tell you if the drive is ready or not.  Below is an example using the FSO object to get all the available drives on the machine, and test to see what type of drive it is and if it is ready or not.

2. 
   
3. ;; Begin Code
   
4. (defun GetDrives (/ wshFSO driveObjs)
   
5.   (vl-load-com)
   
6.   (if (= wshLibImport nil)
   
7.     (progn
   
8.       (vlax-import-type-library
   
9.         :tlb-filename                 "c:\\windows\\system32\\wshom.ocx"
   
10.         :methods-prefix                 "wshm-"
    
11.         :properties-prefix         "wshp-"
    
12.         :constants-prefix         "wshk-"
    
13.        )
    
14.       (setq wshLibImport T)
    
15.     )
    
16.   )
    
17.   (setq wshFSO (vlax-create-object "Scripting.FileSystemObject"))
    
18.   (setq driveObjs (wshp-get-Drives wshFSO))
    
19.   (vlax-for driveObj driveObjs
    
20.     (progn
    
21.       (prompt (strcat "\nDrive Letter: "
    
22.                       (vlax-get-property driveObj 'DriveLetter)
    
23.               )
    
24.       )
    
25.       (prompt "\nDrive Type: ")
    
26.       (cond
    
27.         ((= (vlax-get-property driveObj 'DriveLetter) wshk-CDRom)
    
28.          (prompt "CDROM")
    
29.         )
    
30.         ((= (vlax-get-property driveObj 'DriveLetter) wshk-RamDisk)
    
31.          (prompt "Ram Disk")
    
32.         )
    
33.         ((= (vlax-get-property driveObj 'DriveLetter) wshk-Fixed)
    
34.          (prompt "Fixed")
    
35.         )
    
36.         ((= (vlax-get-property driveObj 'DriveLetter) wshk-Removable)
    
37.          (prompt "Removeable")
    
38.         )
    
39.         ((= (vlax-get-property driveObj 'DriveLetter)
    
40.             wshk-UnknownType
    
41.          )
    
42.          (prompt "Unknown")
    
43.         )
    
44.       )
    
45.       (prompt (strcat "\nIs Ready: "))
    
46.       (if (= (vlax-get-property driveObj 'IsReady) :vlax-true)
    
47.         (prompt "True")
    
48.         (prompt "False")
    
49.       )
    
50.     )
    
51.   )
    
52.   (princ)
    
53. )
    
54. ;; End Code

<br /> ;; Begin Code<br /> (defun GetDrives (/ wshFSO driveObjs)<br />   (vl-load-com)<br />   (if (= wshLibImport nil)<br />     (progn<br />       (vlax-import-type-library<br />         :tlb-filename                 "c:\\windows\\system32\\wshom.ocx"<br />         :methods-prefix                 "wshm-"<br />         :properties-prefix         "wshp-"<br />         :constants-prefix         "wshk-"<br />        )<br />       (setq wshLibImport T)<br />     )<br />   )<br />   (setq wshFSO (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq driveObjs (wshp-get-Drives wshFSO))<br />   (vlax-for driveObj driveObjs<br />     (progn<br />       (prompt (strcat "\nDrive Letter: "<br />                       (vlax-get-property driveObj 'DriveLetter)<br />               )<br />       )<br />       (prompt "\nDrive Type: ")<br />       (cond<br />         ((= (vlax-get-property driveObj 'DriveLetter) wshk-CDRom)<br />          (prompt "CDROM")<br />         )<br />         ((= (vlax-get-property driveObj 'DriveLetter) wshk-RamDisk)<br />          (prompt "Ram Disk")<br />         )<br />         ((= (vlax-get-property driveObj 'DriveLetter) wshk-Fixed)<br />          (prompt "Fixed")<br />         )<br />         ((= (vlax-get-property driveObj 'DriveLetter) wshk-Removable)<br />          (prompt "Removeable")<br />         )<br />         ((= (vlax-get-property driveObj 'DriveLetter)<br />             wshk-UnknownType<br />          )<br />          (prompt "Unknown")<br />         )<br />       )<br />       (prompt (strcat "\nIs Ready: "))<br />       (if (= (vlax-get-property driveObj 'IsReady) :vlax-true)<br />         (prompt "True")<br />         (prompt "False")<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> ;; End Code

啵浪鼓

得到系统盘符,真好!