;; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;