ScriptZilla

Query Installed Apps a Different Way

2011-10-20T08:43:00.000-07:00

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

2011-05-13T13:46:00.001-07:00

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

Template CMD Script for App Installs

2011-02-15T06:04:00.000-08:00

This is obviously bare-bones and will need to be modified to suit specific implementations. There are dozens of ways to execute a software installation, including setup.exe files, extracting ZIP and other archive files, registering DLLs with REGSVR32, and the ugly-ass, vice-grip + screwdriver + duct tape approach where you manually build folder trees, copy files, register DLLs, add and modify registry keys and make or replace shortcuts. Oh, the torture.

EDIT: Updated 7/30/2011 to include errorlevel 3010 (reboot pending)

@echo off
rem ****************************************************************
rem Filename..: setup.cmd
rem Author....: David M. Stein
rem Date......: 07/30/2011
rem Purpose...: install apps in controlled sequence
rem ****************************************************************
rem Additional Notes:
rem
rem ****************************************************************
title Installing Applications
CLS
echo Installing Applications...
SETLOCAL
set APPNAME=MyApplicationSuite2011
set LOG=%TMP%\%APPNAME%_install.log
set MSI=/quiet /norestart
echo %DATE% %TIME% installing... %APPNAME%... >%LOG%
echo %DATE% %TIME% source....... %~dps0 >>%LOG%
echo %DATE% %TIME% target....... %COMPUTERNAME% >>%LOG%
echo %DATE% %TIME% windir....... %WINDIR% >>%LOG%
echo %DATE% %TIME% progfiles.... %PROGRAMFILES% >>%LOG%
echo %DATE% %TIME% temp......... %TMP% >>%LOG%
echo INSTALL LOG: %LOG%
echo ----------------------------------------------- >>%LOG%
echo *** APPLICATION NAME 1 >>%LOG%
echo %DATE% %TIME% info: checking if application is already installed... >>%LOG%
if exist "%ProgramFiles%\FolderName\filename.exe" (
echo %DATE% %TIME% info: ## application is already installed >>%LOG%
) else (
echo %DATE% %TIME% info: ## installing application... >>%LOG%
echo %DATE% %TIME% command = msiexec /i "%~dps0Folder\filename.msi" TRANSFORMS="%~dps0Folder\filename.MST" >>%LOG%
   msiexec /i "%~dps0Folder\filename.msi" TRANSFORMS="%~dps0Folder\filename.MST" %MSI%
   if %errorlevel%==0 (
      echo %DATE% %TIME% info: installation SUCCESSFUL >>%LOG%
   ) else (
      if %errorlevel%==3010 (
         echo %DATE% %TIME% info: installation SUCCESSFUL [reboot pending] >>%LOG%
      ) else (
         echo %DATE% %TIME% file: exit code is %errorlevel% >>%LOG%
         rem Raise error to parent process!!
         exit %errorlevel%
      )
   )
)
rem ------------------------------------------------
rem echo *** APPLICATION NAME 2 >>%LOG%
rem ------------------------------------------------
rem
rem repeat code above with modifications as needed
rem
rem ------------------------------------------------
echo %DATE% %TIME% info: adjusting application folder permissions... >>%LOG%
cacls "%ProgramFiles%\FolderName" /T /E /C /G Users:C
echo ----------------------------------------------- >>%LOG%
echo %DATE% %TIME% info: applying attachmate file association fix... >>%LOG%
REG DEL HKCR\.xxx /f
REG ADD HKCR\.xxx /ve /d "ApplicationClass.ProgName.1" /f
echo ----------------------------------------------- >>%LOG%
echo %DATE% %TIME% info: adjusting registry permissions... >>%LOG%
REGINI.exe %~dps0customregsettings.ini
echo ----------------------------------------------- >>%LOG%
echo %DATE% %TIME% completed! result code: %errorlevel% >>%LOG%
ENDLOCAL
rem Raise error to parent process!!
exit %errorlevel%

Querying Files Using Windows Search with VBScript

2011-02-15T05:49:00.000-08:00

'****************************************************************
' 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 Files by Extension Name

2011-01-26T11:48:00.001-08:00

Const strExtensionsToDelete = "wav,avi,mp3,aac,tmp,bak"
Const testMode = True

Sub RecursiveDeleteByExtension(ByVal strDirectory, strExtensionsToDelete)
  Dim objFolder, objSubFolder, objFile
  Dim strExt
  Set objFolder = objFSO.GetFolder(strDirectory)
  For Each objFile in objFolder.Files
    For Each strExt in Split(Ucase(strExtensionsToDelete),",")
      If Right(Ucase(objFile.Path), Len(strExt)+1) = "." & strExt Then
        wscript.echo "Deleting:" & objFile.Path
        If Not testMode = True Then
          objFile.Delete
        End If
        'Exit For
      End If
    Next
  Next 
  For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteByExtension objSubFolder.Path, strExtensionsToDelete
  Next
End Sub

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
RecursiveDeleteByExtension "d:\downloads", strExtensionsToDelete
wscript.echo "finished!"

Recursively Delete Old Files and Empty Folders

2011-01-26T11:46:00.000-08:00

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

Useful CMD Script Path Expansion Variables

2010-12-12T04:42:00.001-08:00


@echo off
rem http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/percent.mspx?mfr=true
echo displaying various path alias values...
echo %~nx0
echo %comspec%
echo %~d0
echo %~dp0
echo %~dps0
echo %~dpp0
echo %~f0
echo --------------------------------
echo %systemdrive%
echo %systemroot%
echo %windir%
echo %programdata%
echo %programfiles%
echo %userprofile%
echo %allusersprofile%
echo %temp%
echo %commonprogramfiles%
echo %commonprogramfiles(x86)%
echo %appdata%
echo %localappdata%
echo %public%

Uninstall: 3DS Max 2010

2010-12-12T04:39:00.001-08:00

CMD Script…


@echo off
CLS
SETLOCAL
set APPNAME=3dsMax2010
set LOG=%TMP%\%APPNAME%_uninstall.log
set MSI=/quiet /norestart
echo %DATE% %TIME% installing... %APPNAME%... >%LOG%
echo %DATE% %TIME% source....... %~dps0 >>%LOG%
echo %DATE% %TIME% target....... %COMPUTERNAME% >>%LOG%
echo %DATE% %TIME% windir....... %WINDIR% >>%LOG%
echo %DATE% %TIME% progfiles.... %PROGRAMFILES% >>%LOG%
echo %DATE% %TIME% temp......... %TMP% >>%LOG%
echo ----------------------------------------------- >>%LOG%
echo Checking if 3ds Max 2010 is installed >>%LOG%
if exist "%programfiles%\Autodesk\3ds Max 2010" GoTo REMOVE
goto NOTFOUND
goto END
 
:NOTFOUND
echo %DATE% %TIME% 3DS Max 2010 was not detected on this computer
goto END
 
:REMOVE
echo %DATE% %TIME% removing 3ds Max 2010 32-bit >>%TMP%\3dsmax2010uninst.log
echo command = msiexec.exe /x {317AC0C7-FEBF-0409-87A3-4FC70D0ED900} %MSI% >>%LOG%
msiexec.exe /x {317AC0C7-FEBF-0409-87A3-4FC70D0ED900} %MSI%
rem ------------------------------------------------------
echo %DATE% %TIME% removing 3ds Max 2010 32-bit Components >>%TMP%\3dsmax2010uninst.log
echo command = msiexec.exe /x {60A08432-00DD-0409-AC2C-143C75460878} %MSI% >>%LOG%
msiexec.exe /x {60A08432-00DD-0409-AC2C-143C75460878} %MSI%
rem ------------------------------------------------------
echo %DATE% %TIME% removing Backburner 2008.01 >>%TMP%\3dsmax2010uninst.log
echo command = msiexec.exe /x {3D347E6D-5A03-4342-B5BA-6A771885F379} %MSI% >>%LOG%
msiexec.exe /x {3D347E6D-5A03-4342-B5BA-6A771885F379} %MSI%
rem ------------------------------------------------------
echo %DATE% %TIME% removing Tutorials Files >>%TMP%\3dsmax2010uninst.log
echo command = msiexec.exe /x {E551D82D-4D56-4AF7-A2C9-8897D7A0CB00} %MSI% >>%LOG%
msiexec.exe /x {E551D82D-4D56-4AF7-A2C9-8897D7A0CB00} %MSI%
rem ------------------------------------------------------
echo %DATE% %TIME% removing FBX Plugin 2009.4 - 3ds Max 2010 >>%TMP%\3dsmax2010uninst.log
c:
cd "%programfiles%\Autodesk\"
echo command = "FBX\FBXPlugins\2009.4\3ds Max 2010\Uninstall.exe" /S >>%LOG%
"FBX\FBXPlugins\2009.4\3ds Max 2010\Uninstall.exe" /S
goto CLEANUP
goto END
 
:CLEANUP
echo %DATE% %TIME% cleaning up leftover folders and files >>%LOG%
c:
if exist "%programfiles%\Autodesk\3ds Max 2010" (
   echo Removing 3ds Max 2010 sub-folder >>%LOG%
   cd "%programfiles%\Autodesk"
   rd "3ds Max 2010" /s /q
)
if exist "%programfiles%\Autodesk\FBX" (
   echo Removing FBX sub-folder >>%LOG%
   cd "%programfiles%\Autodesk"
   rd "FBX" /s /q
)
rem ------------------------------------------------------
echo %DATE% %TIME% exit code %errorlevel% >>%LOG%
echo %DATE% %TIME% completed >>%LOG%
goto END
 
:END
exit %errorlevel%

A WMI Search-Filter Thingy Script Thingy

2010-10-27T14:53:00.001-07:00

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

2010-10-08T13:57:00.001-07:00

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

2010-09-08T16:28:00.001-07:00

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

2010-09-08T15:26:00.001-07:00

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

2010-08-09T13:43:00.001-07:00

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

2010-07-29T19:20:00.001-07:00

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

2010-07-20T19:18:00.001-07:00

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

2010-06-10T16:19:00.001-07:00

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

Automating Domain Controller Diagnostics, Version 2.0

2010-06-10T15:15:00.001-07:00

I posted a portion of this some time ago, but this week I received the fourth inquiry about the full version, so I guess it’s time to post it. Here goes…

Create a shared folder on each domain controller named "Data$" and assign permissions to only the "Domain Admins" security group. Remove all others from the permissions set.

Install the Support Tools and latest versions of DCDIAG.exe, NETDIAG.exe, and REPADMIN.exe on each domain controller. Make SURE they are the same versions on all of them.

Create a share named "Scripts$" on a central domain member server. Assign permissions to allow "Domain Controllers" security group to have Read permissions. Assign "Domain Admins" to have full control permissions.

Create a share named "Logs$" on a central domain member server (can be the same member server as the one above). Assign permissions to allow "Domain Controllers" security group to have Change permissions (read/write/modify/delete). Assign "Domain Admins" group full control.

Put the script below into the "Scripts$" share.

On each domain controller, create a scheduled task to run the script from the "Scripts$" UNC path at a chosen interval (daily, weekly, monthly, quarterly, whatever) using the local "SYSTEM" account. The "SYSTEM" account operates in the context of the computer (the domain controller on which it is executed) and therefore becomes a member of the "Domain Controllers" group when it attempts to access remote resources (across the LAN/WAN).

When the scheduled task executes the script, it should dump the output files into the local "Data$ share. Another script will be posted soon which crawls through the collected files to produce a summary report of how your domain controllers are doing (with respect to the diagnostics reports for each).

Option Explicit
'**************************************************************
' Filename: dc_diagnostics.vbs
' Author:   David Stein
' Date:     11/19/07
' Purpose:  Run and Report Diagnostics on Domain Controllers

'**************************************************************
' copyright: free for derivative use without any warranties
' provided, explicit or implicit, provided that the above info
' with author name is included (provide attribution)

'**************************************************************
Const DebugMode = True
Const collectionFolder = "\\memberserver\logs$\"
Const alertList    = "EMAIL_ADDRESS@mydomain.local"
Const alertFrom    = "IT REPORTS <donotreply@MYDOMAIN.LOCAL>"
Const mailServer   = "mail.mydomain.local"
Const localShare   = "Data$"

Const bRunDCDIAG   = True
Const bRunNETDIAG  = True
Const bRunREPADMIN = True
Const DeleteTempFiles = False
Const SendAlerts   = True
Const SendOnErrorsOnly = True

Const bVerbose = False

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

Dim objShell, objFSO, strServerName, strServerData
Dim strMonthNum, strDayNum, strYear
Dim datestamp, dcDiagReport, netDiagReport, repAdminReport
Dim statlog, errorCount
errorCount = 0

'--------------------------------------------------------------
' diagnostics status display
'--------------------------------------------------------------

Sub DebugPrint(code, strval)
    If DebugMode Then
        wscript.echo Now & vbTab & code & vbTab & strval
    End If
End Sub

'--------------------------------------------------------------
' run DCDIAG report
'--------------------------------------------------------------

Sub RunDCDiag()
    Dim cmdstr
    cmdstr = "%comspec% /c dcdiag >" & dcDiagReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "dcdiag process completed."
End Sub

'--------------------------------------------------------------
' run NETDIAG report
'--------------------------------------------------------------

Sub RunNetDiag()
    Dim cmdstr
    cmdstr = "%comspec% /c netdiag >" & netDiagReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "netdiag process completed."
End Sub

'--------------------------------------------------------------
' run REPADMIN /SHOWREPS report
'--------------------------------------------------------------

Sub RunRepAdmin()
    Dim cmdstr
    cmdstr = "%comspec% /c repadmin /showreps >" & repAdminReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "repadmin process completed."
End Sub

'--------------------------------------------------------------
' upload report files to remote collection point
'--------------------------------------------------------------

