SCCM Database Queries: Find Executable Files by Name, Version and Install Count

Find all instances of a particular file by its distinct Version number (e.g. "FileVersion" property).  In this example, I'm looking for what versions of Sysinternals' PsExec.exe are in the environment, and how many instances were found for each version.

[Begin T-SQL]
SELECT DISTINCT 
[ExecutableName0],[FileVersion0], COUNT(*) AS QTY
FROM [dbo].[v_GS_INSTALLED_EXECUTABLE]
WHERE ExecutableName0 = 'psexec.exe'
GROUP BY ExecutableName0, FileVersion0
ORDER BY FileVersion0
[End T-SQL]

Query AD Computers with Custom HOSTS File Entries

'****************************************************************
' Filename..: enum_ad_host_files.vbs
' Author....: David M. Stein
' Date......: 04/15/2012
' Purpose...: search for hosts files with custom entries
'****************************************************************
dns_netbios = "short_name_of_your_active_directory_domain"

Const ForReading = 1
Const ForWriting = 2

wscript.echo "info: scanning domain = " & dns_netbios

Set objDom = GetObject( "WinNT://" & dns_netbios )
Set objFSO = CreateObject("Scripting.FileSystemObject")

tcount = 0

For each obj in objDom
 If Lcase(obj.Class) = "computer" Then
  computerName = obj.Name
  wscript.echo "info: " & computerName
  tcount = tcount + 1
  CheckHosts computerName
 End If
Next

Sub CheckHosts(cn)
 Dim filename, objFile, strLine, found
 filename = "\\" & cn & "\admin$\system32\drivers\etc\hosts"
 wscript.echo "info: searching for: " & filename
 If objFSO.FileExists(filename) Then
  On Error Resume Next
  Set objFile = objFSO.OpenTextFile(filename, ForReading)
  If err.Number = 0 Then
   Do Until objFile.AtEndOfStream
    strLine = Trim(objFile.Readline)
    If Left(strLine,1) <> "#" And strLine <> "" Then
     found = True
    End If
   Loop
   objFile.Close
   
   If found = True Then 
    wscript.echo "info: custom entry found!"
   Else
    wscript.echo "info: no custom entries found."
   End If
  Else
   wscript.echo "fail: error (" & err.Number & ") = " & err.Description
  End If
   
 Else
  wscript.echo "fail: unable to locate hosts file on " & cn
 End If
End Sub

wscript.echo "info: " & tcount & " account objects found"

Query Installed Apps a Different Way

For whatever reason, in some environments, a WMI query of Win32_Product is God-awful slow.  I've seen this on Windows 7 and Windows 7 SP1 clients, as well as on Windows Server 2008 and 2008 R2.  The symptom can be seen from WIM script, WBEM, and using WMIC from a command console with very similar results:  The query hangs for 20-25 seconds and then begins executing in spurts.  Other Win32 classes work fine, from what I've seen, it's just Win32_Product for some reason.  One workaround is to dump a registry output file, and scrub it to make a "clean" output file.  You can port this to PowerShell or KiXtart if you want (or whatever you prefer, I really don't care as long as you're happy and that makes me happy so we're all happy. yay!)

'****************************************************************
' Filename..: installedApps.vbs
' Author....: David M. Stein aka Scriptzilla aka dipshit
' Date......: 10/20/2011
' Purpose...: save query of installed applications to local file
'****************************************************************

Const strInputFile  = "c:\regoutput.txt"
Const strOutputFile = "c:\installedApps.txt"

Const ForReading = 1
Const ForWriting = 2
Const adVarChar = 200

cmd = "reg query hklm\software\microsoft\windows\currentversion\uninstall /s >" & strInputFile

On Error Resume Next

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

wscript.echo "info: executing shell command to create temp file..."

objShell.Run "cmd /c " & cmd, 7, True

wscript.echo "info: getting temp file for input..."

