ASP - Cheap Debug Input Dumper

I call it: Dave's Dastardly Diabolical Debugging Dumbass Dumper, or just Debug Dump for short.  It simply prints out any form inputs and querystring inputs and then stops the page rendering process dead.  That allows you to structure a processing page to capture inputs and then dump them before proceeding to process them; allowing you a chance to see what may be going in the wrong direction before you go further into the debug abyss.

[asp]

<%
Sub Show_InputParams ()
   Dim fn, qv, fc, qc
    fc = 0
    qc = 0
    Response.Write "

Form Inputs

"
    For each fn in Request.Form()
        Response.Write "" & fn & " = " & Request.Form(fn) & "
"
        fc = fc + 1
    Next
    Response.Write "

QueryString Inputs

"
    For each qv in Request.QueryString()
        Response.Write "" & qv & " = " & Request.QueryString(qv) & "
"
        qc = qc + 1
    Next
    Response.Write "

(processing halted)

"
    Response.End
End Sub
%>

[asp]

To try this out the quickest way, paste that mess above into a new file and save it as "dumbass.asp".  Then access it via your browser along with some test parameters (querystring inputs for now).  something like "/mysite/dumbass.asp?test1=123&a=def&x=4321"

It should print out something like the following...

Form Inputs

(no form inputs found)

QueryString Inputs

test1 = 123

a = def

x = 4321

3 querystring inputs found

(processing halted)

ASP - Function to Get Windows Logon UserName

This requires that you have some form of authentication enabled on the web site configuration.  I prefer Windows Authentication, but forms or basic might also suffice.  Basically, regardless of the web browser, as long as some form of authentication is required, and the user provides it (or the browser hands it over silently, like IE usually does, cough-cough), it will spew forth the "logon_user" or "remote_user" server variable.  Using that, you can parse out a NetBIOS domain prefix, such as "contoso\dumbass" to return just the "dumbass" part.

