Archive - January 2013

"Mastering others is strength. Mastering yourself is true power." - Lao Tzu

Index

Archive and Delete Event Logs after 80MB
Auto-Fill Computer Description
Check to see if account is disabled
Cleanup Logs on Multiple Servers
Disable Flash Update
Enumerate Admins to File
List Disabled Accounts in AD

List Disabled Accounts in AD - PowerShell
Uninstall All Versions of Java Except Current
Send e-Mail When USB Gets Plugged In
Rename Script to e-Mail
Return Last Logged On User

Δ Useful Script of the Month

How to move multiple files, from many folders, into one folder

rem converge - copy files from many folders...to one folder
@echo off
title Converge Files
color 0a
set DirFrom=C:\Users\testuser\Desktop\powershell\ManyFolders\
set DirTo=C:\Users\testuser\Desktop\powershell\SingleFolder\
set FileExt=ps1
for /R "%DirFrom%" %%f in (*.%FileExt%) do copy "%%f" "%DirTo%"
pause

Δ Thursday, January 31st, 2013

Δ Archive and Delete Event Logs after 80MB

How to archive and delete computer logs

[download resource files]

Demo

Have you ever needed to monitor event log size...and then do cleanup once a storage
threshold has been reached? This script will basically monitor the event size, archive
the log to a specified folder, and then clear the event log automatically. Note, you can
change the threshold size to anything you want.

Δ [email me]

Δ Tuesday, January 29th, 2013

Δ Auto-Fill Computer Description

How to populate computer description

[download resource files]

This script could be used in your deployment script to auto-populate the computer description field.

Set WshNetwork = WScript.CreateObject("WScript.Network")
 Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
 
' Get service tag and computer manufacturer
 For Each objSMBIOS in objWMI.ExecQuery("Select * from Win32_SystemEnclosure")
 serviceTag = replace(objSMBIOS.SerialNumber, ",", ".")
 manufacturer = replace(objSMBIOS.Manufacturer, ",", ".")
 Next
 
' Get computer model
 For Each objComputer in objWMI.ExecQuery("Select * from Win32_ComputerSystem")
 model = trim(replace(objComputer.Model, ",", "."))
 Next
 
' Get computer object in AD
 Set objSysInfo = CreateObject("ADSystemInfo")
 Set objComputer = GetObject("LDAP://" & objSysInfo.ComputerName)
 
' Build up description field data and save into computer object if different from current description
 ' We also do not update computers with a description that starts with an underscore (_)
 newDescription = WshNetwork.UserName & " (" & serviceTag & " – " & manufacturer & " " & model & ")"
 if not objComputer.Description = newDescription and not left(objComputer.Description,1) = "_" then
 objComputer.Description = newDescription
 objComputer.SetInfo
 end if

Δ [email me]

Δ Friday, January 25th, 2013

Δ Check to see if account is disabled

How to check if user account is disabled or enabled

[download resource files]

Demo

This script uses the user account properties to check whether the account is enabled or disabled.

Δ [email me]

Δ Monday, January 21st, 2013

Δ Cleanup Logs on Multiple Servers

How to cleanup logs on servers

[download resource files]

You can list servers in the script that you would like to archive log files to a compressed folder.

# Script to cleanup IIS files on various given servers

#define parameters
$iispath03 = "\C$\WINDOWS\system32\LogFiles\"
$iispath08 = "\C$\inetpub\logs\LogFiles\"
$OS = "default"

#set archive period after which to move logs to compressed folder
$Now = Get-Date
$Days = "8"
$LastWrite = $Now.AddDays(-$days)

#define list of IIS servers to cleanup logs on
$IISServers = @("server1","server2","server3","server4","etc","etc","etc","etc")

#Define Function to check if server 03 or 08
Function GetServerOS
{param ($strServerName)
$strCategory = "computer"
$strfilter = "(&(objectCategory=Computer)(Name=$strServerName))"

$objDomain = New-Object System.DirectoryServices.DirectoryEntry
$objSearcher = New-Object System.DirectoryServices.DirectorySearcher
$objSearcher.SearchRoot = $objDomain
$objSearcher.Filter = $strfilter
$colProplist = “operatingsystem”

foreach ($i in $colPropList){$objSearcher.PropertiesToLoad.Add($i)}

$colResults = $objSearcher.FindAll()

foreach ($objResult in $colResults)
{$objComputer = $objResult.Properties
$objComputer.operatingsystem
}

}

