Report Workstation Uptime in a CSV using Active Directory and VBS

Have you ever been left wondering which computers on your domain have been neglected by their user and not restarted in forever? This is a question that come up in my office every once and a while. One of the easiest ways to solve this problem is to ask WMI for when the computer was last restarted and subtract it from the current time. Also, while asking WMI questions you might as well ask which user is currently logged on the PC that way you know who to blame. This is exactly what the following script does for your domain. It grabs the list of workstations from the domain then queries WMI for the last time the computer is restarted and does some conversion and math and makes you an nice CSV that you can play with.

Script Configuration
Before running this script there is some minor configuration that must be done so it can communicate with your Active Directory setup.

  1. Find objConnection.Open “Active Directory Server” change Active Directory Server to the name of your Domain Controller
  2. Find objCommand.CommandText = _
    “Select Name, Location from ‘LDAP://OU=Workstations,DC=west,DC=domain,DC=edu’ ” _
    & “Where objectClass=’computer'”
    change subdomain, domain, and suffix to the name of your domain i.e. west domain edu (respectively)
  3. Find GetUptime objRecordSet.Fields(“Name”).Value, “C:\uptime.csv” and change C:\uptime.csv to the location where you want the file saved. Be sure to save it with the extension CSV
Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Server" 

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
    "Select Name, Location from 'OU=Workstations,DC=west,DC=domain,DC=edu' " _
        & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
	GetUptime objRecordSet.Fields("Name").Value, "C:\uptime.csv"
    objRecordSet.MoveNext
Loop

Sub GetUptime(strComputer, strFilename)
	On Error Resume Next
	Set StdOut = WScript.StdOut
	 
	Set objFSO = CreateObject("scripting.filesystemobject")
	Set logStream = objFSO.opentextfile(strFilename, 8, True)
	 
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	If Err.Number Then
	      logStream.writeline(strComputer & ",Offline")
	      Err.Clear
	Else
		Set objWMIService = GetObject _
			("winmgmts:\\" & strComputer & "\root\cimv2")
		Set colOperatingSystems = objWMIService.ExecQuery _
			("Select * from Win32_OperatingSystem")
		For Each objOS in colOperatingSystems
			dtmBootup = objOS.LastBootUpTime
			dtmLastBootupTime = WMIDateStringToDate(dtmBootup)
			dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now()) 
		Next
		Set objWMIService = GetObject _
			("winmgmts:\\" & strComputer & "\root\cimv2")
		Set colComputerSys = objWMIService.ExecQuery _
			("Select UserName from Win32_ComputerSystem")
		For Each objCS in colComputerSys
			username = objCS.UserName
			logStream.writeline(strComputer & ",Online," & dtmSystemUptime & "," & dtmLastBootupTime & "," & username) 
		Next
				
	End If
	logStream.Close
End Sub
Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _
         Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
         & " " & Mid (dtmBootup, 9, 2) & ":" & _
         Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, _
         13, 2))
End Function

Read More

Weekly Terminal Services Connection Report using VBS

A few weeks ago we had some state auditors come by and mention that we should review our logs for any sort of outside / vendor access. I knew that going to each server and reviewing the logs manually would be very time consuming and not really provide solid documentation that it was done. I decided that the only way to solve this problem was with a report of some nature. I fired up my trusty Crystal Reports and started to view the logs using that, once I got in to more I realized that when I added the description field of the event log it always crashed Crystal Reports. This left me going to plan B which is writing the reports from scratch using Visual Basic Scripting language.

I already knew that you can use VBS to connect to WMI (Windows Management Interface) and view different parts of the system including the event log, so I spent the morning writing the report and parsing it down to the detail that I really needed. Then I decided to take it to the next level by adding in recursion for multiple servers and also set it up to send an HTML email so it is easy to review every week. Why every week you may ask, well in looking at my event log on my domain server I noticed that I start losing Security events at about 10-14 days out since it is authorizing so much, and a weekly task is a very manageable one.

