LISP 改驱动器序列号

alin

;;;VxListNetworkDrives - Returns a list of all mapped network drives with UNC...

;
; -- Function VxListNetworkDrives
; Returns a list of all mapped network drives with UNC path.
; Copyright:
;   ©2005 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   --- =
; Return [Type]:
;   > List of mapped drives '(("X:" . "\\\\Server\\Xpath")...) [LIST]
; Notes:
;   - Requires ScrRun.dll (see also notes at top of page).
;
(defun VxListNetworkDrives ( / DrvCol ItmCnt RetVal WsnObj)
 (setq WsnObj (vlax-create-object "WScript.Network")
       DrvCol (vlax-invoke WsnObj 'EnumNetworkDrives)
       ItmCnt 0
 )
 (repeat (/ (vlax-invoke DrvCol 'Count) 2)
  (setq RetVal (cons
                (cons
                 (strcase (vla-Item DrvCol ItmCnt))
                 (vla-Item DrvCol (1+ ItmCnt))
                )
                RetVal
               )
        ItmCnt (+ ItmCnt 2)
  )
 )
 (vlax-release-object WsnObj)
 (reverse RetVal)
)


;;;VxRemapNetworkDrives - Remaps a network drive to another drive letter

;
; -- Function VxRemapNetworkDrive
; Remaps a network drive to another drive letter.
; Copyright:
;   ©2005 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Old = Old drive letter, e.g. "X:" [STR]
;   New = New drive letter, e.g. "Y:" [STR]
; Return [Type]:
;   > True: Remapping successful
;   > False: Remapping failed
; Notes:
;   - Requires ScrRun.dll (see also notes at top of page).
;
(defun VxRemapNetworkDrive (Old New / OldUnc RetVal WsnObj)
 (setq WsnObj (vlax-create-object "WScript.Network")
       OldUnc (cdr (assoc (strcase Old) (VxListNetworkDrives)))
 )
 (cond
  ((vl-catch-all-apply
    'vlax-invoke
    (list WsnObj 'RemoveNetworkDrive Old :vlax-true :vlax-true)
   )
  )
  ((vl-catch-all-apply
    'vlax-invoke
    (list WsnObj 'MapNetworkDrive New OldUnc :vlax-true)
   )
  )
  ((setq RetVal T))
 )
 (vlax-release-object WsnObj)
 RetVal
)