VisualLISP使用Windows Scripting Host 编程的示例
;; 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:
;;
;; http://www.microsoft.com/scripting
;;
;; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
没有中文注释，多有不便 这个以前贴过好几次
<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=11083&replyID=46333&skin=1" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=11083&replyID=46333&skin=1</A>
页:
[1]