Windows VBS Automated Maintenance Scripts

I had a need to automate a number of tasks for remote administration, and used Visual Basic Scripting and Windows Scripting Host Objects, since I am fairly comfortable with VB/VBA.

This is an automated defragmentation script that uses dirms.exe, a defragmentation utility found here.

Option Explicit

Dim FSO, Drive, oShell, WshShell, BtnCode, rtn, hd, stComp
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oShell = WScript.CreateObject ("WScript.shell")
'''' ''''''''''''''''''' DIRMS.EXE USAGE
' dirms c -q : Do free space evaluation, defragment, and quickly move files to the front of the drive
' dirms c DEFRAG -q : Defragment files only
' dirms c CoMpAcT -q : C ompact only
' dirms c COMFRAG -q : Perform partial compaction (quickly) on all fragmented files
' dirms c COMFRAG c:\filename.exe : Perform partial compaction on one file
' dirms c move date -q : Move files according to modification dates, and do it quickly

' dirms c move lcn : Try to free space at the bottom of the drive (moves files toward the front of the drive)
'''''''''''''''''''''''''''''''''''''''''''''''

' This sets the drive type to look for to Fixed

Const constFixed = 2
' enumerate all drives

For Each Drive in FSO.Drives

If Drive.DriveType = constFixed Then
hd = LCase(Left(Drive, 1))
stComp = StrComp("M", hd, 1) ' Returns 0 if the M drive.
' Only run if not the IFS drive

If stComp = 1 Then
' Ask the user nicely...

BtnCode = WshShell.PopUp("pcTech needs to degragment your " & Drive & " hard drive[s]. Is that OK?", 60, "pcTech", 4 + 32)
Select Case BtnCode
' Show an OK (1) or Cancel (2) button
Case 6 rtn = WshShell.PopUp("Thanks, please don't turn your PC off for 24 hours.", 5, "pcTech", 1)
If rtn = 1 Then

'do nothing
ElseIf rtn = 2 Then
Exit For
MsgBox "Defrag cancelled", 0, "pcTech"
End If
Case 7 rtn = WshShell.PopUp("Ok, we'll wait until the next time.", 5, "pcTech", 0)

End Select

Select Case ShowFileSystemType(Drive)
Case "NTFS"
' Run NTFS defrag
oShell.run "cmd /c c:\temp\dirms.exe " & hd & " -q > c:\temp\defrag_" & hd & "_hdd.txt", 0

Case "FAT"
' Run FAT defrag, yes I know, it's the same command, but I was hoping
' to find a win95 cli defrag util to use in it's place...
oShell.run "cmd /c c:\temp\dirms.exe " & hd & " -q > c:\temp\defrag_" & hd & "_hdd.txt", 0
Case "CDFS"

' Do nothing, it's a CD
Case Else
' Shit, can't defrag? We should never get this far...
BtnCode = WshShell.Popup("pcTech found no drives to defragment.", 15, "pcTech", 0 + 16)
End Select
'end of stComp check

End If

' end of Fixed Drive check
End If
Next

Set oShell = Nothing
Set FSO = Nothing
Set WshShell = Nothing

Function ShowFileSystemType(drvspec)
Dim FSO,d

Set FSO = CreateObject("Scripting.FileSystemObject")
Set d = FSO.GetDrive(drvspec)
ShowFileSystemType = d.FileSystem
End Function

This is a script that uses SpyBot to remove spyware. There was an ability to retrieve the Stats.ini file from the machine, and populate a SQL db for reporting purposes.

Option Explicit

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Set the type of file access
Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Set our input file
'Determine what our OS version is, since it is dependant on gathering statistics and placement of files
' Per this page that says our configuration.ini file is found in different places as noted below.
' http://www.spybot.info/pt/faq/23.html
'For Windows 95/98, the file is located in C:\Windows\Application Data\Spybot - Search & Destroy\.
'For Windows ME, the file is located in C:\Windows\All Users\Application Data\Spybot - Search & Destroy\.
'For Windows NT/2000/XP, you will find it in C:\Documents and Settings\All Users\Application Data\Spybot - Search & Destroy\.


Select Case GetOS
Case "0"
objINFile = "C:\Windows\Application Data\Spybot - Search & Destroy\Statistics.ini "
Case "4.9"
objINFile = "C:\Windows\All Users\Application Data\Spybot - Search & Destroy\Statistics.ini"
Case Else
objINFile = "C:\Documents and Settings\All Users\Application Data\Spybot - Search & Destroy\Statistics.ini"
End Select

