'  Places ExecutablesList.txt file on the Local Computer's desktop
'  The text file provides a list of all executables contained in the system path
'   Steve Yandl

'  ====================================================

strComputer = "."
Const Desktop = &H10&
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32


'  Set up the text file on the desktop

Set objShell = CreateObject("Shell.Application")
Set objFolderDsk = objShell.Namespace(Desktop)
strDsk = objFolderDsk.Self.Path
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReport = objFSO.CreateTextFile(strDsk & "\ExecutablesList.txt",True)
objReport.WriteLine "Executable files found in the system path" & vbCrLf
objReport.WriteLine "File Name  ---  Folder  ---  Manufacturer (if given)" & vbCrLf

Set objWMIService = GetObject _
    ("winmgmts:\\" & strComputer & "\root\cimv2")


'  Locate and clean up path statements for folders in the system path

Set colItems = objWMIService.ExecQuery("Select * From Win32_OperatingSystem")
For Each objItem in colItems
     strWinDir = objItem.WindowsDirectory
     strSysDrv = objItem.SystemDrive
Next

Set colEnviroList = objWMIService.ExecQuery _
    ("Select * from Win32_Environment Where Name = 'Path'")
For Each objPathEnv in colEnviroList
    strPathStmt = objPathEnv.VariableValue
Next

strPathStmt = Replace(UCase(strPathStmt), "%SYSTEMROOT%", strWinDir)
strPathStmt = Replace(strPathStmt, "%WINDIR%", strWinDir)
strPathStmt = Replace(strPathStmt, "%SYSTEMDRIVE%", strSysDrv)
pathArray = Split(strPathStmt, ";")


'  Determine the file extensions considered belonging to executable files

Set colEnviroList = objWMIService.ExecQuery _
    ("Select * from Win32_Environment Where Name = 'PathExt'")
For Each objExeExt in colEnviroList
    strExtensions = objExeExt.VariableValue
    strExtensions = Replace(strExtensions, ".", "")
Next

extenArray = Split(strExtensions, ";")


'  Verify the existance of each folder extracted from the path statement

ReDim pathOkArray(0)
For P = 0 To UBound(pathArray)
strFolder = pathArray(P)
strFolderX = Replace(strFolder, "\", "\\")
Set colFolders = objWMIService.ExecQuery _
    ("Select * From Win32_Directory Where " & _
        "Name = '" & strFolderX & "'")
If colFolders.Count > 0 Then
pathOkArray(UBound(pathOkArray)) = strFolder
ReDim Preserve pathOkArray(UBound(pathOkArray) + 1)   
End If
Next


'  Set up the database to store and sort the information on executables

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "FileName", adVarChar, MaxCharacters, adFldIsNullable
DataList.Fields.Append "Manufacturer", adVarChar, MaxCharacters, adFldIsNullable
DataList.Fields.Append "Path", adVarChar, MaxCharacters, adFldsNullable
DataList.Open


'  Build the database

For K = 0 To UBound(pathOkArray) - 1
strFolder = pathOkArray(K)
     Set colFileList = objWMIService.ExecQuery _
         ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
             & "ResultClass = CIM_DataFile")
     For E = 0 To UBound(extenArray)
          strExtension = Lcase(extenArray(E))
          For Each objFile In colFileList
               If Lcase(objFile.Extension) = strExtension Then
               DataList.AddNew
               DataList("FileName") = objFile.FileName & "." & objFile.Extension
               DataList("Manufacturer") = objFile.Manufacturer
               DataList("Path") = objFile.Path
               DataList.Update
               End If
          Next
     Next
Next

DataList.Sort = "FileName"


'  Write the results to the desktop text file

DataList.MoveFirst
Do Until DataList.EOF
strFileRprt = DataList.Fields.Item("FileName") & "   -------   " & vbTab _
     & DataList.Fields.Item("Path") & vbTab _
          & DataList.Fields.Item("Manufacturer")
objReport.WriteLine strFileRprt
DataList.MoveNext
Loop

WScript.Echo "Done"