Sub CollectReports()
    DebugPrint "info", "uploading reports to remote collection point..."
    
    If bRunDCDIAG Then
        If objFSO.FileExists(dcDiagReport) Then
            DebugPrint "info", "uploading dcdiag report to collection point..."
            'debugprint "*** " & dcDiagReport
            objFSO.CopyFile dcDiagReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local dcdiag report file..."
                objFSO.DeleteFile dcDiagReport
            End If
            DebugPrint "info", "dcdiag report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "dcdiag report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: dcdiag report failure!"
            DebugPrint "error", "dcdiag report file not found."
            errorCount = errorCount + 1
        End If
    End If

    If bRunNETDIAG Then
        If objFSO.FileExists(netDiagReport) Then
            DebugPrint "info", "uploading netdiag report to collection point..."
            objFSO.CopyFile netDiagReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local netdiag report file..."
                objFSO.DeleteFile netDiagReport
            End If
            DebugPrint "info", "netdiag report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "netdiag report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: netdiag report failure!"
            DebugPrint "error", "netdiag report file not found."
            errorCount = errorCount + 1
        End If
    End If

    If bRunREPADMIN Then
        If objFSO.FileExists(repAdminReport) Then
            DebugPrint "info", "uploading repadmin report to collection point..."
            objFSO.CopyFile repAdminReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local repadmin report file..."
                objFSO.DeleteFile repAdminReport
            End If
            DebugPrint "info", "repadmin report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "repadmin report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: repadmin report failure!"
            DebugPrint "error", "repadmin report file not found."
            errorCount = errorCount + 1
        End If
    End If
End Sub

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

'--------------------------------------------------------------
' function: return padded string using parameters
'      arg: strval (string - value being padded)
'      arg: intLen (integer - string length to meet)
'      arg: sChar  (string - value to append or prefix to string)
'      arg: sSide  (string - side of string to pad, "L" or "R")
'--------------------------------------------------------------

Function PadString(strval, intLen, sChar, sSide)
    Dim retval
    retval = Trim(strval)
    Do While Len(retval) < intLen
        If Ucase(sSide) = "L" Then
            retval = sChar & retval
        Else
            retval = retval & sChar
        End If
    Loop
    PadString = retval
End Function

'--------------------------------------------------------------
' main subroutine
'--------------------------------------------------------------