Script Configuration

  1. Configure the servers that this script will report on. Modify the Servers array for each server that needs to be checked. (Note: all servers need the same login credentials for the script to work)
  2. Find the objMessage.From field and update it with who the email is coming from
  3. Find the objMessage.To Field and update with the email address of the person who will be receiving the report, if you have multiple addresses to send to separate them with a semi-colon (;)
  4. Find the (“http://schemas.microsoft.com/cdo/configuration/smtpserver”) = “smtp-relay.waynezim.com” and update this with your SMTP server, if your server requires authentication you will need to modify this script to include that, a simple Google search should show you what needs to be changed.
  5. This script should be setup to be a scheduled task on one of your servers, the credentials used in setting up the job will be used to connect to the other servers, this account needs to exist on all servers to view the Security Event Log and make the report.
  6. To setup a scheduled task, go to your Control Panel, open Scheduled Tasks, right click New > Scheduled Task, name it, then right click and modify the Properties, Browse to where the script is saved, set the Run as at the bottom for the user that exists on all Servers and set the password. Then go to the Schedule tab and set it to Weekly and change it to run when you want it to.
Dim objWMI, objEvent ' Objects
Dim strComputer ' Strings
Dim intEvent, intNumberID, intRecordNum, colLoggedEvents
'--------------------------------------------
' Server List to Parse Logs
Dim Servers(5)
Servers(0) = "server1"
Servers(1) = "server2"
Servers(2) = "server3"
Servers(3) = "server4"
Servers(4) = "server5"
Servers(5) = "server6"
'--------------------------------------------
' Email Body Heading
HTMLMsg = "<html><body><h3>Remote Desktop Connections from " & cDate(Now() - 7) & " to " & cDate(Now()) & "</h3>"
HTMLMsg = HTMLMsg & "<table border=1><tr><td><b>Computer Name</b></td><td><b>Logon Type</b></td><td><b>Remote IP</b></td><td><b>Date / Time</b></td><td><b>User</b></td></tr>"
'--------------------------------------------
' Next section creates the file to store Events
' Then creates WMI connector to the Logs

'Range Variable - Out of Loop for Common Report Time
WeekAgo = cDate(Now() - 7)

'Start Each Computer Loop
For Each strComputer in Servers
' --------------------------------------------
' Set your variables for Events Loop
intEvent = 1
intRecordNum = 1

Set objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colLoggedEvents = objWMI.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'Security' AND EventCode = 528 AND TimeWritten > '" & WeekAgo & "'")
' -----------------------------------------
' Next section loops through ID properties
intEvent = 1
	For Each objEvent in colLoggedEvents

	HTMLMsg = HTMLMsg & "<tr><td>" & objEvent.ComputerName & "</td>"
	LogonType = RTrim(Mid(objEvent.Message,InStr(objEvent.Message,"Logon Type:")+12,2))
	If LogonType = 2 Then HTMLMsg = HTMLMsg & "<td>Interactive</td>" End if
	If LogonType = 3 Then HTMLMsg = HTMLMsg & "<td>Network</td>" End if
	If LogonType = 4 Then HTMLMsg = HTMLMsg & "<td>Batch</td>" End if
	If LogonType = 5 Then HTMLMsg = HTMLMsg & "<td>Service</td>" End if
	If LogonType = 7 Then HTMLMsg = HTMLMsg & "<td>Unlock</td>" End if
	If LogonType = 8 Then HTMLMsg = HTMLMsg & "<td>Network using Clear Text</td>" End if
	If LogonType = 9 Then HTMLMsg = HTMLMsg & "<td>New Credentials</td>" End if
	If LogonType = 10 Then HTMLMsg = HTMLMsg & "<td>Remote Interactive</td>" End if
	If LogonType = 11 Then HTMLMsg = HTMLMsg & "<td>Cached Interaction</td>" End if

	IPlen = InStr(InStr(objEvent.Message,"Source Network Address:")+24,objEvent.Message,"	") - InStr(objEvent.Message,"Source Network Address:") - 28
	RemoteAddress = RTrim(Mid(objEvent.Message,InStr(objEvent.Message,"Source Network Address:")+24,IPlen))
	HTMLMsg = HTMLMsg & "<td>" & RemoteAddress & "</td>"
	EventTime = Mid(objEvent.TimeWritten, 5, 2) & "/" & Mid(objEvent.TimeWritten, 7, 2) & "/" & Mid(objEvent.TimeWritten, 1, 4) & " " & Mid(objEvent.TimeWritten, 9, 2) & ":" & Mid(objEvent.TimeWritten, 11, 2) & "." & Mid(objEvent.TimeWritten, 13, 2)
	HTMLMsg = HTMLMsg & "<td>" & EventTime & "</td>"
	HTMLMsg = HTMLMsg & "<td>" & objEvent.User & "</td></tr>"
	intRecordNum = intRecordNum +1
	IntEvent = intEvent +1

	Next
Next

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Remote Connections Report: " & cDate(Now())
objMessage.From = "root@waynezim.com"
objMessage.To = "waynezim@waynezim.com"
objMessage.HTMLBody = HTMLMsg
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-relay.waynezim.com"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==

objMessage.Send
WScript.Quit

Report Preview
If you need help decoding what Logon Type really means check out this great article.

remote-connection-report-preview

Read More

How to Remove Old Cached Roaming Profiles from Workstations

Earlier this year I was tasked with cleaning up the workstations on our network to help reduce the amount of time needed for our daily virus scan to complete. One of the issues I took on was cleaning up old cached profiles from the use of roaming profiles. This was not something I wanted to do manually for the 150 PCs that we have across our building, so I made a script that would look for profiles that had not been modified in the last 90 days and wasn’t a system account (localservice, networkservice, default user, all users). Also, an advantage of using a script to do this is it can produce a report of what it will remove without actually doing it. That way you can be sure that you are not deleting things that you do want to keep.

This script does depending on file and print sharing being turned on for the workstation so the script can access the administrative shares on each computer. It does make the assumption that your profiles are saved in the default windows location C:\Documents and Settings\%username% and that you are the administrator for the domain.

Configuration

  1. Be sure to update the LDAP string ‘LDAP://OU=workstations,DC=subdomain,DC=domain,DC=com’ to match your Active Directory structure. The script needs to know where all the workstation are in Active Directory
  2. Find objConnection.Open “DomainController” and modify the put your Domain Controller in place of DomainController
  3. Find OldProfile objRecordSet.Fields(“Name”).Value, “C:\deletedprofiles.csv” and modify the filename to save the file where you and and named what you want, just be sure to leave the extension as CSV so it will open properly with your spreadsheet application.
  4. Most Importantly – Comment out fsoFolder.DeleteFolder objSubfolder, TRUE if you just want a report of what it will delete when run, if not it is currently setup to remove the unwanted profiles
Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "shs-login"

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
    "Select Name, Location from 'LDAP://OU=workstations,DC=subdomain,DC=domain,DC=com' " _
        & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
	OldProfile objRecordSet.Fields("Name").Value, "C:\deletedprofiles.csv"
    objRecordSet.MoveNext
Loop

Sub OldProfile(strComputer, strFilename)
	On Error Resume Next
	Set StdOut = WScript.StdOut
	 
	Set objFSO = CreateObject("scripting.filesystemobject")
	Set logStream = objFSO.opentextfile(strFilename, 8, True)
	 
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	If Err.Number Then
	      logStream.writeline(strComputer & ",Offline")
	      Err.Clear
	Else
		On Error Resume Next
		Set objShell = CreateObject("Shell.Application")
		Set fsoFolder = CreateObject("Scripting.FileSystemObject")

		root = "\\" & strComputer &"\C$\Documents and Settings"

		Set objFolder = fsoFolder.GetFolder(root)
		Set colSubfolders = objFolder.Subfolders
		
			For Each objSubfolder in colSubfolders
				If (lcase(objSubfolder.Name) <> "localservice" AND lcase(objSubfolder.Name) <> "networkservice"_
					AND lcase(objSubfolder.Name) <> "default user" AND lcase(objSubfolder.Name) <> "all users") then
						
						If (DateDiff("D", objSubfolder.DateLastModified, Date()) > 90) then
							logStream.writeline(strComputer & ",Online,Delete," & objSubfolder & "," & objSubfolder.DateLastModified)
							fsoFolder.DeleteFolder objSubfolder, TRUE
						else
							logStream.writeline(strComputer & ",Online,Active," & objSubfolder & "," & objSubfolder.DateLastModified)
						End If
						
				else
					logStream.writeline(strComputer & ",Online,System," & objSubfolder & "," & objSubfolder.DateLastModified)
				End If
			Next
	End If
	logStream.Close
End Sub

Read More

List All Active Directory User Accounts in a CSV

We all know maintaining hundreds of user accounts can be frustrating especially when it comes to audit time and you need a good list of information to pass on to an auditor. Well today I am your savory, this simple script will produce you a list of users with some detailed information that can make audits or documentation much easier. The script creates a Comma Separated Values file or CSV that you can edit in Microsoft Excel or any standard spreadsheet application so you can customize the information before adding it to your report or audit. Below are the specific fields that this script will provide detail on for your Active Directory Users.

User Details

  • Name
  • Description
  • Profile Path
  • Home Drive
  • Account Disabled
  • Password Required
  • User Changable Password
  • Password Expires
  • SmartCard Required
  • Login Count
  • Last Login (date)
  • Last Password Change (date)
  • Created (date)
  • Modified (date)

Script Configuration
Before running this script there is some minor configuration that must be done so it can communicate with your Active Directory setup.

  1. Find objConnection.Open “Active Directory Server” change Active Directory Server to the name of your Domain Controller
  2. Find objCommand.CommandText = _
    “SELECT Name, description, profilePath, homeDrive, distinguishedName,userAccountControl FROM ‘LDAP://dc=subdomain,dc=domain,dc=suffix’ WHERE objectCategory=’user'”
    change subdomain, domain, and suffix to the name of your domain i.e. west consco com (respectively)
  3. Find Set logStream = objFSO.opentextfile(“C:\domainusers.csv”, 8, True) and change C:\domainusers.csv to the location where you want the file saved. Be sure to save it with the extension CSV
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2

Const ADS_UF_ACCOUNTDISABLE = &H0002 
Const ADS_UF_PASSWD_NOTREQD = &H0020 
Const ADS_UF_PASSWD_CANT_CHANGE = &H0040 
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000 
Const ADS_UF_SMARTCARD_REQUIRED = &H40000 
 
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Server"
Set objCommand.ActiveConnection = objConnection

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

objCommand.CommandText = _
    "SELECT Name, description, profilePath, homeDrive, distinguishedName,userAccountControl FROM 'LDAP://dc=subdomain,dc=domain,dc=suffix' WHERE objectCategory='user'"  
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Set objFSO = CreateObject("scripting.filesystemobject")
Set logStream = objFSO.opentextfile("C:\domainusers.csv", 8, True)
logStream.writeline("Name,Description,Profile Path,Home Drive,Account Disabled,Password Required,User Changable Password,Password Expires,SmartCard Required,Login Count,Last Login,Last Password Change,Created,Modified")
Do Until objRecordSet.EOF

	strDN = objRecordset.Fields("distinguishedName").Value 
	Set objUser = GetObject ("LDAP://" & strDN)
	 
	If objRecordset.Fields("userAccountControl").Value AND ADS_UF_ACCOUNTDISABLE Then
		Text = "Yes"
	Else
		Text = "No"
	End If
	If objRecordset.Fields("userAccountControl").Value AND ADS_UF_PASSWD_NOTREQD Then
		Text = Text & ",No"
	Else
		Text = Text & ",Yes"
	End If
	 
	If objRecordset.Fields("userAccountControl").Value AND ADS_PASSWORD_CANT_CHANGE Then
		Text = Text & ",No"
	Else
		Text = Text & ",Yes"
	End If	 
	If objRecordset.Fields("userAccountControl").Value AND ADS_UF_DONT_EXPIRE_PASSWD Then
		Text = Text & ",No"
	Else
		Text = Text & ",Yes"
	End If
	If objRecordset.Fields("userAccountControl").Value AND ADS_UF_SMARTCARD_REQUIRED Then
		Text = Text & ",Yes"
	Else
		Text = Text & ",No"
	End If
	
	logStream.writeline(objRecordset.Fields("Name").Value & ","_
		& objRecordset.Fields("description").Value & ","_
		& objRecordset.Fields("profilePath").Value & ","_
		& objRecordset.Fields("homeDrive").Value & ","_
		& text & ","_
		& objUser.logonCount & ","_
		& objUser.LastLogin & ","_
		& objUser.PasswordLastChanged & ","_
		& objUser.whenCreated & ","_
		& objUser.whenChanged & ","_
		)
		
    objRecordSet.MoveNext
Loop
logStream.Close

Read More

Remove Temporary Files at Logoff

Over time users tend to open a lot of items programs that write little files to be used just once to print a document or a small setting for a program. These items build up over time and cause your computer to run slower due to your antivirus solution scanning it, your hard drive taking longer to find a free space of disk to write your new file or has to spend more time gathering up fragments of your file from in between these temp files. The solution here is pretty simple, these files need to go, and probably the easiest solution is the remove them when the user logs off. This doesn’t require anymore time for the user and typically isn’t a problem since most computers are logged on and off once a day.

This script will remove the most common temporary folder for the user as well as remove any of the temporary internet files that they have gathered while surfing the web. When we implemented this script we noticed that the antivirus scan time and how many files it scanned were significantly reduced providing a better and faster workstation for your users. This script should be placed in the Group Policy for users as one of their logoff script.

Const TEMPORARY_INTERNET_FILES = &H20&
dim intDepth
 
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Clean User Temporary Intenet Files
Set objNameSpace = objShell.Namespace(TEMPORARY_INTERNET_FILES)
Set objFolderItem = objNameSpace.Self
set objFolder=objFSO.GetFolder(objFolderItem.Path)
intDepth=0
RemoveFolder objFolder

'Clean User Temp Files
Const TemporaryFolder = 2
Set tempFolder = objFSO.GetSpecialFolder(TemporaryFolder)
RemoveFolder tempFolder

 
sub RemoveFolder(objFolder)
	' Recursively remove files and folders
	intDepth=intDepth+1
	on error resume next
	for each objFile in objFolder.Files
		objFile.Delete true
	next
	Err.Clear
	on error goto 0
	for each objSubfolder in objFolder.SubFolders
		RemoveFolder objSubFolder
	next
	intDepth=intDepth-1
	if intDepth<>0 then' Don't delete top-level folder
		on error resume next
		objFolder.Delete true 
		err.Clear
		on error goto 0
	end if
end sub

Read More