[LISP函数]：Windows Scripting Host (FSO/WSH)

eachy · 发表于 2005-9-24 00:53:58

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;; WSH.LSP Copyright 1999 Tony Tanzillo
;;
;; WSH.LSP demonstrates how to use the Windows Scripting
;; Host's FileSystemObject in Visual LISP Applications.
;;
;; The FileSystemObject is part of Microsoft's Windows
;; Scripting Host, which is shipped with Windows 98 and
;; Internet Explorer. You can also download and install
;; the Windows Scripting Host on any NT4 or Windows 9x
;; system by downloading it from Microsoft's web site:
;;
;; [url]http://www.microsoft.com/scripting[/url]
;;
;; The FileSystemObject
;;
;; The FileSystemObject and its aggregates provide a
;; well-defined, high-level ActiveX interface to the
;; file system and its contents.
;;
;; Within the FileSystemObject, Drives, Folders, and
;; Files are all represented by like-named ActiveX
;; objects (Folder, File, Drive, and so on). Some of
;; those objects expose a collection property that
;; provides access to child objects.
;;
;; For example, Drive objects have a collection of
;; Folder objects. Folder objects have a collection of
;; File objects and SubFolder objects. You can use these
;; objects and collections to access and process folders
;; and files in a hierarchial fashion.
;;
;; The following is a short synopsys of the properties
;; and methods of the top-level FileSystemObject. The
;; aggregate objects within the FileSystemObject (File,
;; Folder, Drive, and so forth) are not detailed here.
;; You can get complete information on all child objects
;; from the Windows Scripting Host documentation.
;;
;; Note that the method/property/constant prefix "wsh-"
;; is VLISP-specific, as defined by the load-scripting
;; function below.
;;
;; Windows Scripting Host FileSystemObject
;; ---------------------------------------
;;
;; Properties:
;;
;; (wsh-get-Drives)
;;
;; Methods:
;;
;; (wsh-BuildPath <Path> <Name>)
;; (wsh-CopyFile <Source> <Destination> [<Overwrite = :vlax-true>])
;; (wsh-CopyFolder <Source> <Destination> [<Overwrite = :vlax-true>])
;; (wsh-CreateFolder <FolderName>)
;; (wsh-CreateTextFile <FileName> [<Overwrite = :vlax-false> [<Unicode = :vlax-false>]])
;; (wsh-DeleteFile <FileName> [<Force = :vlax-false>])
;; (wsh-DeleteFolder <FolderName> [<Force = :vlax-false>])
;; (wsh-DriveExists <DriveSpec>)
;; (wsh-FileExists <FileSpec>)
;; (wsh-FolderExists <FolderSpec>)
;; (wsh-GetAbsolutePathName <PathSpec>)
;; (wsh-GetBaseName <Path>)
;; (wsh-GetDrive <DriveSpec>)
;; (wsh-GetDriveName <Path>)
;; (wsh-GetExtensionName <Path>)
;; (wsh-GetFile <FileSpec>)
;; (wsh-GetFileName <PathSpec>)
;; (wsh-GetFolder <FolderSpec>)
;; (wsh-GetParentFolderName <Path>)
;; (wsh-GetSpecialFolder <FolderSpec>)
;; (wsh-GetTempName)
;; (wsh-MoveFile <Source> <Destination>)
;; (wsh-MoveFolder <Source> <Destination>)
;; (wsh-OpenTextFile <FileName> [<IOMode = :wsh-ForReading> [<Create = :vlax-false>
;; [<Format = :wsh-TristateFalse]]])
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Global constants
(setq fso:progid "Scripting.FileSystemObject")
(setq fso:prefix "wsh-")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utility functions
(defun load-scripting ( / server)
(if (not wsh-get-drives)
(progn
(vl-load-com)
(setq server (CoGetClassServer fso:progid))
(if (not server)
(alert "Error: Windows Scripting Host is not installed")
(progn
(vlax-import-type-library
:tlb-filename Server
:methods-prefix fso:prefix
:properties-prefix fso:prefix
:constants-prefix (strcat ":" fso:prefix)
)
)
)
)
)
)
(defun ProgID->CLSID (ProgID)
(vl-registry-read
(strcat "HKEY_CLASSES_ROOT\" progid "\\CLSID")
)
)
(defun CoGetClassProperty (ProgID property / clsid)
(if (setq clsid (ProgID->CLSID ProgID))
(vl-registry-read
(strcat
"HKEY_CLASSES_ROOT\\CLSID\"
clsid
"\" property
)
)
)
)
(defun CoGetClassServer (progid)
(CoGetClassProperty progid "InprocServer32")
)
;; load Windows Scripting Host Type Library
(load-scripting)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Windows Scripting Host FileSystemObject Example:
;;
;; Function (FindFiles <Folder> <Pattern>)
;;
;; This function uses the FileSystemObject to
;; find all files in a given folder and all
;; subfolders that match a specified pattern.
;;
;; It returns a list of the full filespec of
;; each file that was found, or nil if no files
;; were found.
;;
;; Note that the pattern argument is a wcmatch-
;; style wildcard pattern, rather than a DOS
;; wildcard pattern. Hence, if you want to
;; include the period extension delimiter in the
;; pattern, you must prefix it with ` (backquote).
;;
;; Finally, this demonstration code is highly-
;; ineffecient, mainly due to the use of (append)
;; for constructing the resulting list. If you
;; are serious about processing large amounts of
;; files, you may want to consider optimizing it.
;;
;; Example (find all LISP files in D:\LISP):
;;
;; (FindFiles "D:\\LISP" "*`.LSP") ;; Note backquote!!!
(defun FindFiles (FolderSpec Pattern / fso Folder rslt Find:OnSubFolder)
;; If the function find-in-folders:onSubFolder is
;; defined, it is called and passed each folder
;; object that is processed. This function could
;; be used to keep a user informed on the progress
;; of a long search operation.
(defun Find:OnSubFolder (Folder)
(princ
(strcat
" \r"
"Searching " (wsh-get-path folder)
)
)
)
(setq pattern (strcase pattern))
(setq fso
(vla-getInterfaceObject
(vlax-get-acad-object)
"Scripting.FileSystemObject"
)
)
(setq folder (wsh-GetFolder fso FolderSpec))
(setq rslt (find-in-folders Folder))
(vlax-release-object Folder)
(vlax-release-object fso)
rslt
)
;; This recursive function processes each
;; folder object, and its subfolders.
(defun find-in-folders (Folder / Files SubFolders result)
;; Process files in this folder:
(setq Files (wsh-get-files Folder))
(vlax-for file files
(if (wcmatch (strcase (wsh-get-name file)) pattern)
(setq result (cons (wsh-get-path file) result))
)
(vlax-release-object file)
)
(vlax-release-object files)
;; Process subfolders in this folder (recursive)
(setq SubFolders (wsh-get-SubFolders folder))
(vlax-for SubFolder SubFolders
(if Find:OnSubFolder
(Find:OnSubFolder SubFolder)
)
(setq result
(append result
(find-in-folders Subfolder)))
(vlax-release-object subfolder)
)
(vlax-release-object SubFolders)
result
)
;;;;;;;;;;;;;;;;;;;;;;;;;;; wsh.lsp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; WSH.LSP Copyright 1999 Tony Tanzillo 
;; 
;; WSH.LSP demonstrates how to use the Windows Scripting 
;; Host's FileSystemObject in Visual LISP Applications. 
;; 
;; The FileSystemObject is part of Microsoft's Windows 
;; Scripting Host, which is shipped with Windows 98 and 
;; Internet Explorer. You can also download and install 
;; the Windows Scripting Host on any NT4 or Windows 9x 
;; system by downloading it from Microsoft's web site: 
;; 
;;   [url]http://www.microsoft.com/scripting[/url] 
;;    
;; The FileSystemObject 
;;    
;; The FileSystemObject and its aggregates provide a 
;; well-defined, high-level ActiveX interface to the 
;; file system and its contents. 
;; 
;; Within the FileSystemObject, Drives, Folders, and 
;; Files are all represented by like-named ActiveX 
;; objects (Folder, File, Drive, and so on). Some of 
;; those objects expose a collection property that 
;; provides access to child objects. 
;; 
;; For example, Drive objects have a collection of 
;; Folder objects. Folder objects have a collection of 
;; File objects and SubFolder objects. You can use these 
;; objects and collections to access and process folders 
;; and files in a hierarchial fashion. 
;; 
;; The following is a short synopsys of the properties 
;; and methods of the top-level FileSystemObject. The 
;; aggregate objects within the FileSystemObject (File, 
;; Folder, Drive, and so forth) are not detailed here. 
;; You can get complete information on all child objects 
;; from the Windows Scripting Host documentation. 
;; 
;; Note that the method/property/constant prefix "wsh-" 
;; is VLISP-specific, as defined by the load-scripting 
;; function below. 
;;   
;; Windows Scripting Host FileSystemObject 
;; --------------------------------------- 
;; 
;; Properties: 
;; 
;; (wsh-get-Drives) 
;;    
;; Methods: 
;; 
;; (wsh-BuildPath <Path> <Name>) 
;; (wsh-CopyFile <Source> <Destination> [<Overwrite = :vlax-true>]) 
;; (wsh-CopyFolder <Source> <Destination> [<Overwrite = :vlax-true>]) 
;; (wsh-CreateFolder <FolderName>) 
;; (wsh-CreateTextFile <FileName> [<Overwrite = :vlax-false> [<Unicode = :vlax-false>]]) 
;; (wsh-DeleteFile <FileName> [<Force = :vlax-false>]) 
;; (wsh-DeleteFolder <FolderName> [<Force = :vlax-false>]) 
;; (wsh-DriveExists <DriveSpec>) 
;; (wsh-FileExists <FileSpec>) 
;; (wsh-FolderExists <FolderSpec>) 
;; (wsh-GetAbsolutePathName <PathSpec>) 
;; (wsh-GetBaseName <Path>) 
;; (wsh-GetDrive <DriveSpec>) 
;; (wsh-GetDriveName <Path>) 
;; (wsh-GetExtensionName <Path>) 
;; (wsh-GetFile <FileSpec>) 
;; (wsh-GetFileName <PathSpec>) 
;; (wsh-GetFolder <FolderSpec>) 
;; (wsh-GetParentFolderName <Path>) 
;; (wsh-GetSpecialFolder <FolderSpec>) 
;; (wsh-GetTempName) 
;; (wsh-MoveFile <Source> <Destination>) 
;; (wsh-MoveFolder <Source> <Destination>) 
;; (wsh-OpenTextFile <FileName> [<IOMode = :wsh-ForReading> [<Create = :vlax-false> 
;;                               [<Format = :wsh-TristateFalse]]]) 
;; 
;; 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Global constants 
 
(setq fso:progid "Scripting.FileSystemObject") 
(setq fso:prefix "wsh-") 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utility functions 
 
(defun load-scripting ( / server) 
   (if (not wsh-get-drives) 
      (progn 
         (vl-load-com) 
         (setq server (CoGetClassServer fso:progid)) 
         (if (not server) 
            (alert "Error: Windows Scripting Host is not installed") 
            (progn 
               (vlax-import-type-library 
                  :tlb-filename Server 
                  :methods-prefix fso:prefix 
                  :properties-prefix fso:prefix 
                  :constants-prefix (strcat ":" fso:prefix) 
               ) 
            ) 
         ) 
      ) 
   ) 
) 
 
(defun ProgID->CLSID (ProgID) 
   (vl-registry-read 
      (strcat "HKEY_CLASSES_ROOT\" progid "\\CLSID") 
   ) 
) 
 
(defun CoGetClassProperty (ProgID property / clsid) 
   (if (setq clsid (ProgID->CLSID ProgID)) 
      (vl-registry-read 
         (strcat 
            "HKEY_CLASSES_ROOT\\CLSID\" 
            clsid 
            "\" property 
         ) 
      ) 
   ) 
) 
 
(defun CoGetClassServer (progid) 
   (CoGetClassProperty progid "InprocServer32") 
) 
 
;; load Windows Scripting Host Type Library 
 
(load-scripting) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; 
;; Windows Scripting Host FileSystemObject Example: 
;; 
;; Function (FindFiles <Folder> <Pattern>) 
;; 
;; This function uses the FileSystemObject to 
;; find all files in a given folder and all 
;; subfolders that match a specified pattern. 
;; 
;; It returns a list of the full filespec of 
;; each file that was found, or nil if no files 
;; were found. 
;; 
;; Note that the pattern argument is a wcmatch- 
;; style wildcard pattern, rather than a DOS 
;; wildcard pattern. Hence, if you want to 
;; include the period extension delimiter in the 
;; pattern, you must prefix it with ` (backquote). 
;; 
;; Finally, this demonstration code is highly- 
;; ineffecient, mainly due to the use of (append) 
;; for constructing the resulting list. If you 
;; are serious about processing large amounts of 
;; files, you may want to consider optimizing it. 
;; 
;; Example (find all LISP files in D:\LISP): 
;; 
;;   (FindFiles "D:\\LISP" "*`.LSP")  ;; Note backquote!!! 
 
(defun FindFiles (FolderSpec Pattern / fso Folder rslt Find:OnSubFolder) 
 
   ;; If the function find-in-folders:onSubFolder is 
   ;; defined, it is called and passed each folder 
   ;; object that is processed. This function could 
   ;; be used to keep a user informed on the progress 
   ;; of a long search operation. 
    
   (defun Find:OnSubFolder (Folder) 
      (princ 
         (strcat 
            "                                                       \r" 
            "Searching " (wsh-get-path folder) 
         ) 
      ) 
   ) 
 
   (setq pattern (strcase pattern)) 
   (setq fso 
      (vla-getInterfaceObject 
         (vlax-get-acad-object) 
         "Scripting.FileSystemObject" 
      ) 
   )   
   (setq folder (wsh-GetFolder fso FolderSpec)) 
   (setq rslt (find-in-folders Folder)) 
   (vlax-release-object Folder) 
   (vlax-release-object fso) 
   rslt 
) 
 
;; This recursive function processes each 
;; folder object, and its subfolders. 
 
 
(defun find-in-folders (Folder / Files SubFolders result) 
 
   ;; Process files in this folder: 
    
   (setq Files (wsh-get-files Folder)) 
    
   (vlax-for file files 
      (if (wcmatch (strcase (wsh-get-name file)) pattern) 
         (setq result (cons (wsh-get-path file) result)) 
      ) 
      (vlax-release-object file) 
   ) 
 
   (vlax-release-object files) 
    
   ;; Process subfolders in this folder (recursive) 
    
   (setq SubFolders (wsh-get-SubFolders folder)) 
   
   (vlax-for SubFolder SubFolders 
      (if Find:OnSubFolder 
         (Find:OnSubFolder SubFolder) 
      ) 
      (setq result 
         (append result 
            (find-in-folders Subfolder))) 
      (vlax-release-object subfolder) 
   ) 
   (vlax-release-object SubFolders) 
    
   result 
) 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;; wsh.lsp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

caddog · 发表于 2005-11-4 00:31:32

我下了，要是加点汉字说明就好了

账号		自动登录	找回密码
密码			立即注册

[LISP函数]：Windows Scripting Host (FSO/WSH)

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子