If objFSO.FileExists(strInputFile) Then
 wscript.echo "info: reading temp file..."
 Set objFile = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.CreateTextFile(strOutputFile, True)

 Set rs = CreateObject("ADODB.RecordSet")

 rs.CursorLocation = adUseClient
 rs.Fields.Append "productname", adVarChar, 255
 rs.Open

 Do Until objFile.AtEndOfStream
     strLine = objFile.Readline
     If Left(strLine, 25) = "    DisplayName    REG_SZ" Then
      strOutput = Trim(Mid(strLine, 30))
   rs.AddNew
   rs.Fields("productname").value = strOutput
   rs.Update
     End If
 Loop
 
 rs.Sort = "productname"
 
 Do Until rs.EOF
     objFile2.WriteLine(rs.Fields("productname").value)
  rs.MoveNext
 Loop
 rs.CLose
 Set rs = Nothing
 
 objFile.Close
 objFile2.Close
 wscript.echo "info: finished scrubbing input to new output file"
Else
 wscript.echo "fail: temp file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing
'----------------------------------------------------------------

wscript.echo "info: processing complete!"

A WMI Search-Filter Thingy Script Thingy

I worked on this for a couple of hours. It could use a lot more work and embellishment (such as specifying the namespaces in the data file, etc.), but here goes. It reads a text file to scan the local computer for matching WMI class properties (currently only within the CIMv2 namespace). I hope it helps someone. Enjoy!

'****************************************************************
' Filename..: wmi_rule.vbs
' Author....: Scriptzilla / skatterbrainz.blogspot.com
' Date......: 10/27/2010
' Purpose...: evaluate wmi class property value matches using data file
'****************************************************************
 