Sub Main()
    Dim msgSub, msgBody
    Set objShell = Wscript.CreateObject("Wscript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    strServerName = objShell.ExpandEnvironmentStrings("%computername%")
    strServerData = "\\" & strServerName & "\" & localShare & "\"

    statlog = ""

    strMonthNum = DatePart("m", Now)
    If Len(strMonthNum) = 1 Then
        strMonthNum = "0" & strMonthNum
    End If

    strDayNum   = DatePart("d", Now)
    If Len(strDayNum) = 1 Then
        strDayNum = "0" & strDayNum
    End If

    strYear     = DatePart("yyyy", Now)
    datestamp   = strMonthNum & strDayNum & Right(strYear,2)

    DebugPrint "info", "datestamp = " & datestamp
    DebugPrint "info", "servername = " & strServerName

    If bRunDCDIAG Then
        dcDiagReport   = strServerData & strServerName & "_dcdiag.txt"
        RunDCDiag()
    End If

    If bRunNETDIAG Then
        netDiagReport  = strServerData & strServerName & "_netdiag.txt"
        RunNetDiag()
    End If

    If bRunREPADMIN Then
        repAdminReport = strServerData & strServerName & "_repadmin.txt"
        RunRepAdmin()
    End If

    CollectReports()

    If SendAlerts = True Then
        If SendOnErrorsOnly = True Then
            ' send alert only when errors occur...

            If errorCount > 0 Then
                msgSub = "DC Status Check: ERROR - " & strServerName
                msgBody = "DC Status Check: ERROR - " & strServerName & vbCRLF & _
                    "------------------------------" & vbCRLF & _
                    "One or more diagnostic reports could not" & vbCRLF & _
                    "be generated or collected from " & strServerName & vbCRLF & _
                    "------------------------------"
                SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
            End If
        Else
          ' send alert for any status, not just errors...

            msgsub = "DC Status Check: SUCCESS - " & strServerName
            If bVerbose Then
                msgbody = strServerName & " Diagnostics Process Report" & vbCRLF & _
                    "----------------------------" & vbCRLF & _
                    "Diagnostics reports have been processed on this " & _
                    "domain controller with the following results. " & _
                    "Reports have been uploaded to the central collection " & _
                    "point for further processing." & vbCRLF & _
                    "----------------------------" & vbCRLF & statlog
            Else
                msgbody = strServerName & " Diagnostics Process Report" & vbCRLF & _
                    "----------------------------" & vbCRLF & _
                    "Diagnostics reports were uploaded successfully."
            End If
            SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
        End If
    End If

    Set objFSO = Nothing
    Set objShell = Nothing
End Sub

'--------------------------------------------------------------

Call Main()

wscript.Quit

All Dried Up?

2010-05-29T14:16:00.001-07:00

I haven’t forgotten about this blog. But I have been struggling to rationalize its existence in the face of so many great scripting blogs out there. I thought a unique and possibly helpful niche would be inter-language scripting. Hence the scripts which leverage two or more languages to accomplish a single task or goal. But it doesn’t seem this is of much use to anyone. Indeed, after looking at it several times, it looks more like an oddity or some exercise in cleverness, rather than something of geniune use to anyone. If you can think of something that might help focus this I’m all ears. Otherwise, I’m just going to let this blog ferment for a while on its own.

Converting “YYYYMMDDHHMMSS” Dates

2010-04-05T13:51:00.001-07:00

Sometimes you end up dealing with date values which are in the form of “YYYYMMDDHHMMSS:00000-GMT” (where “GMT” is a multiple of hours * 60 deviation from Greenwich Mean Time). Formatting those into usable date values can be done several ways. This is just one way. And I threw in a somewhat not-so-obvious KiXtart version of this function for the hell of it.

VBScript version

Function mDate(strDate, format)
    Dim tmp, retval
    On Error Resume Next
    Select Case Lcase(format)
        Case "short":
            tmp = Mid(strDate, 5, 2) & "/" & _
                Mid(strDate, 7, 2) & "/" & _
                Left(strDate,4)
            retval = FormatDateTime(tmp, vbShortDate)
        Case "datetime":
            tmp = Mid(strDate, 5, 2) & "/" & _
                Mid(strDate, 7, 2) & "/" & _
                Left(strDate,4) & " " & _
                Mid(strDate, 9, 2) & ":" & _
                Mid(strDate, 11, 2) & ":" & _
                Mid(strDate, 13, 2)
            retval = FormatDateTime(tmp, vbShortDate) & " " & _
            FormatDateTime(tmp, vbLongTime)
        Case "long":
            tmp = Mid(strDate, 5, 2) & "/" & _
                Mid(strDate, 7, 2) & "/" & _
                Left(strDate,4) & " " & _
                Mid(strDate, 9, 2) & ":" & _
                Mid(strDate, 11, 2) & ":" & _
                Mid(strDate, 13, 2)
            retval = FormatDateTime(tmp, vbLongDate)
    End Select
    mDate = retval
End Function


wscript.echo mDate("20100305132705.00000-520", "short")
wscript.echo mDate("20100305132705.00000-520", "long")
wscript.echo mDate("20100305132705.00000-520", "datetime")

KiXtart Version

Function FormatDateTime($v, $f)
    Dim $sc, $result
    $sc = CreateObject("ScriptControl")
    $sc.Language = "vbscript"
    $result = $sc.Eval('FormatDateTime("'+$v+'",'+$f+')')
    $sc = 0
    $FormatDateTime = $result
EndFunction

Function mDate($strDate, $format)
    Dim $tmp, $retval
    Select
        Case $format = "short"
            $tmp = Substr($strDate, 5, 2) + "/" +
                Substr($strDate, 7, 2) + "/" +
                Left($strDate,4)
                $retval = $tmp
        Case Lcase($format) = "datetime"
            $tmp = Substr($strDate, 5, 2) + "/" +
                Substr($strDate, 7, 2) + "/" +
                Left($strDate,4) + " " +
                Substr($strDate, 9, 2) + ":" +
                Substr($strDate, 11, 2) + ":" +
                Substr($strDate, 13, 2)
            $retval = $tmp
        Case Lcase($format) = "long"
            $tmp = Substr($strDate, 5, 2) + "/" +
                Substr($strDate, 7, 2) + "/" +
                Left($strDate,4)
                $tmp = FormatDateTime($tmp, "vbLongDate")
            $retval = $tmp
    EndSelect
    $mDate = $retval
EndFunction


? mDate("20100305132705.00000-520", "short")
? mDate("20100305132705.00000-520", "long")
? mDate("20100305132705.00000-520", "datetime")

Yes, the KiXtart version is somewhat “cheating” but who cares. It works, and it saves me a little bit of coding. The performance overhead delta is near-zero, unless you’re running on 1990’s hardware.

A Portable LISP Interpreter?

2010-03-30T18:42:00.001-07:00

The very first programming language I touched was GW-BASIC, then COBOL, then QBASIC, then FORTRAN, then LISP and PASCAL and C++ and Java, and on to newer things like Visual Basic, ASP, PHP and Javascript, XSLT and so on. In that chronological order, actually. But of all those, the one that grabs my attention when I hear its name spoken is LISP. I spent almost 15 years focusing my programming time on AutoLISP, Visual LISP and dabbling quite a lot with Franz, XLISP and CLOS, but kept going back to Visual LISP (or “VLISP”) because of it’s strong association with graphical environments (AutoCAD). The combination that Vital LISP brought to the table from the work of Basis Software, later acquired by Autodesk, opened up a whole new world for joining the flexibility and power of AutoLISP with the COM fabric exposed by Windows.

I always loved the way AutoCAD and the VLISP engine provided the substrate for running scripts within AutoCAD much like how Java apps run on the JRE or how PowerShell runs on .NET CLR. But actually, it dawned on me that a more ideal solution is what you get with KiXtart. The engine is self-contained and extremely lean and responsive. Robust and Streamlined, would be two words I would use to describe it.

Unlike WSH or PowerShell, you don’t have to install anything in order to start executing KiXtart scripts. You just need access to the Kix32.exe runtime and it just “goes”. The runtime can be across the network and you can even invoke a local script using a UNC path to the runtime. It’s ridiculously easy to sit a computer “A”, and run a script sitting on computer “B” using the Kix32.exe on computer “C”, and it works fine. Ruud van Velsen indeed deserves accolades for not only making this work so well, but for maintaining the vision and direction that keeps it alive today. Indeed, the KiXtart community is as strong as ever and the online presence is simply amazing.

Why couldn’t there by a similar approach to a LISP runtime? Is there such a thing? Every LISP runtime I’ve seen requires labor to set up and there’s the added issues of which dialect is used (XLISP, Franz, Common, NewLISP, etc.). A stripped-down core library would be fantastic. Something like AutoLISP but without the AutoCAD-specific functions. Replace those with added file system, registry, environment, process and WMI interfaces, and the rest tied to COM or even .NET, and, well, geez. I’d be happy. I wish I had time to build such a beast. If anyone has a project going on this, I’d be more than happy to help you test it out and provide feedback. I’m sure this is a tall order though.

Just a thought. Ok, I’m going to bed now.

Splitting the Splitter

2010-03-30T18:27:00.001-07:00

Here’s a cute little oafish trick that has helped me out more than a few times. You run an inline Split/Array operation to mimic what the LISP cdr and cadr, etc. functions do, which is to pick out a logical subordinate within a string construct which represents a paired list (logically speaking).

myString = “1=Apple,2=Banana,3=Cherry,4=Grapes”

item2 = Split(Split(myString, “,”)(1), “=”)(1)

This will return “Banana”. You can continue nesting (or un-nesting, if you will) obviously, but without error checking this can become quite dangerous. But it is nice to see a use for something like this. Now, if only there were a simple, easy way to mimic mapcar and apply as well.

Query Scheduled Tasks The Hard Way

2010-03-18T13:10:00.001-07:00

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

2010-03-04T19:18:00.001-08:00

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

Now vs Now: VBScript and KiXtart

2010-03-02T17:28:00.001-08:00

Date values are a very common aspect to script writing and most any programming situation in general. How dates are stored, presented and manipulated varies widely from one programming language to another.

Let’s look at the “Now” function included with Windows Scripting Host’s VBScript. This function returns the current date and time in “mM/dD/YYYY hH:MM:SS XM” format.

In case you’re wondering what the hell “mM” and “hH” imply: they imply zero-trim numbers. In other words 8:01:42 AM is not stored as 08:01:42 AM. The leading zero is omitted. Same for month (“mM”), and day (“dD”) as well.

But KiXtart, one of my all-time favorite scripting languages, handles date values quite differently. At first it may seem almost identical, but as you pick things apart you start to see the deltas.

(kixtart)
? @date+" "+@time
>> 2010/03/02 08:20:01

(vbscript)
Wscript.echo Now
>> 3/2/2010 8:20:01 AM

When you compare the output of each result above, not only are the order of YYYY/MM/DD flipped from M/D/YYYY, but the zero-trim is not used with KiXtart.  Is this “bad” or “wrong”?  No.  Just different.  There are times when this is actually a very handy benefit to have as the default.  But also notice that the time stamp is formatted differently.  And the AM/PM suffix is not shown.

So, how can we make KiXtart do it the way VBScript does it?  This is assuming you need to make it do that, of course, which you may not.  But this is for demonstration purposes, so cut me some slack - if you will.

Below are two examples for producing a VBScript formatted “Now” result.  The first one uses a rudimentary date->string parsing technique.  The second does a cop-out and simply knocks on the door of the ScriptControl COM interface to make VBScript do the work and hand back a result.  The performance overhead is about the same at this scalar load level.  If you start piling in a lot more, the results can shift the balance of performance in either direction, depending upon the nature of what your doing (math, string, date, or object management tasks).

------------------------------------------------
Break ON

Function Now1()
    $today = ""+@monthno+"/"+@mdayno+"/"+@year
    $arrTime = Split(@time, ":")
    $hour = $arrTime[0]
    $min  = $arrTime[1]
    $sec  = $arrTime[2]
    If Int($hour) < 12
        $sfx = "AM"
    Else
        $sfx = "PM"
    EndIf
    $Now1 = $today+" "+Int($hour)+":"+$min+":"+$sec+" "+$sfx
EndFunction

Function Now2()
    Dim $sc, $result
    $sc = CreateObject("ScriptControl")
    $sc.Language = "vbscript"
    $result = $sc.Eval('Now()')
    $sc = 0
    $Now2 = $result
EndFunction

? "Kix: "+Now1()
? "VBs: "+Now2()

The results should be identical. Could I/you refactor the Now1() function to nest statements and further compact the code? Sure. Does it buy any performance gains? Not really.

Consider this variation…

Function Now1()
    $today = ""+@monthno+"/"+@mdayno+"/"+@year
    $arrTime = Split(@time, ":")
    If Int($arrTime[0]) < 12
        $Now1 = $today+" "+Int($arrTime[0])+":"+$arrTime[1]+":"+
            $arrTime[2]+" AM”
    Else
        $Now1 = $today+" "+Int($arrTime[0])+":"+$arrTime[1]+":"+
            $arrTime[2]+" PM”
    EndIf
EndFunction

More compact for sure. But there’s a hidden, even if trivial price: The repeated use of an array index request. There are other ways to compact/refactor this of course, but for such few lines of code the pay-offs are difficult to justify beyond elegant coding form (aesthetics). Oh well, blah blah blah. What do I know anyway. I just finished a huge “breakfast-for-dinner” and was then told my car repairs would cost way too much, so I’m blabbering to let off steam. I hope you enjoyed this.

Automate DCDiag on your Domain Controllers

2010-02-28T06:06:00.001-08:00

I’ve been doing this for (literally) years. About 7 years to be exact. You can do this with NETDIAG, REPADMIN and several other “diagnostic” utilities that work from the command line.

The idea is to wrap the diagnostic operation inside a script so that you can capture the output in a text file, then turn around and open the text file to parse it for what you want. Then you can do almost anything with that information:

Generate a summary report file
Send the results into a database table
Send the results as an e-mail report
and on and on and on…

There are several ways to set this up as well. For this example I’m using a VBScript file, a domain user (aka “service” or “proxy”) account, and the Windows Task Scheduler on a Windows Server 2008 domain controller. This works just fine on Windows Server 2003 and Windows Server 2008 R2 as well.

The Script:

Const logFileName = "x:\logs\dcdiag.log"
Const ForReading = 1
Const ForWriting = 2

Dim objShell, objFSO, computer, domain, cmdstr
Dim objFile, testLabel, passed, failed

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

computer = Ucase(objShell.ExpandEnvironmentStrings("%computername%"))
domain   = Ucase(objShell.ExpandEnvironmentStrings("%userdnsdomain%"))

cmdstr = "cmd /c dcdiag /v >" & logFileName

objShell.Run cmdstr, 1, True

If objFSO.FileExists(logFileName) Then
    passed = 0
    failed = 0
	
    Set objFile = objFSO.OpenTextFile(logFileName, ForReading)

    Do Until objFile.AtEndOfStream
        strLine = objFile.Readline
    
        testLabel = Mid(strLine, 36)

        If InStr(1, testLabel, computer & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, computer & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        ElseIf InStr(1, testLabel, domain & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, domain & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        Else
            '
        End If
    Loop
    objFile.Close
    Set objFSO = Nothing

    wscript.echo "Passed " & passed & " tests"
    wscript.echo "Failed " & failed & " tests"	
Else
    wscript.echo "fail: log file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing

The Explanation:

The top section defines the path and filename for the output file we’re going to capture and analyze. Next we define some variables. Then we instantiate the Shell and FileSystemObject object interfaces.

We use the Shell object to fetch the name of the computer and the domain name. We need those to help sift through the output file and find the matching lines we want to look at. The Shell object is also used to run the DCDIAG command via the “Run” method.

After running the shell command, we then check if the output file exists. If it does, we open it and read through it line-by-line looking for matching strings. Within each matching string we look for “passed” or “failed” and count them up as well as echo them to the command prompt.

At the end we mop up and then display the tally for passed and failed tests.

Important Note: This is only ONE form of doing this. There is no limit to what you CAN do. For example, instead of echoing the testLabel contents, we could concatenate them into a report text block and send it via CDOsys (e-mail) or stuff it into a database via ADO or XML or generate an XML or HTML report, or even stuff it directly into a Microsoft Word or Excel document. The possibilities are endless.

If anyone is interested in variations on this just post a comment and I’ll see what I can do. I hope this helps someone out there?

SQL Case Statements for Sum Operations

2010-02-18T15:35:00.001-08:00

SELECT DISTINCT TOP (100) PERCENT
      room_type, COUNT(room_id) AS rooms, SUM(room_area) AS sqft,
      CASE
                WHEN room_type = 1 THEN 'Office'
                WHEN room_type = 2 THEN 'Storage'
                WHEN room_type = 3 THEN 'Equipment'
                WHEN room_type = 4 THEN 'Computer'
                WHEN room_type = 5 THEN 'Medical'
                WHEN room_type = 6 THEN 'Public'
                ELSE 'Unknown'
        END AS TypeName
FROM dbo.tbl_rooms
GROUP BY room_type
ORDER BY room_type

Returns something like the following:

room_type rooms     sqft
Office      210    6,540
Storage      54      983
Equipment    86    1,002
Computer      3      852
Medical     640   39,553
Public        6   10,401
Unknown       0        0

VBScript ADO with XML and CSV Data Files

2009-12-31T06:57:00.001-08:00

I was poking around to find a way to read CSV, TXT (various delimiters) through VBScript for use in scripted data migrations, as well as to render the data in ASP, and found some interesting things. I have to give credit to [http://www.mombu.com/microsoft/scripting-wsh/t-query-xml-file-with-ado-in-wsh-131431.html] for the XML example. I only modified it slightly to fit in with how I tend to code ADO processes. I also would like to applaud the efforts of Connection Strings.com for their fantastic reference site for connection information for almost anything that can possibly store information.

Reading XML Data

Const dsn = "Provider=MSDAOSP;Data Source=MSXML2.DSOControl;"
Const adChapter = 136

Dim conn, rs
Dim iLevel : iLevel = 0

Set conn = CreateObject( "ADODB.Connection" )
Set rs = CreateObject( "ADODB.Recordset" )

conn.Open dsn

rs.Open CreateObject( "WScript.Shell" ).CurrentDirectory + _
    "\test.xml", conn

WalkHier iLevel, rs

rs.Close
conn.Close

Sub WalkHier(ByVal iLevel, ByVal rs)
    iLevel = iLevel + 1
    Dim PriorLevel : PriorLevel = iLevel
    Dim i, adoChildRS
    While Not rs.EOF
        For i = 0 To rs.Fields.Count - 1
            If rs.Fields(i).Name <> "$Text" Then
                If rs.Fields(i).Type = adChapter Then
                    Set adoChildRS = rs.Fields(i).Value
                    WalkHier iLevel, adoChildRS
                Else
                    wscript.echo iLevel & ": rs.Fields(" & i & ") = " & _
                        rs.Fields(i).Name & " = " & rs.Fields(i).Value
                End If
            End If
        Next
        rs.MoveNext
    Wend
    iLevel = PriorLevel
End Sub

Reading CSV Data

dsn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='s:\scripts\';Extended Properties=""text;HDR=Yes;FMT=Delimited(,);"""

query = "SELECT * FROM test.csv"

Set conn = CreateObject("ADODB.Connection")
Set cmd  = CreateObject("ADODB.Command")
Set rs   = CreateObject("ADODB.Recordset")

conn.Open dsn

rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockReadOnly

Set cmd.ActiveConnection = conn

cmd.CommandType = adCmdText
cmd.CommandText = query
rs.Open cmd

If Not(rs.BOF And rs.EOF) Then
    Do Until rs.EOF
        For i = 0 to rs.Fields.Count - 1
            wscript.echo rs(i).name & " = " & rs(i).value
        Next
        rs.MoveNext
    Loop
Else
    wscript.echo "error: no records found"
End If
rs.Close
conn.Close
Set rs = Nothing
Set cmd = Nothing
Set conn = Nothing

Convert INI to XML with KiXtart

2009-12-25T07:14:00.001-08:00

Sometimes you may want/need to read a standard INI data file and output it to an XML format. There are several ways to do this, but here is just one. You’ll need KiXtart 4.61 in order to use the Replace() function. Enjoy (and Merry Christmas!)

KiXtart Code

Break ON
; requires KiXtart 4.61 or later!!!
If @kix <= "4.60"
    ? "this script requires 4.61 or later!"
    Exit
EndIf

$strFileName = "s:\scripts\test.ini"

$quote = Chr(34)
$tab = Chr(9)

Dim $linecount, $fHandle, $strLine, $outer, $keyset, $subkeyformat
Dim $name, $value

$subkeyFormat = 1
$fHandle = FreeFileHandle()
$outer = ""

If Open($fHandle, $strFileName) = 0
    $strLine = ReadLine($fHandle)
    While @error = 0
        Select
            Case Left($strLine,1) = "["
                $outer = Replace(Replace($strLine, "]", ""), "[", "")
                ? "<$outer>"
            Case InStr($strLine, "=") <> 0
                $keyset = Split($strLine, "=")
                $name  = $keyset[0]
                $value = $keyset[1]
                If $subkeyFormat == 1
                    ? "$tab"
                Else
                    ? "$tab<$name>$value</$NAME>"
                EndIf
            Case 1
                If $outer <> ""
                    ? "</$OUTER>"
                    $outer = ""
                EndIf
        EndSelect
        $strLine = ReadLine($fHandle)
    Loop
    $=Close($fHandle)
EndIf

Scraping Web Pages with VBScript and KiXtart

2009-12-25T06:29:00.001-08:00

Here’s a quick example of how to scrape HREF and IMG strings from a web page using VBScript and KiXtart with the InternetExplorer.Application COM object. Thanks to Paul Sadowski for the basis of the VBScript example (with only very slight modifications).

VBScript Code

url = "http://www.textpad.com"

Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate url

Wscript.Echo "DOCUMENT HYPERLINKS" & vbCRLF
Do Until ie.ReadyState = 4
    Wscript.Sleep 2
Loop
For each link in ie.Document.Links
    Wscript.Echo link, link.InnerText
Next

Wscript.Echo "------------------------------------"
Wscript.Echo "DOCUMENT IMAGE TAGS" & vbCRLF

For each img in ie.Document.Images
    Wscript.Echo img.Src
Next
  
ie.Quit

KiXtart Code

break ON

$url = "http://www.textpad.com"

$ie = CreateObject("InternetExplorer.Application")
$ie.Navigate($url)
? "DOCUMENT HYPERLINKS"

While $ie.ReadyState <> 4
    Sleep 2
Loop

For each $link in $ie.Document.Links
    ? $link+"="+$link.InnerText
Next

? "DOCUMENT IMAGE TAGS"

For each $pix in $ie.Document.Images
    ? $pix.Src
Next
  
$ie.Quit()

Merry Christmas!

2009-12-25T05:55:00.001-08:00

I would like to wish everyone who visits my blog a very Merry Christmas! Thank you for taking the time to read my drivel and post feedback on occassion. I hope you have a really nice Christmas weekend and may you enjoy time with your family, and friends.

SQL Script Exports

2009-11-28T06:45:00.001-08:00

Until the day comes when Microsoft SQL Server SSMS provides the same info export features that PHPMyAdmin provides, we’re stuck with the right-click “Script-To…” feature (unless you buy a third-party utility, or write your own SMO or ADOX/ADO scripts, etc.), I tripped and fell over a rather simple feature that I didn’t know existed. You can export multiple table schemas in one operation by simply clicking on the “Tables” object in the Object Explorer panel, then right-click and choose “Script-To: CREATE” and save to the clipboard/file/query window. It works the same as individual exports, only that this does all of the Tables at once. You can do the same by clicking on the “Views” object as well.

If you already knew this, just chuckle, shrug and blow it off and move on. No harm done. I wasn’t aware of this, so I figured at least one other person might not know this as well.

KiXtart: Using FSO File.ReadAll()

2009-11-19T19:07:00.001-08:00

Another example of making use of one scripting language or API from another. In this case, I’m calling on the FileSystemObject API to invoke the ReadAll() function on a file from a KiXtart script. Just to show that there are all sorts of things you can do like this…

function ReadFile($filepath)
    $fso = CreateObject("Scripting.FileSystemObject")
    if exist($filepath)
        $file = $fso.OpenTextFile($filepath)
        $text = $file.ReadAll()
        $file.Close()
        $file = 0
    else
        ? "error: file not found"
    endif
    $readfile = $text
endfunction

; example...

? readfile("c:\myfile.txt")

Restarting a Remote Service (VBScript vs PowerShell)

2009-11-14T21:30:00.001-08:00

This kind of goes along with my rants about PowerShell examples being pretty much reformatted VBScript WMI code examples, but regardless, PowerShell does provide a more abbreviated code environment. The PowerShell code example was derived from a posting by Thomas Lee on the PowerShell blog on restarting a DNS service on a remote computer. I had a VBScript example which does the same with the Spooler service, so I simply adapted Thomas’ code to support and apples-to-apples comparison. As you can see, they are very similar. In fact, the KiXtart version looks almost identical to both as well.

VBScript Example

strComputer = "server1" 
wscript.echo "Restarting Spooler Service on: ",strComputer

Set wmi = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set ret = wmi.ExecMethod("Win32_Service.Name='Spooler'", "StopService")
If ret.ReturnValue = 0 Then
    wscript.echo "Spooler Service stopped"
Else
    wscript.echo "Spooler Service not stopped"
End If

Set ret = wmi.ExecMethod("Win32_Service.Name='Spooler '", "StartService")
If ret.ReturnValue = 0 Then
    wscript.echo "Spooler Service started"
Else
    wscript.echo "Spooler Service not started"
End If

PowerShell Example

$strComputer = "server1" 
"Restarting Spooler Service on: $strComputer" 
  
# get the service object
$svc = gwmi Win32_Service -computer $strComputer | where {$_.name -eq "Spooler"} 
  
# stop the service
$ret = $svc.StopService() 
if ($ret.ReturnValue -eq 0) {"Spooler Service stopped"} 
else {"Spooler Service not stopped"} 
  
# start the service
$ret = $svc.StartService() 
if ($ret.ReturnValue -eq 0) {"Spooler Service started"} 
else {"Spooler Service not started"}

Am I a VMWare Guest Machine or Not?

2009-11-01T05:43:00.001-08:00

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

Windows 7 Clean Install using Upgrade Media

2009-10-25T10:41:00.001-07:00

Just a slightly different spin to the post by Paul Thurrott about performing a clean install of Windows 7 using “upgrade” media without having to install XP or Vista first. This just wraps the steps inside a .BAT script. Make sure you read Paul’s article first or you’ll be lost. Be sure to run this from a CMD console that was launched via “Run as Administrator” or it won’t work…

@echo off
rem the following line between the divider lines should NOT wrap!
rem --------------------------------
REG ADD "HKLM/Software/Microsoft/Windows/CurrentVersion/Setup/OOBE/" /v MediaBootInstall /d 1 /t REG_DWORD /f
rem --------------------------------
echo Registry key value has been set.
pause
slmgr /rearm
echo Activation skip-rearm has been set.
echo Press ENTER to reboot your computer now...
pause
shutdown -r -f -t 2

Using Twitter to Control Your Computer

2009-10-17T14:42:00.001-07:00

I’ve blogged about this before, but not with a lot of detail. So here goes.

In my previous post, I explained how to setup a “system” that has your computer sending a DM (Direct Message) Tweet to your Twitter account. But in this scenario I’m turning it around, so that you will Tweet your computer and have it perform actions based on what you Tweet.

What you do with this is up to you. Anything you can do with a script is fair game. Anything. The script will reside on your computer. You will send a DM to a Twitter account, which your computer will monitor on a scheduled recurrence. Your script will read and parse the DM container and look for specific phrases that it is set to recognize and will execute a task accordingly. Simple enough? Good. I thought so.

Ingredients:

A Twitter Account
Another Twitter Account
A List of Things You Intend to Ask Your Computer To Do
A Script
A Scheduled Task

A Twitter Account

This is YOUR Twitter account actually. You will need this in order to send a DM (Direct Message) Tweet to your computer, which requires…

Another Twitter Account

This is the account your computer will monitor. Remember to lock it down so only your “other” Twitter account can access it.

A List of Things for Your Computer To Do

You need to sit down and make a list of what specific tasks you want to be able to request of your computer. Yes, you COULD make it so you Tweet any shell operation and have it blindly execute that, but trust me: THAT IS DANGEROUSLY STUPID. In fact, so stupid, you should have your balls stomped with ice climbing boots in a rowdy Irish pub just for thinking it. Need some pointers? Here’s a simple list to get you started:

Reboot or Shutdown a computer
Disable a User Account
Add/Remove A User to/from a Group
Start/Stop a Service
Start a Batch or Backup Job

For the first example, I’m going to simply have the computer tweet me back. That way I know the plumbing is working and the toilets flush properly. To do this, I’m going to make a script that reads my DM list and parses it for a specific phrase. When that phrase is found, it will simply tweet me back (by DM) to let me know it got it.

A Script

The script I’m using for this example is written in VBscript, but any language/platform will work fine as long as it can invoke the Twitter API. This script will access my Computer Twitter account, fetch the DM queue, iterate through it for messages containing a specific phrase of “TWEET_ME_BACK @userid” and then simply turn around and send a DM to the “@userid” that sent it (which, in this situation, is me).

'----------------------------------------------
' filename: twitter_monitor.vbs
' author: skatterbrainz
' http://scriptzilla.blogspot.com
' give props, don't rip me off please?
'----------------------------------------------
Const username = "Computer_TwitterName"
Const password = "Computer_TwitterPassword"
Const replyTo  = "My_Twitter_Account"

Function Twitter_Get_Direct(strUser,strPass)
    wscript.echo "querying for direct messages..."
    Dim oXml, strTwitterURL : strTwitterURL = "http://twitter.com/direct_messages.xml"
    Set oXml = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    oXml.Open "GET", strTwitterURL, False, strUser, strPass
    oXml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXml.Send()
    Twitter_Get_Direct = oXml.responseText
    Set oXml = Nothing
End Function

result = Twitter_Get_Direct(username, password)

'----------------------------------------------
' if direct messages were found, iterate them
'----------------------------------------------

If Trim(result) <> "" Then
    wscript.echo "direct messages were found!"
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = "false"
    xmlDoc.loadXML(result)
    For each x in xmlDoc.documentElement.childNodes
        msg = x.Text
        If InStr(1, Ucase(msg), "TWEET ME BACK") <> 0 Then
            id = Left(msg, 9)
            wscript.echo id, ": ", Mid(Msg, 20)
            wscript.echo "sending tweet-dm..."
            TweetBack()
            DeleteDM id
        End If
    Next
End If

'----------------------------------------------
' send tweet via direct-message
'----------------------------------------------

Sub TweetBack()
    Dim retval, strMsg : strMsg = "I got your message!"
    Dim oXml, strTwitterURL : strTwitterURL = "http://twitter.com/direct_messages/new.xml"
    Set oXml = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    oXml.Open "POST", strTwitterURL, False, username, password
    oXml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXml.Send "text=" & strMsg & "&user=" & replyTo
    retval = oXml.responseText
    Set oXml = Nothing
End Sub

'----------------------------------------------
' delete a direct-message using the id number
'----------------------------------------------

Sub DeleteDM(id)
    Dim retval
    Dim oXml, strTwitterURL : strTwitterURL = "http://twitter.com/direct_messages/destroy/" & id & ".xml"
    Set oXml = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    oXml.Open "POST", strTwitterURL, False, username, password
    oXml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXml.Send()
    retval = oXml.responseText
    Set oXml = Nothing
End Sub

Note that in the iteration section of code above I invoke the XMLDOM object to parse the direct_message result. This is because it returns a single XML stream that contains all of the direct messages.

A Scheduled Task

Because your computer needs to read the Twitter account DM queue, it needs to “poll” for it using a recurrent task. The easiest way to do this is by creating a scheduled task. Each time the task is initiated, it will execute the script and go back to sleep until it’s scheduled to run again. I’m using Windows 7 for this example, so here goes…

Click on the Windows button (formerly “Start” button)

Type in SCHED and as soon as “Task Scheduler” appears at the top, press Enter.

Click on Task Scheduler Library in the left-hand panel

Right-click on Task Scheduler Library and select “Create Task”

In the Name box, enter “Monitor Twitter Account”

In the Description box, enter “Monitor Twitter account ___ for Direct Messages to parse” (fill-in your computer Twitter account name).

Select “Run whether user is logged on or not”

Click “Change User or Group” button, enter “SYSTEM” and click “Check Names”

Once the name is underlined, click OK. You should see “NT AUTHORITY\SYSTEM” in the user account name box. (see Fig. 1)

Click the Triggers tab.

Change the “Repeat task every:” to “15 Minutes”

Check “Stop task if it runs longer than:” and set it to “14 Minutes” (see Fig. 2)

Click OK, to return to the Create Task form.

Click the Actions tab, click the New button

Enter “cscript” for the program. Enter “/nologo c:\scripts\monitor_twitter.vbs” in the arguments box (see Fig. 3, and 4)

Click OK to save the new Task

Fig. 1

Fig. 2

Fig. 3

Fig. 4

Making Your Computer Tweet You When Bad Things Happen

2009-10-17T10:40:00.001-07:00

Twitter has a decent, if not minimalist API with which you can tap into with pretty much anything that can execute a process. Scripting is a natural “fit” for this, but so is mainstream/classic-style/meat-and-potatos “programming”. Pick your language, it doesn’t really matter. After all, anyone that says you *have* to use a particular language for general tasks is a complete idiot. (pssst: it’s the same as saying all you need is a hammer, it works on everything, including hose clamps).

I fell off the trail a bit, I’ll get back on. Where was I? Oh yeah…

So, let’s JUST SAY you have a Twitter account and a Windows computer (XP or later). And maybe you’d like to find a way to leverage that (sorry, I know “leverage” was voted one of the top 100 most overused and annoying words for 2009, at least it didn’t make the top 10), but the path from A to Q (forget Z) is a bit fuzzy? Hmmm? Fear not.

Ingredients

A Twitter account
A Script
An Internet connection
A Scheduled Task
Something to trigger this contraption to work

A Twitter Account

You probably don’t want your computer tweeting you, but instead should have it DM (that’s Direct Message) you. That way your computer’s messages aren’t laid bare to the public, but are instead restricted to just YOU. You might think you can just use your own Twitter account to DM yourself, but you can’t. Twitter doesn’t allow that. So you need to create another Twitter account just for your computer to use. Or do you? Actually, from the web or most Twitter clients (TweetDeck, UberTwitter, etc.) that is true. However, with just the API and a script, you can DM yourself. Weird, but true (for how long is anyone’s guess).

A Script

The pieces for this part are posted over on my other blog here and another example of reading DM folders here. But for the sake of sparing your poor overworked fingers from more torturous mouse clicks, I’ll drop it below. For this example, I’m using a VBScript file. You can use PowerShell, KiXtart, BAT or whatever the **** you prefer, I really don’t give a ****.

Const username  = "Computer_TwitterName"
Const password  = "Computer_TwitterPassword"
Const recipient = "My_Twitter_Name"

Function Twitter_Send_Direct(strMsg, recipient)
    Dim oXml, strTwitterURL
    strTwitterURL = "http://twitter.com/direct_messages/new.xml"
    Set oXml = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    oXml.Open "POST", strTwitterURL, False, username, password
    oXml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXml.Send "text=" & strMsg & "&user=" & recipient
    Twitter_Send_Direct = oXml.responseText
    Set oXml = Nothing
End Function

msg = "Warning Event 129 NTP Synch Discovery Failure (computername)"
result = Twitter_Send_Direct(msg, recipient)
wscript.echo result

Save the script as “twitter_event_129.vbs” in a folder called C:\scripts.

An Internet Connection

Not to be a smartass or anything, but if you’re reading this, there’s a pretty good chance you already have this. If not, well then…

A Scheduled Task

I’m going to use Windows Vista and Windows 7 for this exercise. Why? Because I absolutely hate XP. I hate it more than OSX or Linux. But, I absolutely LOVE my Windows 7 and Windows Server 2008. And one reason why is that this makes it MUCH easier to combine steps 4 and 5, and overall it just looks better on the eyes. I’ll get back to this in a minute.

Something to Trigger this Contraption to Work

For this exercise, I’ll make this engine fire up whenever the Windows Event system logs an “Warning” Event of type 129 (that’s a NTP time synch discovery problem). If you can’t find any such events, pick whatever suits you. Just replace the ID number with the appropriate number below.

Since I’m using Windows 7, I’m going to combine steps 4 and 5 as follows:

Open the Event Viewer console

Navigate to Windows Logs / System

In the Actions panel, click “Filter Current Log…”

Check “Warnings”

In the box with “<All Event IDs>” type in “129” and click OK

You should see just those events now.

Right-click on one of the events, and click “Attach Task to this Event…”

The default title will be highlighted. You can change it if you want or leave it as-is, but I would suggest you enter something in the Description box to explain what this “task” is for and what it does. For my example, I’m going to replace the default title “System_Microsoft-Windows-Time-Service_129” with “Send Twitter DM for Event 129 NTP Warnings” and in the Description box enter “Call a script to send a Twitter DM when event ID 129 (warning) for NTP synch discovery is logged” and click Next >

Click Next > on the “When an Event is Logged” panel.

Select “Start a Program” and click Next >

Click the Browse… button to locate my .VBS script

Click Next >

Click Finish

You will see a confirmation message appear…

(yes, you can just click OK)

But, we’re not done yet…

Open the Windows Task Manager

Under Task Scheduler Library, click Event Viewer Tasks

Right-click on the task you just created and select “Properties”

Click the “General tab, click the “Change User or Group…” button

Type in “SYSTEM” and click “Check Names” and the name should become underlined (validated). Click OK. The user account box should now display “NT AUTHORITY\SYSTEM”.

Just below that, change the option to “Run whether a user is logged on or not”

Click the “Actions” tab.

Click the “Edit” button

Change the Program/Script box to “cscript”

In the “Add arguments” box, enter /nologo C:\scripts\twitter_event_129.vbs and click OK

Click the “Settings” tab.

Change the “Stop the task if it runs longer than:” value to 1 hour.

Click OK to save the changes

Right-click on the Task and click “Run” to force it to run. Go to your Twitter client to verify you received a DM. If not, go back and verify your settings and the account and password settings within your script.

Cheers!

So, what do you get with that PowerShell Combo?

2009-10-14T16:01:00.001-07:00

Fries? A drink? A kids toy? As it turns out, not much. This is just one example of what has been a trend that really bothers me about the so-called “examples” of PowerShell being published on the net lately. Most are focused on WMI queries (WQL), or COM marshalling using the New-Object –COM method. This really doesn’t do anything innovative or beneficial beyond learning a “different” way to code. All of the WQL examples are simply search/replace code chunks which look almost identical to VBscript examples.

VBScript

Set objOutlook = CreateObject("Outlook.Application")
Set Namespace = objOutlook.GetNamespace("MAPI")

For each f1 in NameSpace.Folders
    wscript.echo f1.Name
Next

For each objFolder in NameSpace.Folders
    For each f1 in objFolder.Folders
        wscript.echo vbTab & f1.Name
    Next
Next

PowerShell

$Outlook = New-Object -com Outlook.Application
$Namespace = $outlook.GetNamespace("MAPI")

"{0} Root Folders:      " -f $Namespace.folders.count
foreach ($Fl in $namespace.Folders) {
    "   {0}" -f $Fl.Name}
""
foreach ($Folder in $Namespace.Folders) {
    "`'{0}`' subfolders: " -f $Folder.Name
    foreach ($fl in $Folder.Folders) {
        "   {0}" -f $Fl.Name
    }
}

I’m not at all trying to “bash” PowerShell. It’s a cool language, but it has it’s issues that bother me. I don’t consider it a classic or “true” scripting language as much as programmatic macro language. Most of the benefits it provides via brevity of code are derived from cmdlets, which are similar to making DLL’s for COM extensibility, or UDF files for KiXtart, and so on. Blah blah blah. whatever. I’m no pundit, so what I have to say doesn’t really matter that much really. I forgot what point I was trying to make.

Reboot Computers by Operating System

2009-10-11T07:30:00.001-07:00

What if you wanted to reboot every computer in your Active Directory domain that has a specific version of Windows installed? One example is requesting every Windows 7 Ultimate computer to reboot (see below). Just replace the “YOUR-DOMAIN” with your actual NetBIOS domain name and change the operating system string to whatever you prefer. Remember to test in an isolated environment.

Set objDomain = GetObject("WinNT://YOUR-DOMAIN")

For each objX in objDomain
    If Lcase(objX.Class) = "computer" Then
        n = objX.Name
        wscript.echo n
    End If
Next

Sub Reboot(strComputer)
    Dim objWMIService, colOS, objShare, objRetval, cap
    On Error Resume Next
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    If err.Number <> 0 Then
        wscript.echo "unavailable: " & strComputer
    Else
        Set colOS = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem",,48)
        For each objItem in colOS
            cap = objItem.Caption
            If cap = "Microsoft Windows 7 Ultimate" Then
                Set objShare = objWMIService.Get("Win32_OperatingSystem.ReplaceKeyProperty=ReplacePropertyValue")
                Set objRetval = objWMIService.ExecMethod("Win32_OperatingSystem.ReplaceKeyProperty=ReplacePropertyValue", "Reboot")
            End If
        Next
    End If
End Sub

VBScript - Get Remote Asset Tag (Serial Number)

2009-10-03T17:26:00.000-07:00

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

BAT - Enable Remote Desktop on Remote Computer

2009-10-03T17:18:00.000-07:00

Tested on XP, Vista, Windows 7, Windows Server 2003 and Windows Server 2008.

@echo off
if %1=="" (
    goto USAGE
) else (
    goto VERIFY
)

:USAGE
echo ***************************************
echo Usage:
echo enable_remote_desktop.bat [computername]
echo .
echo ***************************************
goto END

:VERIFY
if EXIST \\%1\c$\windows\system32 (
    goto ENABLE
) else (
    goto OFFLINE
)

:OFFLINE
echo ***************************************
echo %1 is not accessible
echo check the name and try again or ensure
echo the client is online and firewall is
echo not preventing access
echo ***************************************
goto END

:ENABLE
echo Configuring registry setting on %1...
REG ADD \\%1\HKLM\SYSTEM\CurrentControlSet\Control\Terminal Server /v fDenyTSConnections /t REG_DWORD /d 0 /f
rem goto REBOOT
echo %1 has been configured
goto END

:REBOOT
echo Requesting a restart of %1...
shutdown -m \\%1 -r -f -t 5
echo Request submitted.  Please allow a few minutes before
echo attempting to connect via remote desktop.
goto END

:END

TextPad Syntax and Clip Libraries for Scripting

2009-09-29T17:46:00.000-07:00

I've had my TextPad syntax definitions and clip libraries posted online for ASP, PHP, BAT/CMD, KiXtart, PowerShell, and VBScript for almost a year now. But they've moved to a new location: http://sites.google.com/site/skatterbrainz

I've also updated many of them recently, so if you ever tried them, you might try them again. Then again, if you don't care, well...

Poor Mans Nested Array Splitting

2009-09-25T17:52:00.001-07:00

Some will laugh. Some will scoff. Some will snort and then realize they accidentally blew a booger on their shirt and say “oh damn”. Oh well, here goes…

<%
Const myList = "1=RED,2=YELLOW,3=GREEN,4=CYAN,5=BLUE,6=MAGENTA"

Sub ColorNumList(default)
    For each pair in Split(myList, ",")
        x = Split(pair, "=")
        If Cstr(default) = x(0) Then
            Response.Write "<option value=" & x(0) & _
            " selected>" & x(1) & "</option>"
        Else
            Response.Write "<option value=" & x(0) & _
            ">" & x(1) & "</option>"
        End If
    Next
End Sub
%>

To use this, you simply insert it within a matching set of ASP code tags inside of a <select></select> form object tag set:

...
<select name="colornum" size="1">
    <% ColorNumList 3 %>
</select>
...

Group Policy: Hide Locked User Display on Windows 7

2009-09-24T18:01:00.000-07:00

While I did show how to set this in the registry using various script options (Daniel Petri demonstrated it first by using the registry editor), there is a MUCH easier way: Group Policy.

Computer Configuration
...Policies
   ...Windows Settings
   ...Security Settings
   ...Local Policies
   ...Security Options:

Interactive logon: Display user information when the session is locked
   Enable --> "Do not display user information"

Registry: Hide Locked User Name on Windows 7

2009-09-24T17:55:00.000-07:00

Borrowing from Daniel Petri's post on how to hide the display of the logged-on user when a Windows 7 computer is locked, I wanted to try to do this in different languages/scripts for the hell of it.

CMD console using REG.exe...

REG ADD HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DontDisplayLockedUserId /t REG_DWORD /d 3 /f

VBScript using Registry object...

Const HKEY_LOCAL_MACHINE = &H80000002
' more at http://msdn2.microsoft.com/en-us/library/aa394600.aspx

Sub AddKey(strComputer, strKeyPath)
    Set objReg=GetObject( _
        "winmgmts:{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\default:StdRegProv")
    objReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
End Sub
Post Options
Sub AddDWValue(strComputer, strKeyPath, strValueName, iValue)
    Set objReg=GetObject( _
        "winmgmts:{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\default:StdRegProv")
 objReg.SetDWordValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, iValue
End Sub

Const k = "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"
AddKey "Computer1", k
AddDWValue "Computer1", k, "DontDisplayLockedUserId", 3

KiXtart...

$k = "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System"
$=WriteValue($k, "DontDisplayLockedUserId", 3, "REG_DWORD")

This was thrown together pretty quick so it might need tweaking.

VBScript - Get Previous / Next Month Names

2009-09-24T17:27:00.000-07:00

Function NextMonthName(dateval)
    Dim tmp : tmp = DateAdd("m", 1, dateval)
    NextMonthName = MonthName(Month(tmp))
End Function


Function PrevMonthName(dateval)
    Dim tmp : tmp = DateAdd("m", -1, dateval)
    PrevMonthName = MonthName(Month(tmp))
End Function

VBScript - Checking for a Valid Date

2009-09-24T15:12:00.001-07:00

Function DateValid(dv)
    Dim retval : retval = ""
    On Error Resume Next
    retval = FormatDateTime(dv, vbShortDate)
    If err.Number = 0 Then
        DateValid = True
    End If
End Function

VBScript CDOsys Message Sending

2009-09-22T16:53:00.001-07:00

'------------------------------------------------------
' Send CDONTS email in ASCII text or HTML format
'------------------------------------------------------
Const mailServer = "mailserver.domain.com"

Sub SendMail(sendto, sendfrom, subjectline, msgBody, msgFormat)
    If (sendto <> "") and (sendfrom <> "") and (subjectline <> "") and (msgBody <> "") Then
        Dim objMessage
        Set objMessage = Server.CreateObject("CDO.Message")
        objMessage.Subject = subjectline
        objMessage.From  = sendfrom
        objMessage.To = sendto
        If msgFormat = "TEXT" Then
            objMessage.TextBody = msgBody
        Else
            objMessage.HTMLBody = msgBody
        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
    Else
        wscript.echo "error: insufficient parameters (sendmail)"
    End If
End Sub

Windows Defrag From a Script to a Script and Back Again

2009-09-22T16:52:00.000-07:00

Sometimes you just have to unscrew your brain, take it out, set it down on the toilet lid and say “what the hell”. Let’s just say, let’s… that we want to run the DEFRAG command using the /A option to just analyze a volume and somehow we’d like to be able to programmatically (that’s a big word) capture that output and automate something with that mess. Let’s just say.

The command line might look like defrag c: /a /v >defrag.txt. But we’d like to be able to schedule this to run at a certain after-hours time and maybe do something like send an email if the results meet some weird crack-infested condition we dreamed up while eating shrimp cocktail and downing four or five cold ones.

The output of this command might look like this…

Microsoft Disk Defragmenter
Copyright (c) 2007 Microsoft Corp.

Invoking analysis on (C:)...

The operation completed successfully.

Post Defragmentation Report:

        Volume Information:
                Volume size                 = 74.40 GB
                Cluster size                = 4 KB
                Used space                  = 24.78 GB
                Free space                  = 49.61 GB

        Fragmentation:
                Total fragmented space      = 2%
                Average fragments per file  = 1.08

                Movable files and folders   = 75092
                Unmovable files and folders = 45

        Files:
                Fragmented files            = 2197
                Total file fragments        = 4809

        Folders:
                Total folders               = 15288
                Fragmented folders          = 14
                Total folder fragments      = 43

        Free space:
                Free space count            = 1805
                Average free space size     = 28.14 MB
                Largest free space size     = 30.62 GB

        Master File Table (MFT):
                MFT size                    = 76.50 MB
                MFT record count            = 78335
                MFT usage                   = 100%
                Total MFT fragments         = 2

        Note: File fragments larger than 64MB are not included in the fragmentation statistics.

        You do not need to defragment this volume.

So, how can we do this automation gyration prognostication? Easy. Using VBScript, FileSystemObject, the Shell object and some coffee, duct tape and a slice of cold pizza, we might arrive at this…

Const inputFile = "c:\windows\temp\defrag.txt"
Const cmd = "cmd /c defrag c: /a /v"
Const ForReading = 1
Const ForWriting = 2

Dim objFSO, objFile, strLine, objShell, parse
Dim label, data

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

wscript.echo "info: running defrag analysis on c: drive..."
objShell.Run cmd & " >" & inputFile, 1, True
wscript.echo "info: defrag completed"

wscript.echo "info: checking if input file was created..."

If objFSO.FileExists(inputFile) Then
    wscript.echo "info: file was found, opening for input..."
    Set objFile = objFSO.OpenTextFile(inputFile, ForReading)
    Do Until objFile.AtEndOfStream
        strLine = Trim(objFile.Readline)
        If InStr(1, strLine, "=") <> 0 Then
            strLine = Replace(strLine, vbTab, "")
            parse = Split(strLine, "=")
            label = Trim(parse(0))
            data  = Trim(parse(1))
            wscript.echo label & vbTab & data
        End If
    Loop
    objFile.Close
Else
    wscript.echo "fail: input file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing

wscript.echo "info: processing complete"

The output might look like this…

info: running defrag analysis on c: drive...
info: defrag completed
info: checking if input file was created...
info: file was found, opening for input...
Volume size     74.40 GB
Cluster size    4 KB
Used space      24.78 GB
Free space      49.61 GB
Total fragmented space  2%
Average fragments per file      1.08
Movable files and folders       75096
Unmovable files and folders     43
Fragmented files        2197
Total file fragments    4810
Total folders   15288
Fragmented folders      14
Total folder fragments  43
Free space count        1802
Average free space size 28.19 MB
Largest free space size 30.62 GB
MFT size        76.50 MB
MFT record count        78335
MFT usage       100%
Total MFT fragments     2
info: processing complete

Now you can insert some code to send email using CDOsys (or whatever you prefer) or send some info to a database table. Then wrap all that up with a tuna sandwich, some fries and a cold drink and you’re off. Sure, you can do a lot of this with WMI directly and that works too. But sometimes there are command console utilities that do things WMI doesn’t do as easily (or simply), so you have options like this (capture the output and then parse back into your script to process further).

Options: You can modify this easily to output XML, INI or just about any text format you desire. You can also pipe it into another script, or pump it into a database. You can also wrap it into an email and send it. Or, because you can capture each line and check the “label” string value, you can check for “Total fragmented space” and if it’s greater than some percentage value, fire an email alert. The take away here is that you can do just about anything you want.

Back from the Brink of something

2009-09-19T07:45:00.000-07:00

What is a "brink" anyway?
Web dictionaries describe it as a "region marking a boundary". But what is a "boundary"? For that matter, what is a "region"? I could go on, but who cares. This is where I'll be posting script stuff. Again. And for those who got pissed off at me last time: Too Fkking bad.

Packaging Gone Awry?

2009-07-15T12:21:00.000-07:00

What's up with packaging these days? It seems every manufacturer, container shipper, and postal carrier entity is experimenting with new ways to package things. Some are borderline clever. Some are just outright dumb. This goes beyond the pack-and-ship aspects. I'm also talking about how desktop and laptop computers are assembled.

Since 2000, I've counted no less than two dozen unique assembly methods used by Dell and HP alone. Screws, thumb-screws, clips, snaps, notches, latches, folding, sliding, lifting, pulling. You name it. What's up with that? Why screws anyway? As if the little toy-like lock hasps are any deterrent to thieves and tinkerers. Just make the cases snap together and be done with it. And if you look at the insides of a computer, oh geez. One minute of gazing and you can easily spot a half-dozen fabrication head-scratchers. Things that make you ask "why do it that way?"

I'm not talking about complicated things either. This applies to simple boxes like the power supply, cd/dvd drives and backplanes. The costs being wasted by overly complicated fastening methods, attachment methods, alignment methods, and so on, is just insane. The reason in most cases is patent blocking. Someone holds patents on the simplest methods and won't play nice with the big players anymore. So they do their own and it ends up being a clusterf**k. Given that not one single manufacturer uses a common-sense assembly approach (except for maybe Apple, in some cases, pardon the pun) I am wondering if it's the patent holder that's to blame. Demanding too high of a price for licensing. Or maybe they just don't want to play at all. Who knows. We're paying the price, both literally and indirectly (ripping our fingers on the sharp edges, contorting to plug things in). Progress and innovation have been tossed into a cell and locked up by attorneys. The 20th century was all about making new things. The 21st century is shaping up to be about protecting things, pure and simple. RIP innovation.

VBScript Query All Domain Controllers for a User Account Status

2009-07-14T18:58:00.001-07:00

Query all domain controllers for the status of a specified user account. This can come in handy when there are suspected replication problems in AD and some domain controllers are not up to date on a given account (locked, disabled, modified, etc.).


Const userid = "ServiceAccount20"
Const ou = "OU=ServiceAccounts,OU=IT,OU=Corp,DC=contoso,DC=com"

Const pageSize = 1000
Const ADS_SCOPE_SUBTREE = 2

Set dso = GetObject("LDAP:")

'----------------------------------------------------------------

Function Domain_LDAP()
    Dim retval, objRootDSE
    Set objRootDSE = GetObject("LDAP://RootDSE")
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

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

Function CName(strval)
    Dim tmp
    tmp = Replace(strval, "CN=NTDS Settings,CN=", "")
    CName = Split(tmp, ",")(0)
End Function

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

Function DomainControllers()
    Dim objConnection, objCommand, objRecordSet
    Dim dn, retval : retval = ""

    dcn = Domain_LDAP()

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.CommandText = _
        "SELECT distinguishedName FROM " & _
        "'LDAP://cn=Configuration," & dcn & "' " & _
        "WHERE objectClass='nTDSDSA'"

    objCommand.Properties("Page Size") = pageSize
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst

    wscript.echo "info: querying for list of domain controllers..."

    Do Until objRecordSet.EOF
        dn = objRecordSet.Fields("distinguishedName").Value
        If retval <> "" Then
            retval = retval & vbTab & dn
        Else
            retval = dn
        End If
        objRecordSet.MoveNext
    Loop
    DomainControllers = retval
End Function

'----------------------------------------------------------------

wscript.echo "info: user account = " & userid
dclist = DomainControllers()

wscript.echo "info: querying user account status from each domain controller..."

For each strDC in Split(dclist, vbTab)
    cn = CName(strDC)
    dcn = Replace(strDC, "CN=NTDS Settings,", "")
 
    Set objUser = GetObject("LDAP://" & cn & "/CN=" & userid & "," & ou)
    On Error Resume Next
 
    ' refer to http://support.microsoft.com/kb/305144
 
    uac = objUser.Get("userAccountControl")
    If err.Number <> 0 Then
        wscript.echo err.Number & " - " & err.Description
    Else
        ' add more cases below if you prefer, or logand the results
        Select Case uac
            Case 512: wscript.echo "info: " & cn & " = normal"
            Case 16: wscript.echo "info: " & cn & " = locked"
            Case 2: wscript.echo "info: " & cn & " = disabled"
            Case 65536: wscript.echo "info: " & cn & " = never-expires"
            Case Else: wscript.echo "info: " & cn & " = unknown: " & uac
        End Select
    End If
Next

VBScript / ASP Secure LDAP Query of User Group Membership

2009-07-14T18:44:00.000-07:00

Check if a user is a member of a specified domain security group using a secure LDAP query with ADsDSoObject provider. Works for ASP and VBScript using a specified domain service/proxy user account (when anonymous LDAP is disabled).


Example:
If IsMemberOf("SalesManagers", "JohnDoe") Then
    Response.Write "is a member"
End If


Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Const ADS_SCOPE_SUBTREE = 2

Function IsMemberOf(groupName, uid)
    Dim objConnection, objCommand, objRecordSet
    Dim retval : retval = False
    Dim i, gplen : gplen = Len(groupName)+3
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT memberof FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            For each m in objRecordSet.Fields("memberof").value
                If Left(Ucase(m),gplen) = Ucase("CN=" & groupname) Then
                    retval = True
                End If
            Next
        Next
        objRecordSet.MoveNext
    Loop
    objRecordSet.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    IsMemberOf = retval
End Function

VBScript / ASP Secure LDAP User Query

2009-07-14T18:34:00.001-07:00

Query Active Directory using a service/proxy user account from within VBScript or an ASP web page. Returns results as a tab-delimited string, where each token is sub-delimited using a pipe character "|".


example:
x = GetUserData("JohnDoe", "ADsPath, mail, department, givenName, sn")
 
For each v in Split(x, vbTab)
    response.write Replace(v, "|", " = ") & "<br/>"
Next


Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"

Function GetUserData(uid, fields)
    Const ADS_SCOPE_SUBTREE = 2
    Dim objConnection, objComment, objRecordSet
    Dim retval : retval = ""
    Dim i, fieldname, strvalue
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand    = CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"
 
    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT " & fields & _
        " FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            fieldname = objRecordSet.Fields(i).Name
            strvalue = objRecordSet.Fields(i).Value
            If retval <> "" Then
                retval = retval & vbTab & fieldname & "|" & strValue
            Else
                retval = fieldname & "|" & strValue
            End If
        Next
        objRecordSet.MoveNext
    Loop
    GetUserData = retval
End Function

VBScript Enumerate AD OUs and Containers

2009-07-13T16:28:00.000-07:00


Dim objDSE, strDefaultDN, strDN, objContainer, objChild
Const enumContainersAlso = False

Set objRootDSE = GetObject("LDAP://rootDSE")
strDefaultDN = Domain_LDAP()
Set objContainer = GetObject("LDAP://" & strDefaultDN)

Call ListObjects(objContainer, "")

Function Domain_LDAP()
    Dim retval
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

Function Domain_NetBIOS(ldapdn)
 Domain_NetBIOS = Replace(Replace(ldapdn,"DC=",""),",",".")
End Function

Sub ListObjects(objADObject, strSpace)
    Dim objChild
    For Each objChild in objADObject
        Select Case objChild.Class
            Case "organizationalUnit":
                objName = Mid(objChild.Name,4)
                objContainer = objChild.distinguishedName
                wscript.echo strSpace & "(o) " & objName
                Call ListObjects(objChild, "....")
            Case "container":
                If enumContainersAlso Then
                    objName = Mid(objChild.Name,4)
                    objContainer = objChild.distinguishedName
                    wscript.echo strSpace & "(c) " & objName
                End If
                Call ListObjects(objChild, "....")
        End Select
    Next
End Sub

VBScript Get Active Directory Environment Data

2009-07-13T16:07:00.000-07:00


Set objRootDSE = GetObject("LDAP://rootDSE")
 
wscript.Echo "defaultNamingContext = " & objRootDSE.Get("defaultNamingContext")
wscript.Echo "rootdomainNamingContext = " & objRootDSE.Get("rootDomainNamingContext")
wscript.Echo "configurationNamingContext = " & objRootDSE.Get("configurationNamingContext")
wscript.Echo "dnsHostName = " & objRootDSE.Get("dnsHostName")
wscript.echo "CN: " & GetCN(objRootDSE.Get("defaultNamingContext"))

Function GetCN(dn)
    Dim retval
    retval = Split(dn, ",")
    GetCN = Mid(retval(0),4)
End Function

Editorial: Stupid Damn Apple iPhone Commerical

2009-07-12T18:29:00.000-07:00

I have to step off the wagon for a moment to bitch about something irritating the living shit out of me: The latest Apple commercial for the iPhone. This is the one that brags about being able to copy and paste crap from one place to another. Such as phone numbers into emails, and so on.

Really? For real?!!

I've been doing that on my cheap, crappy old Blackberry for years. YEARS!!!! God damn years!!!

I have to assume Steve Jobs wasn't consulted about this idea before it went to press. I can't believe he would have consented to it. Of all the cool, innovative things the iPhone can do, copy-and-paste is an embarrassing late-comer to the party. Why would they make a whole commercial for just that one thing? What next, a commercial that they finally got a multi-button mouse?

Yes, I know about the stupid-as-hell "mighty mouse" product. Ironic that I learned to use a computer in the 1980's using a 16-button digitizer mouse. It was fantastic! I could program the buttons to do everything I needed and it saved me a ton of time and effort. But Apple faggoty fans kept saying that a one-button cyclops mouse was "elegant" and "genius". Then the Mighty Mouse comes out and those same two-face bastards go on a back-patting spree with testimonials of how Apple re-innovated the concept of a multi-button mouse. Holy f-ing crap.

I like Apple.

I fucking hate Apple fans.

LDAP Query for User Accounts Created Since a Specific Date

2009-07-12T17:42:00.001-07:00

Just modify the date string to use the YYYYMMDDHHMMSS.0Z format. So, for June 1, 2009, you would specify "20090601000000.0Z"


(&(objectCategory=user)(whenCreated>=20090601000000.0Z))

LDAP Query for Printers = HP DesignJet Plotters

2009-07-12T17:38:00.000-07:00


(&(&
(uncName=*)
(objectCategory=printQueue)
(objectCategory=printQueue)
(driverName=*DesignJet*)
))

LDAP Query for Windows Server 2003 SP1 Computers in AD

2009-07-12T17:36:00.000-07:00


(&(&(&(&(&(&(&(&(&(&
(objectCategory=Computer)
(operatingSystem=Windows Server 2003*)
(operatingSystemServicePack=Service Pack 1)
))))))))))

ASP Get Page Input (Form or QueryString)

2009-07-12T17:33:00.001-07:00


Function GetParam(strLabel)
    Dim retval : retval = ""
    retval = Trim(Request.Form(strLabel))
    If retval = "" Then
        retval = Trim(Request.QueryString(strLabel))
    End If
    GetParam = retval
End Function

VBScript / ASP Function to Convert Dates to/from MySQL

2009-07-12T17:29:00.000-07:00


' MySqlDate(Now, 1) --> "2008-02-20"
' MySqlDate(Now, 2) --> "2/20/2008"

Function MySqlDate( d, dir )
    If Not isDate( d ) Then d = Date()
    Dim strNewDate
    Select Case dir
        Case 1:
            '=== store in db
            strNewDate = Year( d ) & "-" & Month( d ) & "-" & Day( d )
        Case 2: 
            '=== use with asp
            strNewDate = Month( d )& "/"  & Day( d ) & "/" & Year( d )
            strNewDate = cDate( strNewDate )
    End Select
    mysqlDate = strNewDate
End Function

PHP: Determine Zodiac Sign from Birth Date

2009-07-12T17:25:00.000-07:00


function ZodiacSign($date){
    list($year,$month,$day)=explode("-",$date);
    if (($month==1 && $day>20)||($month==2 && $day<20)) {
        return "Aquarius";
    } else if (($month==2 && $day>18 )||($month==3 && $day<21)) {
        return "Pisces";
    } else if (($month==3 && $day>20)||($month==4 && $day<21)) {
        return "Aries";
    } else if (($month==4 && $day>20)||($month==5 && $day<22)) {
        return "Taurus";
    } else if (($month==5 && $day>21)||($month==6 && $day<22)) {
        return "Gemini";
    } else if (($month==6 && $day>21)||($month==7 && $day<24)) {
        return "Cancer";
    } else if (($month==7 && $day>23)||($month==8 && $day<24)) {
        return "Leo";
    } else if (($month==8 && $day>23)||($month==9 && $day<24)) {
        return "Virgo";
    } else if (($month==9 && $day>23)||($month==10 && $day<24)) {
        return "Libra";
    } else if (($month==10 && $day>23)||($month==11 && $day<23)) {
        return "Scorpio";
    } else if (($month==11 && $day>22)||($month==12 && $day<23)) {
        return "Sagittarius";
    } else if (($month==12 && $day>22)||($month==1 && $day<21)) {
        return "Capricorn";
    }
}

PHP: Generate List of U.S. State Abbreviations

2009-07-12T17:23:00.001-07:00

For form select listbox populating...


function StateCodes($deft) {
    $clist = "AL,AK,AS,AZ,AR,CA,CO,CT,DC,DE,FL,GA,HI,IA,ID,IL,IN,"
    . "KS,KY,LA,MA,MD,ME,MI,MN,MO,MS,MT,NC,ND,NE,NH,NJ,NM,NY,"
    . "OH,OK,OR,PA,RI,SC,SD,TN,TX,UT,VA,VT,WA,WI,WV,WY";
    $tok = strtok($clist, ",");
    while ($tok != false) {
        if ($deft == $tok) {
            echo "\n";
        }
        else {
            echo "\n";
        }
        $tok = strtok(",");
    }
}

KiXtart: Customize OEM Support Information

2009-07-11T18:03:00.000-07:00


? "[OEMSupportTag].....: Configuring OEM Support applet..."
Dim $oeminfo, $oemlogo, $oemsupp, $x, $regkey
Dim $logfile, $oemlogosrc, $oemsuppsrc
Dim $wmi, $wmi_compsys, $wmi_comp, $model, $desc, $asset
$weblink = "https://intranet.company.com/helpdesk"

$regkey = "HKLM\System\CurrentControlSet\Control\Windows"
$value = ReadValue($regkey,"SystemDirectory")
$windir = ExpandEnvironmentVars($value)

If $windir <> ""
    $oeminfo = $windir+"\oeminfo.ini"
    $oemlogo = $windir+"\oemlogo.bmp"
    $oemsupp = $windir+"\web\support.htm"
    $logfile = $windir+"\custom_oem.ini"
    $oemlogosrc = @lserver+"\netlogon\oemlogo.bmp"
    $oemsuppsrc = @lserver+"\netlogon\support.htm"

    If Exist( $oeminfo ) = 1
        ? "[OEMSupportTag].....: removing existing oeminfo.ini file..."
        Del( $oeminfo )
    Else
        ? "[OEMSupportTag].....: no existing oeminfo.ini file found."
    EndIf

    ? "[OEMSupportTag].....: attempting to create new oeminfo.ini file..."
    If Open(2, $oeminfo, 5) = 0
        ? "[OEMSupportTag].....: file created successfully, updating contents..."
        $wmi = "WINMGMTS:{IMPERSONATIONLEVEL=IMPERSONATE}!//"+@wksta
        $wmi_compsys = "SELECT * FROM Win32_ComputerSystemProduct"
        $wmi_comp = GetObject($wmi).ExecQuery($wmi_compsys)
        For Each $objsys In $wmi_comp
            $model = $objsys.Name
            $desc  = $objsys.Description
            $asset = $objsys.IdentifyingNumber
        Next
        $=WriteLine(2,"[General]" + @crlf)
        $=WriteLine(2,"Manufacturer=MY COMPANY, INC." + @crlf)
        $=WriteLine(2,"Model="+$model + @crlf)
        $=WriteLine(2,"SupportURL=$weblink" + @crlf)
        $=WriteLine(2,"LocalFile=%windir%\web\support.htm" + @crlf + @crlf)
        $=WriteLine(2,"[OEMSpecific]" + @crlf)
        $=WriteLine(2,"SubModel=" + @crlf)
        $=WriteLine(2,"SerialNo=" + @crlf)
        $=WriteLine(2,"OEM1="+$asset + @crlf)
        $=WriteLine(2,"OEM2=" + @crlf + @crlf)
        $=WriteLine(2,"[ICW]" + @crlf)
        $=WriteLine(2,"Product=Computer Asset" + @crlf + @crlf)
        $=WriteLine(2,"[Support Information]" + @crlf)
        $=WriteLine(2,"Line1=COMPUTER HELP DESK" + @crlf)
        $=WriteLine(2,"Line2= " + @crlf)
        $=WriteLine(2,"Line3=Contact Technical Support by web or phone:" + @crlf)
        $=WriteLine(2,"Line4= " + @crlf)
        $=WriteLine(2,"Line5=  $weblink" + @crlf)
        $=WriteLine(2,"Line6=  1-800-555-1212" + @crlf)
        $=WriteLine(2,"Line7= " + @crlf)
        $=WriteLine(2,"Line8=After hours/weekends/holidays..." + @crlf)
        $=WriteLine(2,"Line9=support options may be limited." + @crlf)
        $=WriteLine(2,"Line10=------------------------------" + @crlf)
        $=WriteLine(2,"Line11=Computer Name: " + @wksta + @crlf)
        If Trim($asset) <> ""
            $=WriteLine(2,"Line12=Asset Tag: " + Trim($asset) + @crlf)
            $=WriteLine(2,"Line13=IPAddress: " + @ipaddress0 + @crlf)
        Else
            $=WriteLine(2,"Line12=IPAddress: " + @ipaddress0 + @crlf)
        EndIf
        Close(2)
        ? "[OEMSupportTag].....: oeminfo.ini file has been successfully updated!"
    Else
        ? "[OEMSupportTag].....: Error: failed to create new oeminfo.ini file!"
    EndIf

    ? "[OEMSupportTag].....: oeminfo logo graphic updated already?..."
    If Exist( $logfile ) = 0
        ? "[OEMSupportTag].....: attempting to create new oeminfo update log file..."
        If Exist( $oemlogosrc ) = 1
            ? "[OEMSupportTag].....: downloading oeminfo logo graphic file..."
            Copy $oemlogosrc $oemlogo
            If Open(3, $logfile, 5) = 0
                WriteLine(3,"[General]"+@crlf)
                WriteLine(3,"DateAdded="+@date+@crlf)
                Close(3)
                ? "[OEMSupportTag].....: oeminfo log updated."
            EndIf
        Else
            ? "[OEMSupportTag].....: oeminfo graphic file missing: "+$oemlogosrc
        EndIf
    Else
        ? "[OEMSupportTag].....: "+$logfile+" previously recorded."
    EndIf
Else
    ? "[OEMSupportTag].....: Error: windir variable not set, aborting process."
EndIf

KiXtart: Get Asset Number

2009-07-11T17:55:00.001-07:00

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

KiXtart: Open Browser / Display Web Page

2009-07-11T17:52:00.000-07:00

Great for login banners and bulletins...


Function OpenWebPage($url, $show, Optional $height, $width, $fixed)
    $ie = CreateObject("InternetExplorer.Application")
    If $ie <> 0 and @ERROR = 0
        $ie.Navigate($url)
        If $show = 1
            If $height > 0
                $ie.Height = $height
            EndIf
            If $width > 0
                $ie.Width  = $width
            EndIf
            If $fixed = 1
                $ie.Resizable = 0
                $ie.StatusBar = 0
                $ie.Toolbar = 0
            EndIf
            $ie.Visible = 1
            Sleep 1
        Else
            ? "(openwebpage): accessing document in silent-mode"
            Sleep 1
            $ie.Quit
            $ie = 0
        EndIf
    Else
        ? "(openwebpage): error / unable to launch IE application object"
    EndIf
EndFunction

KiXtart: Enumerate HOSTS file Entries

2009-07-10T15:26:00.000-07:00


Break ON

$systemRoot = ExpandEnvironmentVars("%systemroot%")
$hostsFile  = $systemRoot+"\system32\drivers\etc\hosts"
$fileHandle = FreeFileHandle()
$entries = 0

If Exist($hostsFile)
    ? "info: hosts file found at "+$hostsFile
    If Open($fileHandle, $hostsFile, 1) = 0
        ? "info: reading file..."
        $line = ReadLine($fileHandle)
        While @ERROR = 0
            If Left($line, 1) <> "#"
                ; ignore lines beginning with # as they are comments
                ? "line --> $line"
                $entries = $entries + 1
            EndIf
            $line = ReadLine($fileHandle)
        Loop
        $=Close($fileHandle)
        ? "info: $entries entries found"
    Else
        ? "fail: unable to open hosts file!"
    EndIf
Else
    ? "fail: hosts file cannot be found!"
EndIf

VBScript: ADOX Create Access Database, Table and Insert Row

2009-07-10T14:18:00.000-07:00

Adapted from portions of code on MSDN at http://msdn.microsoft.com/en-us/library/ms681497(VS.85).aspx


'----------------------------------------------------------------
' first we create the database file itself
'----------------------------------------------------------------

Const dbFile = "c:\database.mdb"
strDSN = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile

Const adVarWChar = 202
Const adSingle = 4
Const adLockOptimistic = 3
Const adOpenDynamic = 2
Const adCmdTable = &H0002

On Error Resume Next
wscript.echo "info: creating database..."
Dim objCatalog
Set objCatalog = CreateObject("ADOX.Catalog")
objCatalog.Create strDSN
If err.Number = 0 Then
    wscript.echo "info: database created successfully"
Else
    wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
    wscript.Quit(1)
End If

'----------------------------------------------------------------
' next we create a table in the new database
'----------------------------------------------------------------

wscript.echo "info: creating table..."

Set objTable = CreateObject("ADOX.Table")
objCatalog.ActiveConnection = strDSN

With objTable
    .Name = "tbl_Employees"
    .Columns.Append "empID", adVarWChar, 12
    .Columns.Append "fname", adVarWChar, 50
    .Columns.Append "lname", adVarWChar, 50
    .Columns.Append "dept", adVarWChar, 50
    .Columns.Append "phone", adVarWChar, 50
    .Columns.Append "email", adVarWChar, 50
    .Columns.Append "jobID", adSingle
    .Columns.Append "birthDay", adVarWChar, 20
End With

objCatalog.Tables.Append objTable

If Err.Number <> 0 Then
    wscript.echo "fail: " & err.Number & ": " & err.Description
    Set objTable = Nothing
    Set objCatalog = Nothing
    wscript.Quit(1)
Else
    wscript.echo "info: table created successfully"
End If

Set objTable = Nothing
Set objCatalog = Nothing

'----------------------------------------------------------------
' comment: SQL INSERT
'----------------------------------------------------------------
wscript.echo "info: entering a new row..."

On Error Resume Next
Set rs = CreateObject("ADODB.Recordset")
rs.Open "tbl_Employees", strDSN, adOpenDynamic, adLockOptimistic, adCmdTable

If err.Number <> 0 Then
    rs.Close
    Set rs = Nothing
    wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
    wscript.Quit(1)
End If

rs.AddNew
rs("empID").value = "100400"
rs("fname").value = "JOHN"
rs("lname").value = "DOE"
rs("dept").value  = "SALES"
rs("phone").value = "800-555-1212"
rs("email").value = "john_doe@dumbass.local"
rs("jobID").value = 4002
rs("birthDay").value = "#03/01/1966#"
rs.Update
If err.Number <> 0 Then
    rs.Close
    Set rs = Nothing
    wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
    wscript.Quit(1)
End If

rs.Close
Set rs = Nothing

VBScript: Sort Start Menu Items

2009-07-10T13:47:00.000-07:00


Const optionType = 1
Const regBase = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder"

Set objShell = CreateObject("Wscript.Shell")

If optionType = 1 Then
    ' a sloppy, cheap, but effective way to do this with Wscript
    cmd1 = "start /wait reg delete """ & regBase & "\Start Menu"" /f"
    cmd2 = "start /wait reg delete """ & regBase & "\Start Menu2"" /f"
    cmd3 = "start /wait taskkill /im explorer.exe /F"
    cmd4 = "explorer.exe"
    objShell.Run "cmd.exe /c " & cmd1, 1, True
    objShell.Run "cmd.exe /c " & cmd2, 1, True
    objShell.Run "cmd.exe /c " & cmd3, 1, True
    objShell.Run "cmd.exe /c " & cmd4, 1, True
Else
    ' a more elegant, poofy and girly way of doing this with style and ambiance
    objShell.RegDelete regBase & "\Start Menu\"
    objShell.RegDelete regBase & "\Start Menu2\"
    objShell.Run "cmd.exe /c start /wait taskkill /im explorer.exe /F", 1, True
    objShell.Run "cmd.exe /c explorer.exe", 1, True
End If

Set objShell = Nothing

PowerShell: Update Desktop Shortcut Targets

2009-07-09T20:22:00.000-07:00


# iterate shortcuts to find matching target paths and 
# if found, replace with new target path and save link

$desktop = $home+"\desktop"
$oldPath = "\\server1\sharename1"
$newPath = "\\server2\sharename1"

$shell = New-Object -ComObject WScript.Shell

$Dir = get-childitem $desktop -recurse

foreach($file in $Dir) {
    $fname = $file.Name
    # write-host $fname
    $lnk = $shell.CreateShortcut($desktop+"\"+$fname)
    $target = $lnk.TargetPath
    if ($target -eq $oldPath) {
        write-host "Updating shortcut target..."
        $lnk.TargetPath = $newPath
        $lnk.Save()
    }
}

ASP - Generate Alphabet List

2009-07-07T19:19:00.001-07:00


<select name="letter" size="1">
<%
For i = Asc("A") to Asc("Z")
    Response.Write "<option>" & Chr(i) & "</option>"
Next
%>
</select>

KiXtart: Update Desktop Shortcuts

2009-07-07T19:14:00.000-07:00


Break ON

$oldPath = "\\server1\shareName1"
$newPath = "\\server2\shareName2"

$shell = CreateObject("WScript.Shell")
$DesktopPath = ExpandEnvironmentVars("%userprofile%")+"\Desktop"

$FileName = Dir("$DesktopPath\*.lnk")
While $FileName <> "" And @error = 0
    ? $FileName
    $link = $shell.CreateShortcut("$DesktopPath\$FileName")
    If Ucase($link.TargetPath) = Ucase($oldPath)
        $link.TargetPath = $newPath
        $link.Save
    EndIf
    $FileName = Dir()
Loop

KiXtart: Enumerate Access Database Tables with ADOX

2009-07-07T19:08:00.000-07:00


$dbfile = "\\servername\share\folder\database.mdb"

Function ListTablesADOX($db)
    Dim $Conn, $strConn, $Catalog, $Table, $Column
    $strConn = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=$db"
 
    ? "Database: $db @CRLF"
 
    $Conn    = CreateObject("ADODB.Connection")
    $Catalog = CreateObject("ADOX.Catalog")
    $Table   = CreateObject("ADOX.Table")
    $Column  = CreateObject("ADOX.Column")
 
    $Conn.Open($strConn)
    $Catalog.ActiveConnection = $Conn

    For Each $Table In $Catalog.Tables
        ? "Table: " + $Table.Name
        For Each $Column In $Table.Columns
            ? Chr(9) + "Column: " + $Column.Name
        Next
    Next
    $Conn.Close
EndFunction

$=ListTablesADOX($dbfile)

KiXtart: Enumerate Local Shares

2009-07-07T14:21:00.001-07:00


Break ON

$strComputer = "."
$tab = Chr(9)

$objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\$strComputer\root\cimv2")
$colShares = $objWMIService.ExecQuery("Select * from Win32_Share")
$numshares = $colShares.Count

? "shares found: $numshares"

For each $objShare in $colShares
    $n = $objShare.Name
    If Right($n,1) = "$$"
        $shareType = "HIDDEN"
    Else
        $shareType = "OPEN"
    EndIf
    ? $objShare.Name + $tab + $shareType + $tab +
        $objShare.Path + $tab + $objShare.Caption + $tab +
        $objShare.Type
Next

VBscript Outsourcing to KiXtart

2009-07-05T12:16:00.000-07:00

If you register the Kixtart.dll component you can invoke the "KiXtart.Application" interface to handle some basic inventory chores. This does not work from PowerShell v2 by the way.


On Error Resume Next
Set objKiX = CreateObject("KiXtart.Application")
If err.Number = 0 Then
    wscript.echo "Processor: " & vbTab & Trim(objKiX.CPU)
    wscript.echo "UserName: " & vbTab &  objKiX.UserId
    wscript.echo "Domain: " & vbTab &  objKiX.LDomain
    wscript.echo "MAC id: " & vbTab &  objKiX.Address
    wscript.echo "Privilege: " & vbTab & objKiX.Priv
    wscript.echo "Password Age: " & vbTab & objKiX.PwAge
    wscript.echo "ProductType: " & vbTab & objKiX.ProductType
    Set objKiX = Nothing
Else
    wscript.echo "kixtart.dll has not been registered"
End If

KixTart: ScriptControl JScript to Outsource Expression

2009-07-05T12:13:00.000-07:00

Use Jscript object to calculate Cosine of a value...


Function Cosine($numValue)
    $sc = CreateObject("ScriptControl")
    $sc.Language = "jscript"
    $result = $sc.Eval("Math.cos("+$numValue+")")
    $sc = 0
    $Cosine = $result
EndFunction

Test examples...


$testvalue = 45
$test = Cosine($testvalue)
? "cosine of $testvalue is: "+$test

KiXtart: ScriptControl VBScript to Outsource Expressions

2009-07-05T12:09:00.000-07:00


Function DaysOld($date)
    Dim $sc, $result
    $sc = CreateObject("ScriptControl")
    $sc.Language = "vbscript"
    $result = $sc.Eval("DateDiff("+Chr(34)+"d"+Chr(34)+", "+Chr(34)+$date+Chr(34)+", Now)")
    $sc = 0
    $DaysOld = $result
EndFunction

Function FormatDateTime($strDate, $format)
    Dim $sc, $result
    $sc = CreateObject("ScriptControl")
    $sc.Language = "vbscript"
    $result = $sc.Eval("FormatDateTime("+Chr(34)+$strDate+Chr(34)+","+$format+")")
    $sc = 0
    $FormatDateTime = $result
EndFunction

Test examples:


$testvalue = '2009/01/03 12:34:56'

$test1 = FormatDateTime($testvalue, 'vbShortDate')
$test2 = FormatDateTime($testvalue, 'vbLongDate')
$test3 = FormatDateTime($testvalue, 'vbLongTime')

? "shortdate: $test1"
? "longdate: $test2"
? "longtime: $test3"

$test4 = DaysOld($testvalue)
? "days old: $test4"

KiXtart: Array List Sorting

2009-07-05T12:06:00.000-07:00


Function ArrayList()
    ; this code creates and populates an ArrayList
    ? "Example: ArrayList object"
    $myArrayList = CreateObject("System.Collections.ArrayList")
    $=$myArrayList.Add("Dog")
    $=$myArrayList.Add("Chicken")
    $=$myArrayList.Add("Rooster")
    $=$myArrayList.Add("Hen")

    ; Now, to add an element and sort the ArrayList, all we need to do is:

    ; [1] add the new element to the ArrayList
    $=$myArrayList.Add("Pig")
    ; [2] sort the ArrayList
    $=$myArrayList.Sort()
    For each $item in $myArrayList
        ? $item
    Next
EndFunction

$x = ArrayList()

VBScript Scrape Links/IMG tags from URL

2009-07-05T12:04:00.000-07:00


args = WScript.Arguments.Count

If args <> 1 Then
    Wscript.Echo "usage: ScrapeLinks.vbs URL"
    Wscript.Quit
End If

URL = WScript.Arguments.Item(0)

Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate URL

Do Until ie.ReadyState = 4
    Wscript.sleep 10
Loop

Wscript.Echo "DOCUMENT LINKS"
Wscript.Echo

For each link in ie.Document.Links
    Wscript.Echo link, link.InnerText
Next

Wscript.Echo
Wscript.Echo "DOCUMENT IMAGE TAGS"
Wscript.Echo

For each pix in ie.Document.Images
    Wscript.Echo pix.Src
Next

ie.Quit
Set ie = Nothing

VBScript Enumerate Shortcuts

2009-07-05T12:01:00.000-07:00

Enumerate shortcuts under all-users profile and report in XML format...


Option Explicit
Const strComputer = "."

Const rKey = "Software\Microsoft\Windows NT\CurrentVersion\ProfileList"
Const rVal = "ProfilesDirectory"
Const HKCU = &H80000001
Const HKLM = &H80000002

Dim objShell, objFSO, oReg, objRootFolder, psub, p
Dim objFolder, objLink, objFsub, linkpath, uid, objLnk

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

On Error Resume Next
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")

If err.Number <> 0 Then
    wscript.echo "error: computer is not accessible"
    wscript.Quit(1)
End If

oReg.GetExpandedStringValue HKLM, rKey, rVal, p
If VarType(p) = vbNull Then
    wscript.echo "error: registry key not found"
    wscript.Quit(1)
End If

Set objRootFolder = objFSO.GetFolder(p)

wscript.echo ""
wscript.echo ""
For each objFolder in objRootFolder.SubFolders
    uid = objFolder.Name
    psub = p & "\" & uid & "\desktop"
    If objFSO.FolderExists(psub) Then
        wscript.echo vbTab & ""
        Set objFsub = objFSO.GetFolder(psub)
        For each objLink in objFsub.Files
            If InStr(1, ".lnk .url", Lcase(Right(objLink.Name,4))) <> 0 Then
                wscript.echo vbTab & vbTab & ""
                linkpath = psub & "\" & objLink.Name
                Set objLnk = objShell.CreateShortcut(linkpath)
                Select Case Lcase(Right(linkpath,4))
                    Case ".lnk":
                        ClosedTag 3, "name", objLnk.Name
                        ClosedTag 3, "fullname", objLnk.FullName
                        ClosedTag 3, "arguments", objLnk.Arguments
                        ClosedTag 3, "working", objLnk.WorkingDirectory
                        ClosedTag 3, "target", objLnk.TargetPath
                        ClosedTag 3, "icon", objLnk.IconLocation
                        ClosedTag 3, "hokey", objLnk.Hotkey
                        ClosedTag 3, "windowstyle", objLnk.WindowStyle
                        ClosedTag 3, "description", objLnk.Description
                        ClosedTag 3, "type", "filesystem"
                    Case ".url":
                        ClosedTag 3, "name", objLnk.Name
                        ClosedTag 3, "fullname", objLnk.FullName
                        ClosedTag 3, "target", objLnk.TargetPath
                        ClosedTag 3, "type", "internet"
                End Select
                wscript.echo vbTab & vbTab & ""
            End If
        Next
        wscript.echo vbTab & ""
    End If
Next
wscript.echo ""

Sub ClosedTag(indent, label, val)
    Dim i, s : s = ""
    For i = 1 to indent
        s = s & vbTab
    Next
    If Trim(val) = "" Then
        s = s & "<" & label & ">_"
    Else
        s = s & "<" & label & ">" & val & ""
    End If
    wscript.echo s
End Sub

Set objFolder = Nothing
Set objFSO = Nothing
Set objShell = Nothing

VBScript / ASP Determine Next Pay Date

2009-07-05T11:31:00.000-07:00


Function NextPayDate()
    Dim wd, base : base = CDate("6/12/2009")
    Dim today : today = Now
    If IsPayDate(today) Then
        NextPayDate = today
    Else
    wd = WeekDay(today)
    Select Case wd
        Case 6:
            ' if today is a friday
            If IsPayDate(DateAdd("d", 14, today)) Then
                NextPayDate = DateAdd("d", 14, today)
            End If
        Case 7:
            ' if today is a saturday
            If IsPayDate(DateAdd("d", 6, today)) Then
                NextPayDate = DateAdd("d", 6, today)
            Else
                NextPayDate = DateAdd("d", 13, today)
            End If
        Case Else:
            If IsPayDate(DateAdd("d", 6-wd, today)) Then
                NextPayDate = DateAdd("d", 6-wd, today)
            Else
                NextPayDate = DateAdd("d", 13-wd, today)
            End If
        End Select
    End If
End Function

VBScript / ASP Is-PayDate (Crude Version)

2009-07-05T11:16:00.001-07:00

Returns True if [dateval] is a multiple of 14 days (two weeks) from a known base pay date in the past (I picked June 12, 2009).


Function IsPayDate(dateval)
    Dim days
    Dim base : base = CDate("6/12/2009")
    If WeekDay(dateval) = 6 Then
        days = DateDiff("d", base, dateval)
        If (days Mod 14) = 0 Then
            IsPayDate = True
        End If
    End If
End Function

Example...


For each d in Split("7/2/2009,7/3/2009,7/10/2009,7/24/2009", ",")
    If IsPayDate(d) Then
        wscript.echo d & " is a pay date"
    Else
        wscript.echo d & " is not a pay date"
    End If
Next

VBScript / ASP String Validate

2009-07-03T08:25:00.001-07:00

Check if string contains a value (not Null and not empty)


Function StringVal(strval)
    If Not(IsNull(strval)) And Trim(strval) <> "" Then
        StringVal = True
    End If
End Function

VBScript / ASP Function Days-In-Month

2009-07-03T08:23:00.001-07:00


Function DaysInMonth(dateval)
    Dim nxt
    Dim tmp : tmp = DateAdd("d", -(Day(dateval)-1), dateval) ' get first day of month
    nxt = DateAdd("m", 1, tmp) ' get first day of next month
    DaysInMonth = Day(DateAdd("d", -1, nxt))
End Function

VBScript / ASP Array_Slice Function

2009-07-03T08:08:00.001-07:00

Almost as good as the PHP function Array_Slice()


Function Array_Slice(arr, start, newArray)
 Dim x : x = 0
 For i = start-1 to Ubound(arr)-1
  ReDim Preserve newArray(x)
  newArray(x) = arr(i)
  x = x + 1
 Next
 Array_Slice = Ubound(newArray)
End Function

ASP version of PHP [Die] Function

2009-07-03T08:06:00.000-07:00


Sub Die(msg)
 Response.Write "<hr/><div style=""font-family:verdana; font-size:10pt; color:red"">"
 Response.Write msg & "</div><hr/>" & vbCRLF
 Response.End
End Sub

ASP MailTo Link Generator

2009-07-03T08:04:00.000-07:00


Function LinkMail(strval)
 If StringVal(strval) Then
  If InStr(1, strval, "@") <> 0 Then
   LinkMail = "<a href='mailto:" & strval & "'>" & strval & "</a>"
  Else
   LinkMail = strval
  End If
 Else
  LinkMail = strval
 End If
End Function

ASP Google-Map Link Function

2009-07-03T08:02:00.001-07:00

Spock: "Crude, but effective"


Function MapLink(strAddress, strCity, strStateZip)
 Dim url
 If StringVal(strAddress) And StringVal(strCity) And StringVal(strStateZip) Then
  url = "http://maps.google.com/maps?hl=en&q=" & _
   Replace(strAddress, " ", "+") & ",+" & _
   Replace(strCity, " ", "+") & ",+" & strStateZip & _
   "&ie=UTF8&split=0&gl=us&ei=OWlNStjaNo-Ztgfi5p2oBA&t=h&z=16&iwloc=A"
  MapLink = "
<a href="http://www.blogger.com/%22%20&%20url%20&%20%22" target="_blank">View Map</a>" & vbCRLF
 Else
  MapLink = ""
 End If
End Function

ASP ListBox for U.S. State Abbreviations

2009-07-03T07:59:00.002-07:00


Sub StatesList(default)
 Dim lst, x
 lst = "AL,AK,AZ,AR,CA,CO,CT,DE,DC,FL," & _
  "GA,HI,ID,IL,IN,IA,KS,KY,LA,ME," & _
  "MD,MA,MI,MN,MS,MO,MT,NE,NV,NH," & _
  "NJ,NM,NY,NC,ND,OH,OK,OR,PA,RI," & _
  "SC,SD,TN,TX,UT,VT,VA,WA,WV,WI,WY"

 If default = "" Then
  Response.Write "" & vbCRLF
 End If

 For each x in Split(lst, ",")
  If Ucase(x) = Ucase(default) Then
   Response.Write "" & vbCRLF
  Else
   Response.Write "" & vbCRLF
  End If
 Next
End Sub

Example:


<select name="state" size="1">
    <% StatesList "VA" %>
</select>

VBScript / ASP String Padding

2009-07-03T07:59:00.001-07:00


Function PadString(strval, delim, length, side)
 Dim tmp : tmp = Trim(strval)
 Select Case Ucase(Left(side,1))
  Case "L":
   Do While Len(tmp) < length
    tmp = delim & tmp
   Loop
  Case "R":
   Do While Len(tmp) < length
    tmp = tmp & delim
   Loop
 End Select
 PadString = tmp
End Function

VBScript / ASP Date Formatter Function

2009-07-03T07:56:00.000-07:00



Function FDate(dateval, mode)
 Select Case mode
  Case "MM/DD/YYYY": 
   FDate = FormatDateTime(dateval, vbShortDate)
  Case "YYYY-MM-DD": 
   FDate = Year(dateval) & "-" & _
    PadString(Month(dateval), "0", 2, "Left") & "-" & _
    PadString(Day(dateval), "0", 2, "Left")
  Case "Mmm D, YYYY":
   FDate = FormatDateTime(dateval, vbLongDate)
  Case "Mmm D, YYYY HH:MM:SS":
   FDate = FormatDateTime(dateval, vbLongDate) & " " & FormatDateTime(dateval, vbLongTime)
  Case "MM/DD":
   FDate = Month(dateval) & "/" & Day(dateval)
  Case "Mmm DD":
   FDate = MonthName(Month(dateval), True) & " " & Day(dateval)
  Case "MMM DD":
   FDate = MonthName(Month(dateval), False) & " " & Day(dateval)
  Case Else:
   FDate = "[FDate] invalid option parameter specified"
 End Select
End Function