' Set our output file and it's location
objOUTFile = "C:\Temp\Stats.ini"

' If our output file doesn't exist, create it, if it does, delete and create
If Not objFSO.FileExists(objOUTFile) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile(objOUTFile, True)
Set fso = Nothing
Set f1 = Nothing
ElseIf objFSO.FileExists(objOutFile) Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile objOUTFile
Set f1 = fso.CreateTextFile(objOUTFile, True)
Set fso = Nothing
Set f1 = Nothing
End If

' Move our configuration.ini file to it's proper location
Select Case GetOS
Case "0"
objConfPath = "C:\Windows\Application Data\Spybot - Search & Destroy\"
Case "4.9"
objConfPath = "C:\Windows\All Users\Application Data\Spybot - Search & Destroy\"
Case Else
objConfPath = "C:\Documents and Settings\All Users\Application Data\Spybot - Search & Destroy\"
End Select

' Now that our configuration path is set, copy the configuration.ini to it
' Use Error handling to ignore the absence of a configuration.ini

On Error Resume Next
FileSystemObject.CopyFile "C:\temp\Configuration.ini", objConfPath, True

'Open file for reading
Set objIFile = objFSO.OpenTextFile(objINFile, 1)

' Open file for writing
Set objOFile = objFSO.OpenTextFile(objOUTFile, 8)

Do Until objIFile.AtEndOfStream
strNextLine = objIFile.Readline
'grab the first charachter on the line

strFinder = Left(strNextLine, 1)

If strFinder = "[" Then 'we found our header descriptor
strDescription = Left(strNextLine, Len(strNextLine))

' decend into the list
'we know this one is LastFound date, and we don't care
strLastFound = objIFile.Readline

'we know this one is CountFound, again we don't care for this script
strCountFound = objIFile.Readline

'this one could be blank, or could be LastRemoved, which we need to know
strLastRemoved = objIFile.Readline

If strLastRemoved = "" Then
' This is a blank line, and we need to go throught the loop again
' so do nothing

Else
' it's not a blank line, it's our LastRemoved line and we don't care
' but we need to get to the next line
strCountRemoved = objIFile.Readline

intLen = Len(strCountRemoved)
intEq = InStr(strCountRemoved, "=")
intData = intLen - intEq
intTotal = Right(strCountRemoved, intData)

strLine = strDescription & "=" & intTotal & vbCrlf
'WScript.Echo strLine

objOFile.WriteLine strLine
End If

End If
Loop


objIFile.Close
objOFile.Close
'now delete our original statistics.ini

Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile objINFile
Set fso = Nothing


Function GetOS()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Determines OS by reading reg val & comparing to known values
' OS version number returned as:
' Windows 9X: 0
' Windows NT4: 4
' Windows ME: 4.9

' Windows 2k: 5
' Windows XP: 5.1
' Windows 2003: 5.2
' Windows x: >5.2
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim oShell, sOStype, sOSversion, GetOsVersionNumberReg
Set oShell = CreateObject("Wscript.Shell")


'On Error Resume Next