scriptPath = Replace(wscript.ScriptFullName, "\" & wscript.ScriptName, "")
 
ruleFile = scriptPath & "\wmi_rules.txt"
Const ForReading = 1
Const ForWriting = 2
Set objFSO  = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile = objFSO.OpenTextFile(ruleFile, ForReading)
If err.Number = 0 Then
    Do Until objFile.AtEndOfStream
        strLine = Trim(objFile.Readline)
        If strLine <> "" And Left(strLine,1) <> "'" And Left(strLine,1) <> ";" Then
            arrRule = Split(strLine, ",")
            For each item in arrRule
                arrPair = Split(item, "=")
                Select Case arrPair(0)
                    Case "Class": wmi_class = arrPair(1)
                    Case "Property": wmi_prop = arrPair(1)
                    Case "Value": wmi_val = arrPair(1)
                    Case "MatchType": wmi_match = arrPair(1)
                End Select
            Next
 
            If WMIRule(wmi_class, wmi_prop, wmi_val, wmi_match) = True Then
                wscript.echo "class....... " & wmi_class
                wscript.echo "property.... " & wmi_prop
                wscript.echo "value....... " & wmi_val
                wscript.echo "matchtype... " & wmi_match
                wscript.echo "result ----> TRUE"
                wscript.echo
            Else
                wscript.echo "class....... " & wmi_class
                wscript.echo "property.... " & wmi_prop
                wscript.echo "value....... " & wmi_val
                wscript.echo "matchtype... " & wmi_match
                wscript.echo "result ----> FALSE"
                wscript.echo
            End If
        End If
    Loop
    objFile.Close
Else
    wscript.echo "fail: unable to open rule file for input"
End If
Set objFSO = Nothing

'----------------------------------------------------------------
 
Function WMIRule(w_class, w_prop, w_val, w_match)
    Dim objClass, objProp, strName, strValue, retval
    Dim objWMIService, wmiQuery, colItems, objItem
               
    strComputer = "."
    Set objWMIService = objWMI(strComputer, "classes")
               
    wmiQuery = "select * from " & w_class
               
    Set colItems = objWMI(strComputer, wmiQuery)
               
    For each objItem in colItems
        For Each objProp In objItem.Properties_
            strName = objProp.Name
            If Ucase(strName) = Ucase(w_prop) Then
                'wscript.echo vbTab & "property --> " & w_prop
                If IsArray(objProp.Value) Then
                    strValue = Join(objProp.Value, ";")
                Else
                    strValue = Trim(objProp.Value)
                End If
            End If
        Next
 
        If strValue <> "" And Not IsNull(strValue) Then
            If w_match = "EQUAL" Then
                If strValue = w_val Then
                    retval = True
                End If
            Else
                If InStr(strValue, w_val) > 0 Then
                    retval = True
                End If
            End If
        End If
    Next
    WMIRule = retval
End Function
 
 
Function objWMI(strComputer, strWQL)
    'On Error Resume Next
    Dim wmiNS, objWMIService, objSWbemLocator, objSWbemServices
    Dim strUID, strPwd
               
    wmiNS  = "\root\cimv2"
    strUID = ""
    strPwd = ""
               
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
               
    On Error Resume Next
               
    Set objSWbemServices = objSWbemLocator.ConnectServer(strComputer, wmiNS, strUID, strPwd)
               
    Select Case Err.Number
        Case -2147024891:
            wscript.echo "error: access denied!"
            Exit Function
    End Select
               
    On Error GoTo 0
               
    Select Case UCase(strWQL)
        Case "CLASSES":
            Set objWMI = objSWbemServices
        Case Else:
            Set objWMI = objSWbemServices.ExecQuery(strWQL)
    End Select
               
    Set objSWbemServices = Nothing
    Set objSWbemLocator = Nothing
End Function

And here is the data "rules" file that spells out the class properties to search...

'------------------------------------------------------------------------------
' wmi_rules.txt
'------------------------------------------------------------------------------
' each row denotes a rule to be tested within root\cimv2 namespace (for now)
' each row contains the WMI: class, property, value, and matchtype
' class = win32 class name
' property = the name of a given class property
' value = the value you wish to test for
' matchtype = EQUAL or LIKE
'------------------------------------------------------------------------------
Class=win32_ComputerSystem,Property=Model,Value=dc7900,MatchType=LIKE
Class=win32_OperatingSystem,Property=Caption,Value=Microsoft Windows 7 Enterprise,MatchType=LIKE
Class=win32_OperatingSystem,Property=OSArchitecture,Value=64-bit,MatchType=EQUAL
Class=win32_Service,Property=Name,Value=VMAuthdService,MatchType=EQUAL

Automating Domain Controller Diagnostics, Version 2.0, Part 2 of 2

This is the follow-up script to part 1 (see "Automating Domain Controller Diagnostics, Version 2.0").  This script runs on the member server which has the "Logs$" share, using a scheduled task.  Make sure the scheduled task runs AFTER the individual scheduled tasks on each domain controller are all completed.  I strongly suggest you stagger the individual scheduled tasks a little to avoid impacting all domain controllers at the same time, so the task that runs this script should be run a few minutes or an hour AFTER the last of those is completed.

Configure the scheduled task to run this script as the local SYSTEM account.

As always: This script is provided as-is without any warranties, implied or explicit.  Use at YOUR OWN RISK.  Edit and test in a safe environment before using in a production environment.

'**************************************************************
' Filename: dc_diagnostics_report.vbs
' Author:   David Stein
' Date:     11/20/07
' Purpose:  Open and Parse report files to produce final report
'**************************************************************
Const collectionServer = "\\memberserver"
Const DebugMode  = True
Const SendAlerts = True
Const mailServer = "mailserver.mydomain.local"
Const alertList  = "Server Admins <it_server_admins@MYDOMAIN.LOCAL>"
Const alertFrom  = "IT REPORTS <donotreply @MYDOMAIN.LOCAL>"
Const ForReading = 1
Const ForWriting = 2
Const Verbosity  = False
Const threshold  = 1
Const scriptVer  = "11.20.07"

'--------------------------------------------------------------
' declare variables
'--------------------------------------------------------------

Dim fso, filename, filedate, totalcount, s
Dim dcdiag_status, dcdiag_list, collectionFolder
Dim netdiag_status, netdiag_list
Dim repadmin_status, repadmin_list
Dim errorsFound, dcdiag_errors, netdiag_errors, repadmin_errors
Dim dclist, ndlist, rplist, strServer
Dim listd, listn, listr, shortdate, currenttime

shortdate   = FormatDateTime(Now,vbShortDate)
currentTime = FormatDateTime(Now,vbLongTime)
collectionFolder = collectionServer & "\logs$"

'--------------------------------------------------------------
' initialize list and counter variables
'--------------------------------------------------------------

dclist = ""
ndlist = ""
rplist = ""

totalcount      = 0
errorsFound     = 0
dcdiag_errors   = 0
netdiag_errors  = 0
repadmin_errors = 0

dcdiag_list   = ""
netdiag_list  = ""
repadmin_list = ""

'--------------------------------------------------------------
' diagnostics printer
'--------------------------------------------------------------

Sub DebugPrint(s)
    If DebugMode Then
        wscript.echo s
    End If
End Sub

'--------------------------------------------------------------
' main process
'--------------------------------------------------------------

Sub Main()
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FolderExists(collectionFolder) Then
        dcdiag_status   = CountReportFiles("dcdiag")
        netdiag_status  = CountReportFiles("netdiag")
        repadmin_status = CountReportFiles("repadmin")

        totalcount = (dcdiag_status + netdiag_status + repadmin_status)

        debugprint "info: " & dcdiag_status & " dcdiag report files"

        For each s in Split(dcdiag_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & netdiag_status & " netdiag report files"

        For each s in Split(netdiag_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & repadmin_status & " repadmin report files"

        For each s in Split(repadmin_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & totalcount & " total report files"

        listd = IterateReportFiles("dcdiag")
        listn = IterateReportFiles("netdiag")
        listr = IterateReportFiles("repadmin")

        debugprint "-------------------------------------------" & _
            vbCRLF & "detail results..." & _
            vbCRLF & "-------------------------------------------"
        debugprint listd & _
            vbCRLF & "-------------------------------------------"
        debugprint listn & _
            vbCRLF & "-------------------------------------------"
        debugprint listr & _
            vbCRLF & "-------------------------------------------"
        If SendAlerts Then
            Dim msgBody, msgSub
            If errorsFound > 0 Then
                msgSub = "Domain Controller Status Alert"
            Else
                msgSub = "Domain Controller Status Report"
            End If
            msgBody = msgSub & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Errors/Warnings: " & errorsFound & _
                vbCRLF & "Processed: " & shortdate & " at " & currentTime & _
                vbCRLF & "----------------------------------" & vbCRLF

            For each s in Split(dcdiag_list,",")
                If Trim(s) <> "" Then
                    msgBody = msgBody & Trim(s) & vbCRLF
                End If
            Next
            msgBody = msgBody & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Details Follow..." & _
                vbCRLF & "----------------------------------"
            msgBody = msgBody & _
                vbCRLF & "DCDIAG Results: " & _
                vbCRLF & listd & _
                vbCRLF & vbCRLF & "NETDIAG Results: " & _
                vbCRLF & listn & _
                vbCRLF & vbCRLF & "REPADMIN Results: " & _
                vbCRLF & listr & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Note: log report files are collected at" & _
                vbCRLF & "the following UNC location and may be" & _
                vbCRLF & "accessed there for diagnostics review..." & _
                vbCRLF & collectionFolder & _
                vbCRLF & "script: dc_diagnostics_report.vbs, version: " & scriptVer

            SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
        End If
    Else
        ' folder not found
    End If
    Set fso = Nothing
End Sub

'----------------------------------------------------------------
' description:
'----------------------------------------------------------------

Function ServerFileName(sFilename)
    Dim tmp, retval
    tmp = Split(sFilename, "_")
    On Error Resume Next
    retval = tmp(0)
    If err.Number <> 0 Then
        retval = Left(sFilename,9)
    End If
    ServerFileName = retval
End Function

'--------------------------------------------------------------
' count, separate and process log files
'--------------------------------------------------------------

Function CountReportFiles(reportClass)
    Dim fld, f, filename, filedate, counter, retval, age
    counter = 0
    retval = "Server" & vbTab & "Reported" & vbCRLF
    Set fld = fso.GetFolder(collectionFolder)
    For each f in fld.Files
        filename = f.Name
        filedate = f.DateLastModified
        If InStr(1, filename, reportClass) > 0 Then
            age = DateDiff("d", filedate, shortdate)
            If Abs(age) > threshold Then
                retval = retval & ServerFileName(filename) & vbTab & filedate & " **,"
            Else
                retval = retval & ServerFileName(filename) & vbTab & filedate & ","
            End If
            counter = counter + 1
        End If
    Next
    Set fld = Nothing
    Select Case reportClass
        Case "dcdiag":
            dcdiag_list = retval
        Case "netdiag":
            netdiag_list = retval
        Case "repadmin":
            repadmin_list = retval
    End Select
    CountReportFiles = counter
End Function

'--------------------------------------------------------------
' loop through log files
'--------------------------------------------------------------

Function IterateReportFiles(rType)
    Dim fld, f, filename, filepath, retval
    retval = ""
    Set fld = fso.GetFolder(collectionFolder)
    For each f in fld.Files
        filename = f.Name
        filepath = collectionFolder & "\" & filename
        If InStr(1, filename, rType) > 0 Then
            retval = retval & AnalyzeReportFile(filepath, rType, ServerFileName(filename))
        End If
    Next
    Set fld = Nothing
    IterateReportFiles = retval
End Function

'----------------------------------------------------------------
' description:
'----------------------------------------------------------------

Function CompareFileDates(d1, d2)
    Dim retval
    retval = DateDiff("d", d1, d2)
    CompareFileDates = retval
End Function

'--------------------------------------------------------------
' open, parse and return result from log file
'--------------------------------------------------------------

Function AnalyzeReportFile(filespec, reportClass, strServer)
    Dim theFile, retval, ln
    retval = ""
    Set theFile = fso.OpenTextFile(filespec, ForReading, False)

    Do While theFile.AtEndOfStream <> True
        ln = Trim(theFile.ReadLine)

        Select Case reportClass
            '----------------------------------------------
            ' DCDIAG analysis
            '----------------------------------------------

            Case "dcdiag":
                If InStr(1,ln,"Failed") > 0 Then
                    retval = retval & strServer & " ... ERROR: " & ln & _
                        vbCRLF & "....log: " & filespec & vbCRLF
                    dcdiag_errors = dcdiag_errors + 1
                    dclist = dclist & strServer & ","
                    errorsFound = errorsFound + 1
                ElseIf InStr(1,ln,"Warning") > 0 Then
                    retval = retval & strServer & " ... WARNING: " & ln & _
                        vbCRLF & "....log: " & filespec & vbCRLF
                    dcdiag_errors = dcdiag_errors + 1
                    dclist = dclist & strServer & ","
                    errorsFound = errorsFound + 1
                End If

            '----------------------------------------------
            ' NETDIAG analysis
            '----------------------------------------------

            Case "netdiag":
                Select Case Left(ln,36)
                    Case "REPLICATION-RECEIVED LATENCY WARNING":
                        retval = retval & strServer & " ... WARNING: " & ln & _
                            vbCRLF & "....log: " & filespec & vbCRLF
                        errorsFound = errorsFound + 1
                        netdiag_errors = netdiag_errors + 1
                        ndlist = ndlist & strServer & ","
                End Select

                Select Case Left(ln,25)
                    Case ".........................":
                        If InStr(1,ln,"fail") > 0 Then
                            netdiag_errors = netdiag_errors + 1
                            errorsFound = errorsFound + 1
                            ndlist = ndlist & strServer & ","
                            retval = retval & strServer & " ... ERROR: " & Mid(ln,27) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        ElseIf InStr(1,ln,"FATAL") > 0 Then
                            netdiag_errors = netdiag_errors + 1
                            errorsFound = errorsFound + 1
                            ndlist = ndlist & strServer & ","
                            retval = retval & strServer & " ... FATAL: " & Mid(ln,27) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        End If
                End Select

            '----------------------------------------------
            ' REPADMIN analysis
            '----------------------------------------------

            Case "repadmin":
                Select Case Left(ln,14)
                    Case "Last attempt @":
                        If InStr(1,ln,"fail") > 0 Then
                            errorsFound = errorsFound + 1
                            repadmin_errors = repadmin_errors + 1
                            rplist = rplist & strServer & ","
                            retval = retval & strServer & " ... ERROR: " & Mid(ln,16) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        End If
                End Select
        End Select
    Loop
    If retval = "" Then
        retval = strServer & " ... OK" & vbCRLF
    End If
    theFile.Close
    Set theFile = Nothing
    AnalyzeReportFile = retval
End Function

'--------------------------------------------------------------
' send email
'--------------------------------------------------------------

Sub SendMail(sTo, sFrom, sSubject, sBody, sFormat)
    Dim objMessage
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = sSubject
    objMessage.Sender  = sFrom
    objMessage.To = sTo
    If sFormat = "TEXT" Then
        objMessage.TextBody = sBody
    Else
        objMessage.HTMLBody = sBody
    End If
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    debugprint "info: (sendmail) message sent to " & sTo
End Sub

Main()

Wscript.Quit

Query Scheduled Tasks The Hard Way

Because the CIM/WMI model is still an unfinished work in progress, I’ve once again had to resort to making some ugly crap code to work around a giant hole in the model. In this case it’s the lack of a model counterpart to the Scheduled Tasks collection.  This is NOT the same as the Win32_ScheduledJobs or the AT command output.  I’m talking about SCHTASKS.exe and the Windows Scheduled Tasks utility.  Anyhow, the klunky workaround here is to ride the SCHTASKS command like a whipping boy and make it dump a text file, then turn around and do a crude (but effective) string parsing and crank it out in XML form.  Enjoy.

'****************************************************************
' Filename..: xml_scheduled_tasks.vbs
' Author....: David M. Stein
' Date......: 03/18/2010
' Purpose...: query Scheduled Tasks (not WMI/Jobs/AT) --> XML out
'****************************************************************

Const tempfile = "c:\temp\schtasks.txt"
Const computer = ""

Const ForReading = 1
Const ForWriting = 2

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

If computer <> "" Then
    cmdstr = "cmd /c schtasks /query /s \\" & computer & " /v /fo list >" & tempfile
Else
    cmdstr = "cmd /c schtasks /query /v /fo list >" & tempfile
End If

retval = objShell.Run(cmdstr, 1, True)

If objFSO.FileExists(tempfile) Then
    Dim linecount, objFSO, objFile, ln, strLine

    linecount = 0 
    wscript.echo ""
 
    Set objFile = objFSO.OpenTextFile(tempfile, ForReading)
    Do Until objFile.AtEndOfStream
        strLine = Trim(objFile.Readline)
     
        If Left(strLine, 9) = "HostName:" Then
            hostname = Mid(strLine, 39)
            wscript.echo vbTab & ""
     
        ElseIf Left(strLine, 9) = "TaskName:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
            wscript.echo vbTab & vbTab & "" & hostname & ""
     
        ElseIf Left(strLine, 15) = "Scheduled Type:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
     
        ElseIf Left(strLine, 9) = "Schedule:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 12) = "Task To Run:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 8) = "Comment:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 12) = "Run As User:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 11) = "Start Time:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 11) = "Start Date:" Then
            wscript.echo vbTab & vbTab & "" & Mid(strLine, 39) & ""
        
        ElseIf Left(strLine, 17) = "Power Management:" Then
            wscript.echo vbTab & ""
      
        End If
        linecount = linecount + 1
     
    Loop
    objFile.Close
    Set objFSO = Nothing
 
    wscript.echo ""
 
Else
    wscript.echo "fail: file not found"
End If

VBScript: Enumerate Start Menu Shortcuts into XML

Here's a little script to dump a list of all shortcuts and their internal properties, which exist under the “All Users” profile, in Start Menu\Programs, as well as all sub-folders below that.  The output is basic raw XML.  Not much to it, but I had to crank this out for a special project I worked on a few weeks ago and thought I’d post it here.

'****************************************************************
' Filename..: enum_allusers_shortcuts.vbs
' Author....: skatterbrainz
' Date......: 02/03/2010
' Purpose...: enumerate shortcuts under all-users start menu (xml)
'****************************************************************
Dim objShell, allUsers, allStart, objFSO, oFolder, s

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

allUsers = objShell.ExpandEnvironmentStrings("%AllUsersProfile%")
allStart = allUsers & "\Start Menu\Programs"

Set oFolder = objFSO.GetFolder(allStart)

wscript.echo "<shortcuts>"
For each s in oFolder.SubFolders
 ListShortcuts objFSO.GetFolder(allStart & "\" & s.Name)
Next
wscript.echo "</shortcuts>"

Sub ListShortcuts(objFolder)
 Dim objFile, filename
 For each objFile in objFolder.Files
  filename = objFile.Name
  If Right(Lcase(filename),4) = ".lnk" Then
   filepath = objFolder.Path & "\" & filename
   wscript.echo vbTab & "<shortcut>"
   ShortcutProps filepath
   wscript.echo vbTab & "</shortcut>"
  End If
 Next
End Sub

Sub ShortcutProps(scName)
 Dim objShortcut
 If objFSO.FileExists(scName) Then
  Set objShortcut = objShell.CreateShortcut(scName)
  WScript.Echo vbTab & vbTab & "<fullname>" & objShortcut.FullName & "</fullname>"
  WScript.Echo vbTab & vbTab & "<arguments>" & objShortcut.Arguments & "</arguments>"
  WScript.Echo vbTab & vbTab & "<workingpath>" & objShortcut.WorkingDirectory & "</workingpath>"
  WScript.Echo vbTab & vbTab & "<target>" & objShortcut.TargetPath & "</target>"
  WScript.Echo vbTab & vbTab & "<icon>" & objShortcut.IconLocation & "</icon>"
  WScript.Echo vbTab & vbTab & "<hotkey>" & objShortcut.Hotkey & "</hotkey>"
  WScript.Echo vbTab & vbTab & "<windowstyle>" & objShortcut.WindowStyle & "</windowstyle>"
  WScript.Echo vbTab & vbTab & "<comment>" & objShortcut.Description & "</comment>"
  Set objShortcut = Nothing
 Else
  wscript.echo "unable to find shortcut"
 End If
End Sub

Set oFolder  = Nothing
Set objFSO   = Nothing
Set objShell = Nothing

Am I a VMWare Guest Machine or Not?

VBScript Version

Function IsVmWareClient()
    Dim objWMIService, colBIOS, objBIOS, retval
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colBIOS = objWMIService.ExecQuery("Select SerialNumber from Win32_BIOS")
    For each objBIOS in colBIOS
        If Left(objBIOS.SerialNumber, 6) = "VMware" Then
            retval = True
            Exit For
        End If
    Next
    IsVmWareClient = retval
End Function

' test

If IsVmWareClient() Then
    wscript.echo "yes - this is a vmware guest machine"
Else
    wscript.echo "not a vmware guest machine"
End If

KiXtart Version

Function IsVmWareClient()
    Dim $wmiService, $colBIOS, $objBIOS, $retval
    $wmiService = GetObject("winmgmts:\\.\root\CIMV2")
    $colBIOS = $wmiService.ExecQuery("select SerialNumber from Win32_BIOS") 
    For Each $objBIOS in $colBIOS
        If Left($objBIOS.SerialNumber, 6) = "VMware"
            $retval = 1
        EndIf
    Next
    $IsVmWareClient = $retval
EndFunction

; test

If IsVmWareClient()
    ? "yes - this is a vmware guest machine"
Else
    ? "not a vmware guest machine"
EndIf

VBScript - Get Remote Asset Tag (Serial Number)

Function AssetNumber(strComputer)
    Dim objWmi, objWmiCS, obj, retval
    On Error Resume Next
    Set objWmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\cimv2")
    If err.Number <> 0 Then
        wscript.echo "error: " & err.Number & " / " & err.Description
        err.Clear
        Set objWMI = Nothing
        retval = "*** unavailable ***"
    Else
        Set objWmiCS = objWmi.ExecQuery("select * from Win32_ComputerSystemProduct")
        For Each obj in objWmiCS
            retval = obj.IdentifyingNumber
        Next
        Set objWmiCS = Nothing
        Set objWMI = Nothing
    End If
    AssetNumber = retval
End Function

wscript.echo AssetNumber("holland")

KiXtart: Get Asset Number

WMI query for asset number (e.g. Dell Asset, HP Serial number, etc.)

Function AssetNumber()
    Dim $objWmi, $objWmiCS, $obj, $retval, $pc
    $pc = @wksta
    $objWmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\$pc\root\cimv2")
    $objWmiCS = $objWmi.ExecQuery("select * from Win32_ComputerSystemProduct")
    For Each $obj in $objWmiCS
        $retval = $obj.IdentifyingNumber
    Next
    $AssetNumber = Trim($retval)
EndFunction