#Gather list of IIS log file directories
foreach ($server in $IISServers)
{

#Check OS of server in question
$FullOS = GetServerOS $server
if ($FullOS[1].Contains("2003")){
$OS = "2003"
$IISDir = "\\" + $server + $iispath03
}
elseif($FullOS[1].Contains("2008")){
$OS = "2008"
$IISDir = "\\" + $server + $iispath08
}
else{
$OS = "Error"
$IISDir = "Error"
}

$IISLogDirs = dir $IISDir W3* | where {$_.psIsContainer -eq $true} | select fullname
if($IISLogDirs)
{

#Cycle through each of the discovered directories
foreach ($dir in $IISLogDirs)
{
#set current directory (should be compressed) to archive files to
$archivedir = $dir.fullname + "\" + $Now.year + "\"

#check if the current year directory exists, if not create it
if (!(Test-Path -path $archivedir))
{
New-Item $archivedir -type directory
}

#Get list of log files to cleanup
$logfiles = get-childitem $dir.fullname *.log | Where {$_.LastWriteTime -le "$LastWrite"} | select fullname
if($logfiles)
{
foreach ($file in $logfiles)
{
copy-item $file.fullname $archivedir
remove-item $file.fullname
}

}

Δ [email me]

Δ Friday, January 18th, 2013

Δ Disable Flash Update

How to stop the flash player from updating

[download resource files]

Demo

This is one way to disable the flash player from auto updating. The settings are located in
the mms.cfg which gets copied to the Flash folder.

Δ [email me]

Δ Thursday, January 17th, 2013

Δ Enumerate Admins to File

How to return admins

[download resource files]

Demo

Enumerates admins to a file...including nested groups.

Option Explicit
WScript.TimeOut = 20 'Just in case we get hung somewhere.

Dim fso,logfile, appendout
Dim wshShell: Set wshShell = WScript.CreateObject("WScript.Shell")

'setup log
Const ForAppend = 8
set fso = CreateObject("Scripting.FileSystemObject")

Dim aGroups: aGroups = Array()
Dim objNetwork, objLocalGroup

' These attributes must be declared in the main program,
' so they are global in scope.
Dim objTrans, strComputer, strNetBIOSDomain

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

' Determine NetBIOS name of domain and local computer.
Set objNetwork = CreateObject("Wscript.Network")
strNetBIOSDomain = objNetwork.UserDomain
strComputer = objNetwork.ComputerName
Set objNetwork = Nothing

' Bind to local Administrators group.
Set objLocalGroup = GetObject("WinNT://" & strComputer  & "/Administrators,group")
'to desktop
'logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & strComputer & "_Admins.txt"
'to current folder
logfile = ".\" & strComputer & "_Admins.txt"
If fso.FileExists(logfile) Then fso.DeleteFile logfile,True

Set appendout = fso.OpenTextFile(logfile, ForAppend, True)

' Enumerate members of the local group.
Call EnumLocalGroup(objLocalGroup)

wshShell.Run logfile

' =========== Functions and subs 
Sub EnumLocalGroup(ByVal objGroup)
    ' Subroutine to enumerate members of local group.
    ' The variable strComputer has global scope.

Dim objMember
    ' Enumerate direct members of group.
    For Each objMember In objGroup.Members

EchoAndLog  objMember.AdsPath

' Test if member is a group.
        If (LCase(objMember.Class) = "group") Then
            ' Nested group. Test if objMember is a local group.
            If (InStr(LCase(objMember.AdsPath), "/" _
                    & LCase(strComputer) & "/") > 0) Then
                ' objMember is a local group.
                ' Call sub recursively to enumerate nested local group.
                Call EnumLocalGroup(objMember)
            ElseIf (InStr(LCase(objMember.AdsPath), _
                    "/nt authority/") > 0) Then
                ' objMember is local implicit group (special identity).
                ' Membership cannot be enumerated.
            Else
                ' objMember is a domain group.
                ' Call sub that uses LDAP provider to enumerate
                ' nested domain group. objMember is bound with
                ' WinNT provider.
	        	 If isNewGroup(aGroups, objMember.Adspath) Then 
	            	' Call sub recursively. objMember bound with LDAP. Original code
	            	Call EnumDomainGroup(objMember, True)
	            End If 
            End If
        End If
    Next
End Sub

Sub EnumDomainGroup(ByVal objDomainGroup, ByVal blnNT)
    ' Subroutine to enumerate members of domain group.
    ' blnNT is True if objDomainGroup is bound with WinNT,
    ' False if bound with LDAP.
    ' The variables objTrans and strNetBIOSDomain have global scope.
    On Error Resume Next 
    Dim strNTName, strGroupDN, objGroup, objMember

' Check if this function called before.
    If (IsEmpty(objTrans) = True) Then
        ' objDomainGroup must be bound with WinNT.
        ' Setup NameTranslate. Connect to Global Catalog.
        Set objTrans = CreateObject("NameTranslate")
        objTrans.Init ADS_NAME_INITTYPE_GC, ""

' Convert NetBIOS name of group to Distinguished Name.
        strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
        objTrans.Set ADS_NAME_TYPE_NT4, strNTName
        strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        strGroupDN = Replace(strGroupDN, "/", "\/")
    Else
        ' NameTranslate already setup. Check if objDomainGroup
        ' bound with WinNT.
        If (blnNT = True) Then
            ' Convert NetBIOS name of group to Distinguished Name.
            strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
           
            objTrans.Set ADS_NAME_TYPE_NT4, strNTName
            strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
            
            If Err <> 0 Then 
	            EchoAndLog "	!!! Could not enumerate membership of " & strNTName
				Exit Sub 
            End If
            ' Escape any forward slash characters, "/", with the backslash
	        ' escape character. All other characters that should be escaped are.
	        strGroupDN = Replace(strGroupDN, "/", "\/")
        Else
            ' objDomainGroup bound with LDAP. Retrieve Distinguished Name.
            strGroupDN = objDomainGroup.distinguishedName
            ' Escape any forward slash characters, "/", with the backslash
            ' escape character. All other characters that should be escaped are.
            strGroupDN = Replace(strGroupDN, "/", "\/")
        End If
    End If
    ' Bind to group with the LDAP provider, if required.
    If (blnNT = True) Then
        Set objGroup = GetObject("LDAP://" & strGroupDN)
    Else
        Set objGroup = objDomainGroup
    End If
    ' Enumerate direct members of objDomainGroup (bound with LDAP).
    For Each objMember In objGroup.Members
    	If (LCase(objMember.Class) = "group") Then 'show members as indented
			EchoAndLog objMember.AdsPath
		Else
    		EchoAndLog vbTab &  objMember.AdsPath		
		End If 
		
        ' Check if objMember is a group.
        If (LCase(objMember.Class) = "group") Then
        	If isNewGroup(aGroups, objMember.Adspath) Then 
            	' Call sub recursively. objMember bound with LDAP. Original code
            	Call EnumDomainGroup(objMember, False)
            End If 
        End If
    Next
    On Error GoTo 0 
End Sub

Function isNewGroup(aList, NewItem) 'check for new items
	'Kaplan addition to avoid recursive loops
	On Error GoTo 0
	Dim I, ItemFound
	For I = LBound(aList) to UBound(aList)
	   If aList(I) = NewItem Then
	      ItemFound = True
	      Exit For
	   End If
	Next
	
	If Not ItemFound Then
	   isNewGroup = True 
	   ReDim Preserve aList(Ubound(aList) + 1)
	   alist(I)=newitem    
	   'WScript.Echo "Added " & Newitem & " to array"
	Else
		isNewGroup = False
		EchoAndLog "!!! Skipping," & newitem & " membership has been enumerated before and may be a recursion!" 
	End If
End Function

Sub EchoAndLog (message)
	'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub

Δ [email me]

Δ Thursday, January 10th, 2013

Δ List Disabled Accounts in AD

How to list disabled accounts

[download resource files]

This will list the disabled accounts to a text file named report.txt.

'on error resume next 'This script will list all disable accounts in the domain Const ADS_UF_ACCOUNTDISABLE = 2 Const OPEN_FILE_FOR_WRITING = 2 Const OPEN_FILE_FOR_Appending = 8 strFile = "report.txt" strWritePath = "c:\" & strFile strDirectory = "c:\" '######### Set objFSO1 = CreateObject("Scripting.FileSystemObject") If objFSO1.FileExists("c:\" & strFile) Then Set objFolder = objFSO1.GetFile("c:\" & strFile) Else Set objFile = objFSO1.CreateTextFile(strDirectory & strFile) 'Wscript.Echo "Just created " & objFolder & "\" & strFile objFile = "" End If '######### Set fso = CreateObject("Scripting.FileSystemObject") Set textFile = fso.OpenTextFile(strWritePath, OPEN_FILE_FOR_WRITING) Set objConnection = CreateObject("ADODB.Connection") objConnection.Open "Provider=ADsDSOObject;" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection objCommand.CommandText = "<LDAP://dc=YOURCHILDDOMAINNAMEHERE(IF YOU HAVE ONE),dc=YOURDOMAINNAMEHERE,dc=com>;(objectCategory=User)" & ";userAccountControl,distinguishedName;subtree" objCommand.Properties("Page Size")=3000 Set objRecordSet = objCommand.Execute intCounter = 0 While Not objRecordset.EOF intUAC=objRecordset.Fields("userAccountControl") If intUAC AND ADS_UF_ACCOUNTDISABLE Then 'WScript.echo objRecordset.Fields("distinguishedName") & " is disabled" textFile.WriteLine(objRecordset.Fields("distinguishedName")) intCounter = intCounter + 1 End If objRecordset.MoveNext Wend WScript.Echo VbCrLf & "A total of " & intCounter & " accounts are disabled." objConnection.Close WScript.Echo "Done..." AppToRun = "c:\report.txt" CreateObject("Wscript.Shell").Run AppToRun WScript.Quit

Δ [email me]

Δ Wednesday, January 9th, 2013

Δ List Disabled Accounts in AD - PowerShell

How to list disabled accounts using powershell

[download resource files]

List disabled accounts using PowerShell.

Δ [email me]

Δ Monday, January 7th, 2013

Δ Uninstall All Versions of Java Except Current

How to uninstall java versions

[download resource files]

Demo

This will collect the list of installed java versions to be uninstalled. There is an input field
for the workstation name.

Option Explicit
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adInteger = 3
Const adDate = 7 
Dim oWMI, oRS
Dim strComputer
Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote, strArgs, i
	quote=chr(34)
	
	For i  = WScript.Arguments.Count -1 to  0 Step -1
		strArgs = WScript.Arguments(i) & Space(1) &  strArgs
	Next
	
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 1, true
    WScript.Quit            	'...and stop running as WScript
End If

If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments(0)
Else
	strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
	strComputer = InputBox("Uninstall old Java from what PC","PC Name?",strComputer)
End If

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

On Error Resume Next
Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
If Err.Number <> 0 Then 
	WScript.Echo Err.Description
	WScript.Quit
End If

Set oRS = CreateObject("ADOR.Recordset")
oRS.Fields.Append "Caption", adVarChar, MaxCharacters
oRS.Fields.Append "Version", adVarChar, MaxCharacters
oRS.Fields.Append "ID", adVarChar, MaxCharacters
oRS.Fields.Append "Date", adDate, adFldIsNullable
oRS.Open

WScript.Echo "Collecting a list of Java installations on " & strComputer &	".  This can take a while, please wait ..."

Dim dStart
dStart=Now 
WScript.Echo(dStart)

GetList ()
	
WScript.Echo "Elapsed time in seconds: " & DateDiff("s", dStart, now)
	
oRS.Sort = "Date ASC"
oRS.MoveFirst

If oRS.BOF And oRS.EOF Then 
	MsgBox  "Java not installed.",vbInformation + vbOKOnly,strComputer
	WScript.Quit
End If

If oRS.RecordCount = 1 Then 
	MsgBox "Only one version of Java is installed, " & oRS.Fields.Item("Caption")&  Space(1) & oRS.Fields.Item("Version"), _
		vbInformation + vbOKOnly,strComputer
		WScript.Quit
Else

Wscript.Echo "Skipping newest, " & oRS.Fields.Item("Caption")&  Space(1) & oRS.Fields.Item("Version")
	oRS.MoveNext	'Skip newest
	
	Do Until oRS.EOF    
	    Uninstall oRS.Fields.Item("ID"), oRS.Fields.Item("Caption")
		oRS.MoveNext
	Loop

End If

oRS.Close

Function GetList()
	Dim strQuery, colItems
	Dim oItem
	strQuery = "SELECT caption, version, identifyingnumber, installdate2 FROM Win32_Product where caption like '%Java%'"
	Set colItems = oWMI.ExecQuery(strQuery,,48) 
	
	For Each oItem In colItems
	   oRS.AddNew
	   oRS("Caption") = oItem.Caption
	   oRS("Version") = (oItem.Version)
	   oRS("ID") = (oItem.IdentifyingNumber)
	   oRS("Date") = WMIDateStringToDate(oItem.InstallDate2)
	   oRS.Update
	Next
End Function

Sub Uninstall(strID, strName)
	Dim colSoftware, objSoftware, retval 
	Set colSoftware = oWMI.ExecQuery("Select name from Win32_Product where identifyingNumber ='" & strID & "'")
	If isnull(colsoftware.count) or Err.Number <> 0 Then
		MsgBox strName & " was not found on " & strcomputer,vbcritical+vbokonly,"Fatal Error"
		WScript.Quit
	End If
	
	For Each objSoftware in colSoftware
		WScript.Echo "Uninstalling " & objSoftware.Name & " from " & strComputer
		retval = objSoftware.Uninstall()
		If retval = 0 Then 
			WScript.Echo  "Successfully uninstalled " & ObjSoftware.Name & " from " & strComputer
		Else
			Wscript.Echo "Failed with error code " & retval
		End If 
	Next
End Sub

Function WMIDateStringToDate(dtmDate)
	Dim dtm
	'WScript.Echo dtm: 
	WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
	Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
	& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function

Δ [email me]

Δ Friday, January 4th, 2013

Δ Send e-Mail When USB Gets Plugged In

How to send emails in your scripts

[download resource files]

If you haven't sent alerts or notifications via your scripts, you really have to try this one out.
Basically, when you plug in a USB drive, the user gets and alert, and you receive an email.
It uses an open smtp server to send the email. Note, this has been tested under Windows XP
only. When I test it under Windows 7/8, I'll post it again.

Option Explicit

Dim bDebug, bNotify, bCSV, bVerbose, bAnnoy, aAlwaysBeep
Dim strSubject, strBody, strTo, strFrom
Dim strTestEmail, aIgnoreList, message
Set objNet = CreateObject("Wscript.Network")
strComputer = objNet.Computername
Dim  strDrive
dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim dExceptions                   ' Create a dictionary.
Set dExceptions = CreateObject("Scripting.Dictionary")
dim ExcludeNames, PNPIDs, strModel
Const TextCompare = 1
dExceptions.CompareMode = TextCompare
Dim dLastTime: dLastTime= "3/10/2007 12:32" 'arbitrary time in the past
Dim bSkipAdmins, bExitIfServer, strSite
dim bReportSanctuary, bSanctuaryBail

' ****** ======== EDIT YOUR SETTINGS HERE  ====== ******
'if bDebug True messages echo showing postion in code.  
'Debug is for testing, DO NOT DEPLY WITH THIS SET TO TRUE! 
bDebug = False

'Don't run if user has admin rights on computer
'This may not work on post XP OS because of UAC/you may have to do a runas or load at logon
bSkipAdmins = False

'if true, script will quit for server OS
bExitIfServer = True

' Attempt to eject drive, requires usb_Drive_Ejector.exe from 
bEject = True

'Bail if end point control software installed
bSanctuaryBail = False

'Report end point control software state
bReportSanctuary = False

'Free SMTP Mail server - you probably won't need to edit this
Const strMailServer = "mail.bellsouth.net"

'ADD EMAIL ADDRESSES HERE TO RECEIVE THE EMAILS";"
strTo = "mrnettek@hotmail.com;mrnettek@hotmail.com"

'DEBUG TESTING EMAIL
strTestEmail = "mrnettek@hotmail.com"

'Verbose adds Device IDs to email.  Good for creating exclusion list.
bVerbose = True

'You can use strSite with a select case or if statement to provide 
'customized messages depending on AD site
'comment next two lines out if not running in an NT domain
'Set oSI = CreateObject("ADSystemInfo")
'strSite = oSI.SiteName

'List of USB Storage devices that will not cause message to be sent
'Compared against all or part of the the Device ID. No spaces! 
'These will be ignored for all users and all workstations
aIgnoreList = Array("FLOPPY","CDROM","CARDREADER","LASERJET","DVR","OFFICEJET")

'Special list of exceptions paired to Computername or UserName CAPS
'first column is a key, and cannot be duplicated.  
'dExceptions.Add "PCName", "VEN_FLIP&PROD_VIDEO_CAMCORDER&REV_\PS50001&0"
'dExceptions.Add "USERNAME", "DEVICE&REV_9339"

ExcludeNames = dExceptions.Keys
PNPIDs = dExceptions.items

'From line.  Set an orignation address
'strFrom = "usbalerts@domain.com

'Default computername@domain.com
strFrom = strComputer & "@hotmail.com"

'If true, user gets popup msgbox with warning below
bNotify = True

'If True, computer beeps until drive removed or dismounted, annoying user
bAnnoy = True

'list of devices that will always get a beep, even if bAnnoy is false
aAlwaysBeep = Array("IPOD","GPX&PROD_AUDIO_PLAYER")

'If true then CSV info is added to message to cut and paste into spreadsheet.
bCSV = True

'Popup warning message
message =  "       NOTICE!  " & VbCrLf & VbCrLf  &  "The USB device you have inserted violates our security rules. " & _
"Only company issued USB devices are allowed."

' ========== End Edits =======
'Email Constants do not change!
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSendUsingPort = 25
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
'RS Constants do not change
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adDouble = 5

Dim strComputer, wshShell,objNet
Dim oWMI, colMonitoredEvents, objLatestEvent, strNTName, strMyName,strMyCSVName, strDescription
Dim oSI, oRS
Dim Fields, i
Set wshShell = WScript.CreateObject("wscript.shell")
Dim m_objCDO, m_objCDOcon
Dim colitems, USBItem
Dim strUSBName, strUSBID, strConnected, iUSBSize, USBNames, USBPNPIDs
Dim quote
Dim bEject 
quote=chr(34)

'Connect to WMI
Set oWMI = GetObject("winmgmts:\\"& strComputer & "\root\cimv2")
'Bail if you can't connect to WMI
If Err <> 0 Then WScript.Quit

Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = oWMI.ExecQuery("SELECT ProductType FROM Win32_OperatingSystem",,48)

Dim objItem, strProductType
For Each objItem In colItems
  strProductType = objItem.ProductType
Next

If bExitIfServer Then
	If strProductType <> 1 Then WScript.Quit
End If

If bSkipAdmins And IsAdmin Then 
	If bDebug Then WScript.Echo "Exiting, user is administrator"
	WScript.Quit
End If

Dim strServiceMessage, bServiceInstalled

If bSanctuaryBail Then 
	CheckService "scomc", "Sanctuary"
	
	If bServiceInstalled and bSanctuaryBail Then 
		If bDebug Then WScript.Echo "Exiting, End Point Security Installed"
		WScript.Quit
	End If 
End If

if bDebug then aIgnoreList = Array("FLOPPY","CDROM")

'ref http://www.devguru.com/Technologies/ado/quickref/record_fieldscollection.html

'create disconnected recordset -- note the ADOR
Set oRS = CreateObject("ADOR.Recordset")
oRS.Fields.Append "Model", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "PNPID", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "Size", adDouble, adFldIsNullable
oRS.Open

If Not IsCScript() and bDebug = True Then 		'debug in CScript
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote 
    WScript.Quit            				'...and stop running as Wscript
End If

If IsCScript() and bDebug = False Then 		'If  CScript and not debugging re-run with wscript...
	WshShell.Run "WScript.exe " & quote & WScript.ScriptFullName & quote 
    WScript.Quit            				'...and stop running as WScript
End If

strNTName = objNet.UserName
GetName

strComputer = uCase(strComputer)
strNTName =uCase(strNTName)

If dExceptions.Exists(strComputer) or dExceptions.Exists(StrNTName) Then 
	AddExclude strComputer
End If

'Disable error messages...
If not bdebug then On Error Resume Next
If bDebug Then WScript.Echo "Debug mode"

CheckNow True 'True means first time run
CreateSink

Sub CheckNow(bStartup)
	strConnected = ""
	strUSBID = ""
	strUSBName = ""
	
	'This runs to pickup devices connected before script started
	
	Set colitems = oWMI.ExecQuery("Select model, size, pnpdeviceID from Win32_diskdrive where interfacetype = 'USB' and size > 1")
	
	For Each USBItem In colitems
	
		If USBItem.pnpdeviceID = strUSBID Then  'Ignore duplicate entries in same detection
			strUSBName = ""
		Else
			strUSBName =  USBItem.model 
			strUSBID = USBItem.pnpdeviceID
			iUSBSize = round(USBItem.Size /1024 /1024)
			
			For i = 0 To UBound(aIgnoreList)
				If InStr(ucase(strUSBID),uCase(aIgnoreList(i))) > 0 Then	'avoids type mismatch of binary compare
					If bDebug Then WScript.Echo "Skipping " &  strUSBID &  " which contains " & aIgnoreList(i)
					strUSBName = ""
				End If 
		Next
		
		End If 
		
		If len(strUSBName) > 1 Then
			oRS.AddNew
		    oRS("Model") = strUSBName
		    oRS("Size") = iUSBSize
		    oRS("PNPID") = strUSBID
		    oRS.Update
		End If 
	
	Next

If oRS.RecordCount> 0 Then Notifier strConnected, bStartup
End Sub

Sub CreateSink()
	'This runs to look for new insertions of devices.  "Within 5", below is a 5 second check interval
	
	Dim strWQL 'Query that creates the sink
	If bDebug Then Wscript.echo "Creating WMI sink"	
	
	strWQL = "SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE Targetinstance ISA 'Win32_PNPEntity'" & _
	" and TargetInstance.DeviceId like '%USBSTOR%'"
	
	Set colMonitoredEvents = oWMI.ExecNotificationQuery(strWQL) 
	
	Do
		If bDebug Then WScript.Echo "Waiting for events"
		Set objLatestEvent = colMonitoredEvents.NextEvent
		CheckNow False
	Loop
	
End Sub

Sub Notifier(strUSBType,bStartup)
	If bDebug Then On Error Resume Next
	If DateDiff("s",dLastTime,Now) <5 Then  
		if bDebug then WScript.Echo "Skipping notification within 5 seconds of previous" 
		Exit Sub 
	End If 
	
	if bDebug then Wscript.echo "USB insertion event detected"
	Dim i		
	Dim strTime
	strTime = Time
	
	oRS.Sort = "Model"
	oRS.MoveFirst
	Do Until oRS.EOF
		strModel = oRS.Fields.Item("Model")
		If bVerbose Then 
			strConnected = strConnected & strModel & ", " & oRS.Fields.Item("size") &" MB,"  & " (" & oRS.Fields.Item("PNPID") & ")" & VbCrLf  
		Else
			strConnected = strConnected & strModel & ", " & oRS.Fields.Item("size") &" MB,"  & VbCrLf  
		End If 
	oRS.MoveNext
	Loop
	
	If bStartUp = True Then ' initial event
		strSubject = "USB storage detected at logon onto " & strComputer 
		strBody = "User " & objNet.Username & strMyName & ", had the following " & oRS.RecordCount& " USB storage device"
		If oRS.RecordCount> 1 Then strBody = strBody & "s"
		strBody= strBody & " found connected when monitoring began of " & strComputer & _
		" at " & strTime & " on " & Date & ":" & VbCrLf & VbCrLf 
	Else
		strSubject = "USB storage detected on " & strComputer
		strBody = "User " & objNet.Username & strMyName & " at " & strTime & " on " & Date & _
		", connected to " & strComputer & " the following USB storage device:" & VbCrLf
	End If

strBody = strBody & strConnected & VbCrLf & strServiceMessage
		
	If bCSV Then 
		Dim CsvText
		oRS.MoveFirst
		Do Until oRS.EOF
		' Iterate the dict. again for CSV data
			csvtext  =CsvText  & _
			Date & "," &  strTime & "," & quote &  objNet.Username & quote & "," &  quote & strMyCSVName &_
			quote & "," & strComputer & "," & quote & oRS.Fields.Item("Model") & quote & ","  & oRS.Fields.Item("size") & "," & quote & oRS.Fields.Item("PNPID") & quote &  VbCrLf  
		oRS.MoveNext
		Loop
			strBody = strBody & VbCrLf & VbCrLf & String(10,"=") & " CSV DATA " & String(10,"=") & VbCrLf  & CsvText		
	End If 
	
	If bDebug Then strBody = strBody & VbCrLf & VbCrLf & "******* TEST MESSAGE ONLY ********"

Set m_objCDO = CreateObject("CDO.Message")
	Set m_objCDOcon = CreateObject("CDO.Configuration")
	'Setting up Mail
	'Note that I am relying on a server that does not require authentication
	'this is because the username/pw would be in plaintext, available to the
	'user.  You can use authentication -- see CDO docs
	
	Set Fields = m_objCDOcon.Fields
	With Fields
	   .Item(cdoSendUsingMethod)       = 2
	   .Item(cdoSMTPServer)            = strMailServer
	   .Item(cdoSMTPServerPort)        = cdoSendUsingPort
	   .Item(cdoSMTPConnectionTimeout) = 100   
	   .Update
	End With
	
	'Passing parameters to message object
	Set m_objCDO.Configuration = m_objCDOcon
	
	If bDebug Then strTo = strTestEmail
	
	With m_objCDO
	    .To       = strTo
	    .From     = strFrom
	End With

m_objCDO.TextBody = strBody
	m_objCDO.Subject  = strSubject
	
	i = 0

'Retry if fails to send
    Do
		If bDebug Then Wscript.echo "Waiting to send mail loop"
    	Err.Clear
    	m_objCDO.Send
    	
    	if bDebug Then 
    		If Err <> 0 Then WScript.Echo "Error number: " & Err.Number & VbCrLf & Err.Description
    	End If  
		
		WScript.Sleep 6000				'Wait a minute
		i = i + 1
		If Err = -2147220975 Then i = 10

Loop Until Err.Number = 0 Or i = 10 	'after 10 times bail or untrusted failure
	
	If bDebug Then 
		if  i <> 10 Then 
			Wscript.echo "Mail sent"
		Else
			WScript.Echo "Error sending mail, skipped"
		End If 
	End If 
	
	Set m_objCDO = Nothing
	Set m_objCDOcon = Nothing
	
	If bNotify Then 
		WShshell.popup message,60,"Security Violation: " & strModel,vbcritical + vbOKOnly + vbSystemModal
	End If	
	
	strDrive = GetDriveLetter

'Possible additions here: MoveAll to local drive , Delelete Allfiles, WriteWarning to file

If bAnnoy Then 	
		AnnoyUser()
	Else
		If UBound(aAlwaysBeep) = 0 Then 	'if nothing in Always beep list, run eject here instead of in AnnoyUser routine.
			If bEject Then EjectDrive
		End If 
		
		For i = 0 To UBound(aAlwaysBeep)
			If InStr(ucase(strUSBID),uCase(aAlwaysBeep(i))) > 0 Then	'avoids type mismatch of binary compare
				AnnoyUser()
				Exit For 
			End If 
		Next
	End If 
	
	'empty
	oRS.MoveFirst
	Do While Not oRS.EOF
	    oRS.Delete
	    oRS.MoveNext
	Loop
	
	dLastTime = Now()
	If bDebug Then On Error GoTo 0
End Sub

Sub EjectDrive()
	'get path name, ending in \
	Dim scriptpath, strCommand, strExePath
	scriptpath = Left(Wscript.ScriptFullName, InStrRev(Wscript.ScriptFullName, "\"))
	strExePath = scriptpath & "USB_Disk_Eject.exe" 
	
	If Not fso.FileExists(strExePath) Then
		If bDebug Then 
			message = "This function requires USB_Disk_Eject.exe to be in the same folder as the script. " & _
			"You can download it from http://quick.mixnmojo.com/usb-disk-ejector. Please support the shareware author!"
			MsgBox message,vbCritical + vbOKOnly,"File not found"
			WScript.Quit
		End If 
		Exit Sub 
	End If 
	
	If fso.DriveExists(strDrive) Then 
		strcommand = quote &  strExePath  & quote & " /Silent /REMOVELETTER " & strDrive
		If bDebug Then WScript.Echo strcommand 
		wshShell.Run strcommand,0,True
		MsgBox "The " & strModel & " has been disconnected. Please unplug it.",vbCritical + vbokonly,"Drive Dismounted" 
	End If 
End Sub

Sub AnnoyUser()
	Dim iAnnoy, tmpMsg
	iAnnoy = 0

For iAnnoy = 0 To 10	
		If bDebug Then WScript.Echo "Beep...."
		If bDebug Then WScript.Echo "Drive is " & strDrive
		If fso.DriveExists(strDrive) Then 
			beep 
			If bEject Then EjectDrive
		Else
			Exit Sub
		End If 
			
		If iAnnoy = 10 Then 
			tmpMsg =  "Beeps will continue until you remove the " & strModel & " from this computer."
			wshShell.Popup tmpMsg,10,"VIOLATION!",vbCritical+vbOKOnly
			iAnnoy =0
		End If
	Next

End Sub

Sub beep()
	Dim iWait 
	If bEject Then
		iWait = 15
	Else
		iWait = 2
	End If 
	
	wshShell.run "cmd /C " & chr(34) & "@echo " &  String(7,chr(7)) & chr(34),0,True
	wshShell.Popup "Unplug drive!",iWait,"Violation!",vbCritical 
End Sub

Function GetDriveLetter()
If bDebug Then WScript.Echo "Getting drive letter of USB drive"
Dim colDiskDrives, oDiskDrive, colDrives, colLDrives, oLDrive
Dim strWQL, colPartitions, oPartition
Dim i

Set colDiskDrives = oWMI.ExecQuery("SELECT * FROM Win32_DiskDrive where InterfaceType='USB' and size > 0",,48)

For Each oDiskDrive In colDiskDrives 'Get USB Drives.  DeviceID looks like \\.\PHYSICALDRIVE1
      strModel = oDiskDrive.Caption
	   strWQL =  "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & oDiskDrive.deviceID & _
		 "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
	   Set colPartitions = oWMI.ExecQuery(strWQL,,48)
	   For Each oPartition In colPartitions
	   	i = i + 1
	   	'WScript.Echo "Partition: " & oPartition.DeviceID 'Device ID looks like Disk #1, Partition #0
		 strWQL = "ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & oPartition.DeviceID & _
		 "'} WHERE AssocClass = Win32_LogicalDiskToPartition"
		 
		 Set colLDrives = oWMI.ExecQuery(strWQL,,48)
		 	For Each oLDrive In colLDrives
		 			GetDriveLetter = oLDrive.DeviceID	'Device ID looks like E:
			Next
	   Next	 
   Next
 End Function

Function IsAdmin()
	'This may not work with post XP because of UAC issues
	Dim  strSysFolder, strFile, oFile
	strSysFolder = fso.GetSpecialFolder(1) 'System Folder
	strFile = strSysFolder & "\IsAdmin.txt"
	
	On Error Resume Next
	set oFile = fso.CreateTextFile (strFile,True)
	oFile.WriteLine "Delete Me"
	oFile.Close
	
	If Err.Number <> 0 Then 
		IsAdmin = False
		'WScript.Echo "Not an admin" 
	Else 
		IsAdmin = True
		'WScript.Echo "Is an admin" 
		'Cleanup file 
		fso.DeleteFile(strFile)
	End If
	
	On Error GoTo 0
End Function

Sub GetName 'Gets user's first and last from AD
	Dim strLogonServer
	strLogonServer = wshShell.ExpandEnvironmentStrings("%LOGONSERVER%")
	If strLogonServer = strComputer  Or not Fso.FolderExists(strLogonServer & ".")  Then
		strMyName =""
		Exit Sub 
	End If

'I could bind directly using the CN from oSI, but this was already written...
	Dim objConnection, oRS, objCommand, root, sDomain
	Const ADS_SCOPE_SUBTREE = 2
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = ("ADsDSOObject")
	objConnection.Open "Active Directory Provider"
	objCommand.ActiveConnection = objConnection
	
	'Get the ADsPath for the domain to search. 
	Set root = GetObject("LDAP://rootDSE")
	sDomain = root.Get("defaultNamingContext")
	
	objCommand.CommandText = "SELECT samAccountName,description, givenname, sn FROM " & _
	    "'LDAP://" & sdomain & "' WHERE samAccountName = '" & strNTName &  "'"

objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
	Set oRS = objCommand.Execute
	
	'new version 2.2
	If oRS.RecordCount = 0 Then
	   strMyName = ""
	Else

strMyName = " (" & oRS("givenName").value & space(1) & oRS("sn").value

If IsArray(oRS("Description")) Then 
	    	Dim tArray
	    	tArray = oRS("Description")
	    	strDescription = tArray(0)
	    Else
			If Len(oRS("Description"))>0 Then
				strDescription = oRS("Description")	
			End If
		End If 
	End If 
	
	If Len(strDescription) > 0 Then 
		strMyName = strMyName & ", " & strDescription & ")"
	Else
		strMyName = strMyName & ")"
	End If 
	
	strMyCSVName  =  Mid(strMyName,3,Len(strMyName)-3)
	
	Set root = Nothing
	Set oRS = Nothing
	Set objCommand = Nothing
	Set objConnection = Nothing
	
End Sub

Sub AddExclude(strComputer)
	For i = 0 To dExceptions.Count -1 ' Iterate the array.
		If (lcase(ExcludeNames(i)) = LCase(strComputer)) Or (lcase(ExcludeNames(i)) = LCase(strNTName)) Then
			ReDim Preserve aIgnoreList(UBound(aIgnoreList)+1)
	    	aIgnoreList(UBound(aIgnoreList)) = PNPIDs(i) 
	    	If bDebug Then WScript.echo StrComputer & " is excluded from detecting " & PNPIDs(i)
	    	Exit For 
	    End If 
	Next
End Sub

Sub CheckService(strServiceName,strServiceDescription)
	Dim colServices, objService
	Dim iServicePresent : iServicePresent = 0
	Set oWMI = GetObject("winmgmts:" _	
		& "{impersonationLevel=impersonate}!\\" & strComputer& "\root\cimv2")
	If Err.Number <> 0 Then 
		strServiceMessage =  "Error connecting to WMI on " & strComputer & ". " & Err.Description
		bServiceInstalled = False
		Exit Sub 
	End If 
		
	Set colServices = oWMI.ExecQuery ("SELECT State FROM Win32_Service where name ='" & strServiceName & "'" )
	
	For Each objService in colServices
		iServicePresent = colServices.count
		strServiceMessage =  strServiceDescription & " is " & objService.State & " on " & strComputer
	Next
	
	If iServicePresent = 0 Then 
		strServiceMessage =  strServiceDescription & " is not installed on " & strComputer
		bServiceInstalled = False
	Else
		bServiceInstalled = True 
	End If 
End Sub

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function

Δ [email me]

Δ Wednesday, January 2nd, 2013

Δ Rename Script to e-Mail

How to send your scripts in emails

[download resource files]

Demo

Have you ever tried sending a batch file, or vbscript via email? You can't do it...that's not
without renaming it first, or zipping it. This script strips the extension to allow for easy email
attachment.

Δ [email me]

Δ Tuesday, January 1st, 2013

Δ Return Last Logged On User

How to get the last logged on user

[download resource files]

This just a simple script to return the last logged on user.

Option Explicit

Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adInteger = 3
Const adDBTimeStamp = 135 'YYYYMMDDHHMMSS date/time format

Dim WshShell: 	Set WshShell = WScript.CreateObject("WScript.Shell")
Dim strComputer
Dim objWMIService
dim dNewest, strNewest 
dNewest = #1/1/1980#
strNewest = ""
Dim ColComputer, obJComputer, strCurrentUser 
Dim message 
dim colLogons, oLogon
Dim oRS

If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments(0)
Else
	strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
	strComputer = InputBox("Check for last user's logon onto what PC","Computer name",strComputer)
End If

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

On Error Resume Next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"  & strComputer & "\root\cimv2") 
If Err <> 0 Then
	MsgBox "Failed to connect to " & strComputer & ". " & Err.Description,vbCritical + vbOKOnly,"Fatal Error"
	WScript.Quit
End If

Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer In colComputer
    strCurrentUser =  objComputer.UserName 
Next

If Len (strCurrentUser) > 1 Then
	message = "This user is still logged on."
Else
	message = "There are no current logons."
End If

'create disconnected recordset -- note the ADOR
Set oRS = CreateObject("ADOR.Recordset")
oRS.Fields.Append "FullName", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "LogonName", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "LastLogon", adVarChar, adFldIsNullable
oRS.Fields.Append "NumberofLogons", adInteger, adFldIsNullable
oRS.Open

Set colLogons = objWMIService.ExecQuery("SELECT Fullname,LastLogon,Name,NumberOfLogons FROM Win32_NetworkLoginProfile where numberofLogons > 0",,48)
If Err <> 0 Then
	MsgBox "Failed to connect to " & strComputer & ". " & Err.Description,vbCritical + vbOKOnly,"Fatal Error"
	WScript.Quit
End If

For Each oLogon In colLogons
    oRS.AddNew
    oRS("FullName") = oLogon.FullName
    oRS("LogonName") = oLogon.Name
    oRS("LastLogon") = WMI2LocalTime(ologon.Lastlogon) 
    oRS("NumberofLogons") = oLogon.NumberOfLogons
    oRS.Update
Next

On Error Resume Next
oRS.MoveFirst
Do Until oRS.EOF
    GetNewestDate FixNull(oRS.Fields.Item("FullName")), FixNull(oRS.Fields.Item("LogonName")), FixNull(oRS.Fields.Item("LastLogon"))
oRS.MoveNext
Loop

oRS.Close

message = "The most recent user to log onto " & strComputer  & " is "   & _
	strNewest & " reported as " & dNewest & ". " & message

Dim retval 
Retval = MsgBox(message & VbCrLf & VbCrLf & "Copy results to clipboard?",vbQuestion + vbYesNo,strComputer)
If retval = vbYes Then Copy2Clip(message)

' ========= Functions and Subs ============

Function FixNull(strText)
	FixNull = strText
	If IsNull(strText) Then FixNull = ""
	If IsEmpty(strText) Then FixNull = ""
End Function 
	
Sub GetNewestDate(strFullName, strName, dLastLogon)	
	If cdate(dLastLogon) > dNewest Then
			If Len(strFullName) = 0 Then 
				strNewest = strFullName & Space(1) & strName  
			Else
				strNewest = strFullName & " (" & strName & ")"
			End If 
			dNewest= dLastLogon
	End If 
End Sub

Function WMI2LocalTime(strWMITime)
	Const CONVERT_TO_LOCAL_TIME = True
	Dim dateTime 
	' Create a new datetime object.
	Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
	'Set Value
	dateTime.Value = strWMITime
	'Return localtime VT_DATE format.
	WMI2LocalTime = dateTime.GetVarDate(CONVERT_TO_LOCAL_TIME)
	Set dateTime = Nothing
End Function

Function Copy2Clip(strMessage)

Dim objWord

' Declare an object for the word application  
	On Error Resume Next
	Set objWord = CreateObject("Word.Application")
	If Err = 0 Then 
		' Using the object
		With objWord    
			.Visible = False             	' Don't show Word
			.Documents.Add               	' Create a document
			.Selection.TypeText strMessage	' Put text into it    
			.Selection.WholeStory        	' Select everything in the doc
			.Selection.Copy              	' Copy contents to clipboard    
			.Quit False                  	' Close Word, don't save
		End With
		WshShell.Popup "Data copied to clipboard",15,"Done"
	Else
		Err.Clear
		If(MsgBox ("Could not copy to clipboard, send to notepad instead?",_
			vbYesNo + vbQuestion, "Send to Notepad") = vbYes) then
			wshshell.Run("notepad.exe")
			
			While wshshell.appactivate("Untitled - Notepad") = False
				Wscript.Sleep 10
			Wend
			
			wshshell.SendKeys strMessage
		End If 
	End If 
	On Error GoTo 0
End Function

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author