[asp]
<%
Function Get_UserName()
    Dim tmp, result
    result = ""
    tmp = Trim(Request.ServerVariables("LOGON_USER"))
    If tmp = "" Then
        tmp = Trim(Request.ServerVariables("REMOTE_USER"))
    End If
    If tmp <> "" Then
        If InStr(tmp, "\") > 0 Then
            arrtmp = Split(tmp,"\")
            result = Lcase(arrtmp(1)
        Else
            result = Lcase(tmp)
        End If
    End If
    Get_UserName = result
End Function

' test it out...

If Get_UserName() = "dave" Then
    Response.Write "yay!  it's dave!"
Else
    Response.Write "boo.  it's not dave. bummer."
End If
%>
[/asp]

Function: Get Maintenance Window Status (VBScript, ASP and PowerShell flavors)

A little function you can use to determine if a date/time window is active, pending or expired.  I've provided both PowerShell, VBScript and ASP examples (almost the same thing).

Note that PowerShell requires defining the function before invoking it, with regards to single-file, sequential ("top-down") processing order.

[powershell]
function Get-TimeWindowStatus {
    Param(
        [parameter(Mandatory=$true)]$Start,
        [parameter(Mandatory=$true)]$End
    )
    $now = Get-Date
    $dif1 = $(New-TimeSpan -Start $Start -End $now).Minutes
    $dif2 = $(New-TimeSpan -Start $End -End $now).Minutes
    if ($dif1 -lt 0) {
        return -1
    }
    elseif ($dif2 -gt 0) {
        return 1
    }
    else {
        return 0
    }
}

$d1 = "8/27/2014 9:30:00"
$d2 = "8/27/2014 10:00:00"

switch (Get-TimeWindowStatus -Start $d1 -End $d2) {
    -1 {write-host "Maintenance window has not begun."}
    1  {write-hsot "Maintenance window has expired."}
    default {Write-Host "Maintenance window is active."}
}
[/powershell]

ASP and VBScript on the other hand pre-process script code, so you can define functions anywhere within a given script file, and the location for invoking the function doesn't matter as long as it's in the same file (or loaded in advance using "#include" if using ASP).

[asp]
d1 = "8/26/2014 16:00"
d2 = "8/27/2014 9:00"

Select Case TIME_WINDOW_STATUS (d1, d2)
    Case 0:  Response.Write "Maintenance window is in effect."
    Case 1:  Response.Write "Maintenance window has expired."
    Case -1: Response.Write "Maintenance window has not begun."
End Select

Function TIME_WINDOW_STATUS (startDT, endDT)
    Dim dd1, dd2, result
    dd1 = DateDiff("n", d1, NOW)
    dd2 = DateDiff("n", d2, NOW)
    If dd1 > 0 And dd2 < 0 Then 
        result = 0
    ElseIf dd1 < 0 Then
        result = -1
    ElseIf dd2 > 0 Then
        result = 1
    End If
    TIME_WINDOW_STATUS = result
    End Function

[/asp]

[vbscript]
d1 = "8/26/2014 16:00"
d2 = "8/27/2014 9:00"

Select Case TIME_WINDOW_STATUS (d1, d2)
    Case 0:  wscript.echo "Maintenance window is in effect."
    Case 1:  wscript.echo "Maintenance window has expired."
    Case -1: wscript.echo "Maintenance window has not begun."
End Select

Function TIME_WINDOW_STATUS (startDT, endDT)
    Dim dd1, dd2, result
    dd1 = DateDiff("n", d1, NOW)
    dd2 = DateDiff("n", d2, NOW)
    If dd1 > 0 And dd2 < 0 Then 
        result = True
    ElseIf dd1 < 0 Then
        result = False
    ElseIf dd2 > 0 Then
        result = False
    End If
    TIME_WINDOW_STATUS = result
End Function

[/vbscript]

Deleting Sub-Folders with VBScript, Coffee and French Fries

Delete all sub-folders beneath a given root folder on multiple (remote) computers.  The old RD/RMDIR command will delete the named root folder along with sub-folders, by default.  This script leaves the root folder alone and only deletes the sub-folders.  Feel free to modify as needed.

'****************************************************************
' Filename..: fso_delete_subfolders.vbs
' Author....: David M. Stein
' Date......: 11/19/2013
' Purpose...: delete all sub-folders beneath a root path, on multiple computers
' NO WARRANTIES - USE AT YOUR OWN RISK - YOU DAREDEVIL YOU
'****************************************************************

Dim strServer, objSubFolder
Dim strFolderRoot, strSubFolder, x

Const strServerList = "SERVER1,SERVER2,SERVER3"
Const strRootPath = "D$\TEMP"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For each strServer in Split(strServerList, ",")
wscript.echo "info: server is " & strServer
On Error Resume Next
strFolderRoot = "\\" & strServer & "\" & strRootPath
Set objFolder = objFSO.GetFolder(strFolderRoot)
If err.Number = 0 Then
For each objSubFolder in objFolder.SubFolders
strSubFolder = objSubFolder.Name
wscript.echo "info: deleting folder --> " & strFolderRoot & "\" & strSubFolder
x = objFSO.DeleteFolder(strFolderRoot & "\" & strSubFolder, True)
wscript.echo "info: result is " & x
Next
Else
wscript.echo "error [" & err.Number & "]: " & err.Description
wscript.echo "info: could be caused by folder-not-found."
End If
Next

File Search using WMI CIM_DataFile with VBScript

I looked around, but didn't find a script example that did exactly what I wanted, but I ran across several good alternatives. One thing I found was that if I don't specify the drive letter, it takes WAAAAAAAYYYYY longer to execute. Just a tip. In any case, I hope this helps someone out there...

'****************************************************************
' Filename..: fileSearch.vbs
' Author....: ScriptZilla / SkatterBrainz / Dave
' Date......: 07/30/2012
' Purpose...: search for files using WMI/CIM_DataFile
'****************************************************************
time1 = Timer

'----------------------------------------------------------------
' comment: search parameters
'----------------------------------------------------------------

strFileExt  = "syn"
strFileName = "*"
strDriveLtr = "c:"
strComputer = "."

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function StringDate(dv)
 Dim xdy, xdm, xdd, xdh, xdn, tmp
 ' example: 20120729195837.171181-240
 xdy = Mid(dv,1,4) ' year
 xdm = Mid(dv,5,2) ' month
 xdd = Mid(dv,7,2) ' day
 xdh = Mid(dv,9,2) ' hour
 xdn = Mid(dv,11,2) ' minute
 tmp = xdm & "/" & xdd & "/" & xdy & " " & xdh & ":" & xdn
 StringDate = FormatDateTime(tmp, vbShortDate) & " " & _
  FormatDateTime(tmp, vbLongTime)
End Function

'----------------------------------------------------------------
' comment: main script code begins
'----------------------------------------------------------------

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

If strFileName = "*" Then
 query = "Select * from CIM_DataFile Where Drive='" & strDriveLtr & "'" & _
  " AND Extension='" & strFileExt & "'"
Else
 query = "Select * from CIM_DataFile Where Drive='" & strDriveLtr & "'" & _
  " AND FileName = '" & strFileName & "'" & _
  " AND Extension='" & strFileExt & "'"
End If

wscript.echo "info: search criteria = " & strFileName & "." & strFileExt & " on " & strDriveLtr
Set colFiles = objWMIService.ExecQuery(query)

wscript.echo "info: beginning search..."

counter = 0
For Each objFile in colFiles
 counter = counter + 1
    wscript.echo objFile.Drive & objFile.Path & _
     objFile.FileName & "." & objFile.Extension & _
     vbTab & StringDate(objFile.CreationDate) & _
     vbTab & StringDate(objFile.LastModified) & _
     vbTab & objFile.FileSize
Next

wscript.echo "info: " & counter & " matching files found"
wscript.echo "info: " & Timer - time1 & " seconds"

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!"

Two Ways to Do String Matching in VBscript

The ugly but easier way (using InStr function)

Const strValue = "Microsoft Windows 7 Enterprise Edition"
If InStr(strValue, "Windows 7") > 0 Or InStr(strValue, "Windows XP") > 0 Then
    wscript.echo "match found"
End If

The fancier but more irritating way (using the REGEX object):

Function MatchString(strToSearch, strPattern)
    Dim objRegEx, colMatches, matchFound
    Set objRegEx = CreateObject("VBScript.RegExp")
    objRegEx.Global = True
    objRegEx.Pattern = strPattern
    Set colMatches = objRegEx.Execute(strToSearch)
    If colMatches.Count > 0 Then
        matchFound = True
    End If
    Set objRegEx = Nothing
    MatchString = matchFound
End Function

If MatchString(strValue, "Windows XP|Windows 7") Then
    wscript.echo "match found"
End If

Querying Files Using Windows Search with VBScript

'****************************************************************
' Filename..: scanFiles.vbs
' Author....: David M. Stein aka Skatterbrainz aka Scriptzilla aka goofy
' Contact...: ds0934 (at) gmail (dot) com
' Date......: 02/14/2011
' Purpose...: generate file scan report using Windows Search queries
'****************************************************************
' COPYRIGHT (C) 2011 David M. Stein - All Rights Reserved.
' No portion of this software code may be reproduced, shared,
' transmitted, by any means, electronic or otherwise, for any
' purposes whatsoever, without the explicit prior written consent 
' of the author.  
'****************************************************************
' DESCRIPTION
'
' This script invokes the built-in Windows Desktop Search service
' to query the local index for files that contain specific string
' phrases.  The string phrases are defined in an external text
' file which allows for customization of phrases as needed.
' The output is echoed to the display screen unless redirected
' to a log file.  The associated .cmd file does just that. It is
' used to execute this script, and redirect the output to a log
' file which is saved to a central folder (network server share)
'****************************************************************


Option Explicit


Const verbose = False


'----------------------------------------------------------------
' comment: DO NOT CHANGE ANY CODE BELOW THIS POINT !!!
' comment: ...or ye shall perish in the land of stupidity
'----------------------------------------------------------------


echo "info: script initialized " & Now


Const ForReading = 1
Const ForWriting = 2


Dim objConnection, objRecordset, query, scriptPath, inputFile
Dim objFSO, objFile, strLine, searchList, itemCount : itemCount = 0
Dim filePath, phrase


Set objFSO = CreateObject("Scripting.FileSystemObject")


' comment: determine self-referential path location
scriptPath = Replace(wscript.ScriptFullName, "\" & wscript.ScriptName, "")
inputFile = "searchlist.txt"
' comment: determine input search list file location
filePath = scriptPath & "\" & inputFile


On Error Resume Next
echo "info: searching for searchlist.txt input file..."
If objFSO.FileExists(filePath) Then
    echo "info: reading search values..."
    Set objFile = objFSO.OpenTextFile(filePath, ForReading)
    Do Until objFile.AtEndOfStream
        strLine = objFile.Readline
        If Left(strLine,1) <> ";" Then
            If searchList <> "" Then
                searchList = searchList & vbTab & strLine
            Else
                searchList = strLine
            End If
            itemCount = itemCount + 1
        End If
    Loop
    objFile.Close
End If


echo "info: " & itemCount & " phrases were queued"


'----------------------------------------------------------------
 
echo "info: initializing window search interface..."

Set objConnection = CreateObject("ADODB.Connection")


echo "info: opening windows search data connection..."
objConnection.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"
If err.Number <> 0 Then
    echo "fail: connection-open failure [" & _
        err.Number & ":" & err.Description & "]"
    wscript.quit(2)
End If


echo "info: beginning windows search scan process..."
For each phrase in Split(searchList, vbTab)
    wscript.echo "PHRASE: " & phrase

    ' comment: define search query expression to identify matching files

    query = "SELECT System.FileName, System.ItemPathDisplay, " & _
        "System.DateCreated, System.DateModified " & _
        "FROM SYSTEMINDEX WHERE Contains(System.FileName, '" & _
        Chr(34) & phrase & Chr(34) & "')" & _
        " OR Contains('" & Chr(34) & phrase & Chr(34) & "')"

    ' comment: open connection to service and submit query request

    Set objRecordSet  = CreateObject("ADODB.Recordset")
    objRecordSet.Open query, objConnection

    If err.Number <> 0 Then
        echo "fail: recordset-open failure [" & _
            err.Number & ":" & err.Description & "]"
        objConnection.Close
        Set objConnection = Nothing
        wscript.quit(3)
    End If

    ' comment: if results are not empty, iterate the dataset rows

    If Not (objRecordset.BOF and objRecordset.EOF) Then
        objRecordSet.MoveFirst


        echo "info: iterating recordset results..."
        Do Until objRecordset.EOF
            wscript.echo "MATCH: " & _
            objRecordset.Fields.Item("System.ItemPathDisplay").value & _
            vbTab & objRecordset.Fields.Item("System.DateCreated").value & _
            vbTab & objRecordset.Fields.Item("System.DateModified").value
            objRecordset.MoveNext
        Loop
        wscript.echo
    Else
        echo "info: no matching records were found"
    End If
    objRecordset.Close
    Set objRecordset = Nothing
Next


' comment: close connection to service


objConnection.Close
Set objConnection = Nothing


echo "info: processing completed " & Now


'----------------------------------------------------------------
' function: verbose printing
'----------------------------------------------------------------


Sub Echo(s)
    If verbose = True Then
        wscript.echo s
    End If
End Sub

EXAMPLE of searchlist.txt

; disable lines by inserting a semi-colon in front of them

This is a phrase to search for

this is another phrase

phrases are case insensitive

Recursively Delete Old Files and Empty Folders

With a slight twist: The recursion to delete empty folders ignores folders with a name that begins with a tilde "~". You can modify the character or pattern to suit your demented whims.

Const maxAge = 30
Const testMode = True

Sub RecursiveDeleteByAge(ByVal strDirectory, maxAge)
 Dim objFolder, objSubFolder, objFile
 Set objFolder = objFSO.GetFolder(strDirectory)
 For Each objFile in objFolder.Files
  dlm = objFile.DateLastModified
  If DateDiff("d", dlm, Now) > maxAge Then
   wscript.echo "Deleting:" & objFile.Path
   If Not testMode = True Then
    objFile.Delete
   End If
   Exit For
  End If
 Next 
 For Each objSubFolder in objFolder.SubFolders
  RecursiveDeleteByAge objSubFolder.Path, maxAge
 Next
End Sub


Sub RecursiveDeleteEmptyFolders(ByVal strDirectory)
 Dim objFolder, objSubFolder
 Set objFolder = objFSO.GetFolder(strDirectory)
 
 If objFolder.Files.Count = 0 Then
  If objFolder.SubFolders.Count = 0 Then
   ' no sub-folders beneath this folder...
   If Left(objFolder.Name,1) <> "~" Then
    wscript.echo "deleting " & objFolder.Path
    If Not testMode = True Then
     objFolder.Delete
    End If
   End If
  Else
   For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteEmptyFolders objSubFolder.Path
   Next
  End If
 Else
  wscript.echo "folder is not empty"
  For Each objSubFolder in objFolder.SubFolders
   RecursiveDeleteEmptyFolders objSubFolder.Path
  Next
 End If
 
End Sub

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

RecursiveDeleteByAge "d:\downloads", maxAge
RecursiveDeleteEmptyFolders "d:\downloads"

wscript.echo "finished!"

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

Making Folder Trees

I was asked to provide a script to help someone else with creating a folder tree during a software installation.  I explained that it’s “one line of code” when using a .BAT/.CMD script with “mkdir x:\folder\folder\folder”, but I got the hand in the face, followed by “we need it to be VBscript, not DOS”.  I said “whatever” and cranked out the following hamburger pile. I hope it’s of use to someone else…

rootPath = "c:\program files"
folderPath = "vendorname\appname\folder123"
fpath = rootPath & "\" & folderPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FolderExists(rootPath) Then
    tmp = rootPath
    For each s in Split(folderPath, "\")
        tmp = tmp & "\" & s
        If fso.FolderExists(tmp) Then
            wscript.echo "exists: " & tmp
        Else
            wscript.echo "creating: " & tmp
            fso.CreateFolder(tmp)
        End If
    Next
Else
    wscript.echo "fail: root path not found = " & rootPath
End If

Stupid-Simple, Yet Useful VBScript Functions

Ok, technically some of these are not functions, they're subs (or subroutines), but who cares.  I don't know who invented them, but I've been using these for years and years.  I hope they're helpful to you as well…

Sub Echo(category, caption)
    wscript.echo Now & vbTab category & vbTab & caption
End Sub

Examples…

Echo "info", "searching for wmi repository scope on remote computer…"
…
Echo "fail", "unable to connect to remote computer"

Function ScriptPath()
    ScriptPath = Replace(wscript.ScriptFullName, "\" & wscript.ScriptName, "")
End Function

Function IsWeekend(strDate)
    If Weekday(strDate)=1 Or Weekday(strDate)=2 Then
        IsWeekend = True
    End If
End Function

Function LeapYear(yr)
    Dim d1, d2
    d1 = FormatDateTime("1/1/" & yr)
    d2 = DateAdd("yyyy", 1, d1)
    If DateDiff("d", d1, d2) = 366 Then
        LeapYear = True
    End If
End Function

For i = 2004 to 2012
    If LeapYear(i) Then
        wscript.echo i & vbTab & "is a leap year"
    Else
        wscript.echo i & vbTab & "is not a leap year"
    End If
Next

Script Tip: Determine the Script File Path

With BAT/CMD scripts you can simply prefix any path references with %~dps0 to get to things in the same location (folder/UNC) where the script itself resides.  So if you run..

start /wait %~dps0setup.exe /silent /norestart

It runs setup.exe from the same folder location. (that is not a typo, there should be NO space between the zero and the rest of the file path)

It's just as easy with KiXtart using the @scriptdir macro, but with VBscript it's not that simple.  But it's not difficult either…

scriptPath = Replace(Wscript.ScriptFullName, "\" & Wscript.ScriptName, "")

An example of running setup.exe in the same folder with VBscript might be…

filePath = scriptPath & "\setup.exe"
result = objShell.Run(filePath & " /silent /norestart", 7, True)

However, be careful to wrap paths in double-quotes if they contain spaces…

filePath = Chr(34) & scriptPath & "\setup.exe" & Chr(34)
result = objShell.Run(filePath & " /silent /norestart", 7, True)

Comparing Processes: Before/After Launching an Application

I needed to capture a delta between running processes on my Windows 7 computer before and after launching a particular application.  I could have used some freeware and shareware apps for this, but I wanted something stupid simple (as far as output), not something I had to sift through and tinker with settings, etc.  I hope you find it useful. Beware of word-wrapping when copying this mess.

'****************************************************************
' Filename..: taskdump.vbs
' Author....: David M. Stein
' Date......: 07/27/2010
' Purpose...: display user contexts of running processes on remote computer
' Notes.....: run as admin (re: remote computer)
'****************************************************************
Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const offset = 78 ' start point on each row of dump file
Const offlen = 50 ' end point on each row of dump file

Dim objFile, strLine, uid, ulist
Dim objArgs, objFSO, objShell, mode
Dim strComputer, temp, outf, retval

'----------------------------------------------------------------
' comment: check if computer name was provided to script
'----------------------------------------------------------------

Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then
	strComputer = Trim(InputBox("Computer Name", "Computer Name"))
	mode = 2
Else
	strComputer = Trim(objArgs(0))
	mode = 1
End If

If strComputer = "" Then
	ShowUsage()
	wscript.Quit(1)
End If

wscript.echo "info: computer is " & strComputer

'----------------------------------------------------------------
' comment: continue on
'----------------------------------------------------------------

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

'----------------------------------------------------------------
' example dump...
'----------------------------------------------------------------
' Image Name	     PID Session Name        Session#    Mem Usage User Name		              CPU Time
' ========================= ======== ================ =========== ============ ================================================== ============
' System Idle Process              0	            0         28 K N/A			     0:43:57
' System	           4	            0        240 K NT AUTHORITY\SYSTEM		     0:00:13
' smss.exe	       548	            0        388 K NT AUTHORITY\SYSTEM
'----------------------------------------------------------------

'----------------------------------------------------------------
' comment: define output (dump) file path and name
'----------------------------------------------------------------

temp = objShell.ExpandEnvironmentStrings("%temp%")
outf = temp & "\" & strComputer & ".tsk"
ulist = ""

'----------------------------------------------------------------
' comment: run tasklist to produce dump file
'----------------------------------------------------------------

retval = objShell.Run("cmd /c tasklist /s " & strComputer & " /v >" & outf, 7, True)
wscript.echo "info: exit code was " & retval

'----------------------------------------------------------------
' comment: if dump file found, open and parse it
'----------------------------------------------------------------

If objFSO.FileExists(outf) Then
	wscript.echo "info: reading dump file..."
	On Error Resume Next
	Set objFile = objFSO.OpenTextFile(outf, ForReading)
	If err.Number = 0 Then
		Do Until objFile.AtEndOfStream
			strLine = Trim(objFile.Readline)
			If strLine <> "" Then
				uid = Trim(Mid(strLine, offset, offlen))
				' ignore user "N/A"
				If uid <> "N/A" And Left(uid, 3) <> "===" And Left(uid, 4) <> "User" Then
					If ulist = "" Then
						ulist = Ucase(uid)
					Else
						' only collect unique names
						If InStr(ulist, Ucase(uid)) < 1 Then
							ulist = ulist & vbTab & uid
						End If
					End If
				End If
			End If
		Loop
		objFile.Close
		' display results
		If mode = 1 Then
			wscript.echo Replace(ulist, vbTab, vbCRLF)
		Else
			MsgBox Replace(ulist, vbTab, vbCRLF), 64, "User Processes on " & Ucase(strComputer)
		End If
	Else
		wscript.echo "fail: error (" & err.Number & ") = " & err.Description
	End If
Else
	wscript.echo "fail: dump file not found"
End If

Sub ShowUsage()
	wscript.echo
	wscript.echo "usage: taskdump.vbs computername"
	wscript.echo
End Sub

Script to Auto-Update Your Sysinternals Tools

Jason Faulkner posted a very cool Batch script to freshen your library of Sysinternals tools over at SysAdminGeek.com.  It queries the live.sysinternals.com\tools repository and downloads matching tools in your library.  If you haven't already checked it out, you should (click here).

Here's a version I've done in VBScript.  You can tweak it for your needs and even schedule it to run periodically to keep your tools up to date.

Const livetools = "\\live.sysinternals.com\tools"
Const localtools = "c:\sysinternals"

Set objFSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
wscript.echo "info: connecting to live.sysinternal.com..."
Set objLiveFolder = objFSO.GetFolder(livetools)
If err.Number <> 0 Then
	wscript.echo "fail: unable to connect"
	wscript.quit(1)
End If

If objFSO.FolderExists(localTools) = False Then
	wscript.echo "fail: local folder not found"
	wscript.quit(2)
End If

For each objFile in objLiveFolder.Files
	fileName = objFile.Name
	If objFSO.FileExists(localtools & "\" & fileName) Then
		wscript.echo "info: updating file " & fileName & "..."
		sourceFile = liveTools & "\" & fileName
		targetFile = localTools & "\" & fileName
		objFSO.CopyFile sourceFile, targetFile, True
	End If
Next

Set objFolder = Nothing
Set objFSO = Nothing

If I had more time I'd do this in KiXtart and Powershell, but I'll leave that to someone else.  Enjoy!

MS Security Essentials vNext Silent Install

The new Microsoft Security Essentials is out in beta, and here's how to install it silently using a VBscript.  You still need to tweak it for UAC unless you adapt the command string for use within something else like ConfigMgr.  Enjoy…

const x86 = "mseinstall_en_us_x86.exe"
const x64 = "mseinstall_en_us_amd64.exe"

Function ScriptPath()
    ScriptPath = Replace(wscript.ScriptFullName, "\" & wscript.ScriptName, "")
End Function

Set fso = createobject("Scripting.FileSystemObject")
If fso.FolderExists("c:\Program Files (x86)") Then
    cmd = x64
Else
    cmd = x86
End If

cmdpath = ScriptPath() & "\" & cmd

If fso.FileExists(cmdpath) Then
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run cmdpath & " /s /runwgacheck /o", 1, True
    Set objShell = Nothing
Else
    wscript.echo cmdpath & " not found"
End If

Set fso = Nothing

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