sOStype = oShell.RegRead(_
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
If Err.Number<>0 Then
' Hex(Err.Number)="80070002"
' - Could not find this key, OS must be Win9x
Err.Clear
GetOsVersionNumber = 0
Exit Function

End If


GetOsVersionNumberReg = oShell.RegRead(_
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
If Err.Number<>0 Then
GetOsVersionNumber = "Unknown NTx"
' Could not determine NT version
Exit Function

End If

SetLocale "en-us" ' do not remove
GetOsVersionNumber = CSng(GetOsVersionNumberReg)
If GetOsVersionNumber > 49 Then
GetOsVersionNumber = CSng(Replace(GetOsVersionNumberReg, ".", ","))
End If

GetOS=GetOsVersionNumber
End Function

This was a quickie script to run executable files silently, so as not to alert the user.

'///////////////////////////////////////////////////
'
' Use this script to hide any .exe, .com, .bat, etc.
' from popping up a cmd window. Run in the same directory
' as the executable does not require passing a path.
'
' Keep in mind that if you DO have to pass a path, that
' you enclose ANY spaces in quotations, or use old
' skool DOS charachters to represent Long FileNames,
' like progra~1 for Program Files...
'
'///////////////////////////////////////////////////

Dim oShell
Set oShell = WScript.CreateObject ("WScript.shell")

Set colNamedArguments = WScript.Arguments.Named

If Not colNamedArguments.Exists("FileName") Then
Wscript.Echo "Usage: RunCmdFile /FileName: is required."
Wscript.Quit
End If

oShell.run("%comspec% /c " & FileName),0

Set oShell = Nothing

This is a script to change a service account that a group of consultants use for administering domains.

' Create the user. If it exists, change the password
' Object Class Naming attribute
' user cn (Common Name)
' group cn (Common Name)
' computer cn (Common Name)
' container cn (Common Name)
' organizational unit ou (Organizational Unit)

' domain dc (Domain Component)
' --------------------------------------------------------------'
Option Explicit
Dim oOU, oUser, oRoot, oContainer, oSContainer, oContents, oGroup
Dim sContainer, sDomain, sPassword, bFound, sUser, oMyBusiness

sPassword = "mYwAcKyPaSs"
sUser = "consultant"
bFound = "no"
' Bind to Active Directory Domain

On Error Resume Next
Set oRoot = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then

On Error GoTo 0
' WScript.Echo "No domain found, this is a workstation."

Dim oShell
Set oShell = WScript.CreateObject ("WSCript.shell")
oShell.Run "net user techworks " & sPassword & " /ADD", 0
oShell.Run "net localgroup Administrators techworks /ADD", 0

Set oShell = Nothing

WScript.Quit
End If

sDomain = oRoot.Get("DefaultNamingContext")



Set oContents = GetObject("LDAP://" & sDomain)

For Each oContainer in oContents
' WScript.Echo oContainer.Name
'see if this is an SBS box

If oContainer.Name = "OU=MyBusiness" Then
' WScript.Echo "This might be an SBS box.."

Set oMyBusiness = GetObject("LDAP://" & oContainer.Name & "," & sDomain)
For Each oSContainer in oMyBusiness
If oSContainer.Name = "OU=Users" Then
sSContainer = "OU=SBSUsers,OU=Users,OU=MyBusiness," & sDomain

Set oOu = GetObject("LDAP://" & sSContainer)
For Each oUser in oOU
If oUser.Name = "CN=consultant" Then
bFound = "yes"
' WScript.Echo "Found techworks in " & sSContainer

oUser.SetPassword sPassword
oUser.SetInfo
WScript.Quit
End If
Next
End If
Next
End If


If "CN=Users" Then
' WScript.Echo "This is not an SBS box."
sContainer=oContainer.Name
Set oOU = GetObject("LDAP://" & sContainer & ", " & sDomain)
For Each oUser in oOU

If oUser.Name = "CN=consultant" Then
bFound = "yes"
' WScript.Echo "Found user in " & sContainer
oUser.SetPassword sPassword
oUser.SetInfo
WScript.Quit
End If
Next
End If

Next

Set oOU = Nothing
Set oContents = Nothing

If bFound = "no" Then

Set oContainer = GetObject("LDAP://CN=Users," & sDomain)
' Build the actual User.
Set oUser = oContainer.Create("User", "CN=" & sUser)
Set oGroup = GetObject("LDAP://CN=Administrators,CN=Builtin," & sDomain)
oUser.Put "sAMAccountName", sUser
oUser.Put "userPrincipalName", sUser
' This will trap an error if the user exists somewhere we
' didn't check

On Error Resume Next
oUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0

' debug
' WScript.Echo "This user exists somewhere outside normal CN containers."
' WScript.Echo "You will have to find it and change it manually."
WScript.Quit
End If

' re-use this variable to store the user path, and set the password

Set oUser = Nothing

Set oUser = GetObject("LDAP://CN=" & sUser & ",CN=Users," & sDomain)
oUser.SetPassword sPassword
oGroup.Add(oUser.ADsPath)

' give him info

oUser.Put "givenName", "Consultant"
oUser.Put "sn", "INC"
oUser.Put "displayName", "Consultant Group, INC"
oUser.Put "telephoneNumber", "(555) 555-5555"
oUser.Put "mail", "info@consultantgroup.com"
oUser.Put "wWWHomePage", "http://www.consultantgroup.com"
' enable the account

oUser.AccountDisabled = FALSE
oUser.SetInfo

End If

WScript.Quit