… just technical stuff!

You can do really really cool stuff with gpos in vbScript. I will show you how to export reports and give you some examples what else can be done going the vbScript way…
The Group Policy Management console in Windows offers you the possibility to export reports about group policy object’s settings to html files – this, for example, is an excerpt of my default domain controllers policy:

You can do this (and much more) by script too. Here is how you can do it… You can choose to save this report in a variable to do further processing in your script or you can save it to a file, just like the console does.

Function getGPOHTMLReport(strDomain, strGPOCN)
  Set objGPM = CreateObject("GPMgmt.GPM")
  Set objGPMConstants = objGPM.GetConstants()
  Set objGPMDomain = objGPM.GetDomain(strDomain, "", objGPMConstants.UseAnyDC)
  Set objGPO = objGPMDomain.GetGPO(strGPOCN)
  Set objGPMReport = objGPO.GenerateReport(objGPMConstants.ReportHTML)
  getGPOHTMLReport = objGPMReport.result
End Function

Wscript.echo getGPOHTMLReport("normanbauer.com", "{6AC1786C-016F-11D2-945F-00C04fB984F9}") 'Default Domain Controllers Policy

Sub exportGPOHTMLReport(strDomain, strGPOCN, strOutFilename)
  Set objGPM = CreateObject("GPMgmt.GPM")
  set objGPMConstants = objGPM.GetConstants()
  set objGPMDomain = objGPM.GetDomain(strDomain, "", objGPMConstants.UseAnyDC)

  Set objGPO = objGPMDomain.GetGPO(strGPOCN)
  objGPO.GenerateReportToFile objGPMConstants.ReportHTML, strOutFilename
End Sub

exportGPOHTMLReport "normanbauer.com", "{6AC1786C-016F-11D2-945F-00C04fB984F9}", "C:\temp\export.html" 'Default Domain Controllers Policy

Functions used in the scripts above:

• GetConstants
• GetDomain
• GetGPO
• GenerateReport
• GenerateReportToFile

The function above generates the report of the specified gpo (you can find the cn of the gpo ["Unique ID"] in the Group Policy Management console on the details tab of a gpo, or in the System\Policies Container in Active Directory) and returns the html formatted result. The sub does almost the same but does not return the result but saves it to a file specified in strOutFilename.

You can do much more with the GPMgmt.GPM object – almost everything what the console can do, like creating, deleting and copying gpos, get and set wmi filters and set the gpo to be enabled or disabled on computer and/or user accounts.

This topic is little more complex and we’ll need different steps to accomplish this feature.
First at all you need the pictures for your user objects in the directory. You can use ADSI Edit, Powershell or 3rd party software to put pictures in AD. My blog post “How to save a user picture in Active Directory with vbScript?” will do this for you using vbScript.
Second you’ll need a small application that sets a picture on your harddrive as the user account picture. I tested this only with Windows 7 – so there is no guarantee that this works with other versions too. Why an application? Because there is no documented way of setting an individual user account picture programmatically in vbScript – neither via registry nor via file system.
My blog post “How to set the Windows 7 user account picture programmatically?” covers that small application.
Now that we have the pictures in Active Directory and developed a small application that sets an image file as user account picture we just need one more step between both. We need a vbScript that runs at logon, loads the picture from AD, puts it on the disk and calls our application. Here we go:

Function LoadPictureFromAD(szADsPath, szSaveFileName)
	Dim objUser, bytesRead, adoStreamWrite
	Const adTypeBinary = 1, adSaveCreateOverWrite = 2

	Set objUser = GetObject(szADsPath)
	bytesRead = objUser.Get("thumbnailPhoto")

	Set adoStreamWrite = CreateObject("ADODB.Stream")
	adoStreamWrite.Type = adTypeBinary
	adoStreamWrite.Open
	adoStreamWrite.Write(bytesRead)
	adoStreamWrite.SaveToFile szSaveFileName, adSaveCreateOverWrite
	adoStreamWrite.Close
End Function

Set wshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

workingdir = Replace(wscript.scriptfullname, Wscript.scriptname, "")

Set wshNetwork = WScript.CreateObject("WScript.Network")
username = wshNetwork.UserDomain  & "\" & wshNetwork.UserName
Set objSysInfo = CreateObject("ADSystemInfo")
strUserName = objSysInfo.UserName
dn = "LDAP://" & strUserName

path = wshShell.ExpandEnvironmentStrings("%temp%") & "\"
filename = path & "uap.jpg"

LoadPictureFromAD dn, filename
wshshell.run workingdir & "useraccountpicture.exe " & username & " " & filename, 0, true

This script contains the function LoadPictureFromAD which expects the user’s distinguished name and a filename where the resulting picture will be saved to. Inside the function we connect to AD, get the user’s object, read the attribute thumbnailPhoto, copy it to a previously created stream object and save it in a file identified by szSaveFileName.
The script itself assumes that the useraccountpicture.exe application resists in the same location as the script. So we set the working directory to the scripts location. After that we need the user’s name, it’s domain and it’s distinguished name. Then we create the filename for the image, this is simply the temp folder with “uap.jpg” as filename. With the distinguished name and the filename we can call the LoadPictureFromAD function and finally we run the useraccountpicture application with the username and the filename as parameters.

Save the script as .vbs – run it – have a look at the start menu – that’s all…

Now you can use this script as a logon script within group policies and all your users can find their photos in the start menu and on the lock screen.

I offen wondered how I can programmatically read items from mailboxes stored within Microsoft Exchange Server. Some time ago I used Outlook with some macros that accessed the information I needed. But what if Outlook does not run? Or what if the computer crashed – who would logon and start Outlook? Sure you can find workarounds for every problem. But this never seemed to be a ‘cool’ solution to me. In the past few weeks – after I got my Exchange 2010 MCITP – I started to have a look at EWS – Exchange Web Services (available since Microsoft Exchange Server 2007). This one seemed to be pretty simple and also a stable solution to all my needs. Here is how I do it all now with vbscript…

There is not much you’ll need to connect to Exchange, just a http connection to your Client Access Server, a user with credentials and access to the mailbox you want to read, a soap xml request and some lines of code that will parse the response for you.

First, you’ll need to know the dns name or the ip of your Client Access Server – in this example I’ll you EXCAS.domain.tld.
Now we create some objects and define the url to the CAS and username and password to access it:

Dim objXmlHttp, xmlDoc

Const strUrl = "https://EXCAS.domain.tld/ews/exchange.asmx" 'URL to CAS
Const strUser = "domain.tld\myexchangeuser" 'Domain and Username to authenticate with
Const strPassword = "myExchangeUSeRsP4ssw0rd"
Const strEmailAddress = "mailboxtoreadfrom@domain.tld" 'Mailbox that you want to read data from

Set objXmlHttp = CreateObject("Microsoft.XMLHTTP") 'this will send the request to EWS
Set objXmlDoc = CreateObject("MSXML2.DOMDocument") 'this will parse the response for us

Now it is time to decide what we want to do, or better: we need to create the request telling EWS what to do. In this example I want to know about every calendar item in a certain time span. But you can do much more:

• create, move, copy, delete, update, find calendar, email, folder, … items
• get user availability, get and set out of office settings
• add, remove, update delegates
• many many more, have a look at the full list at http://msdn.microsoft.com/en-us/library/bb409286(v=EXCHG.140).aspx

Since we want to crawl for many items we will use the FindItem Operation. Following this link you’ll get a complete overview how the request will look like. In common every operation that can be used with Exchange Web Service is really well documented!
As you can see the basic xml soap request is:

  
    
      
        IdOnly
      
      
        
      
    
  

We just need to make some modifications to this example – we want to read all properties in the calendar for example, we do want to connect to another mailbox and we do want to use a certain time span not the whole calendar. So the soap request would look like this (changes marked bold):

  
    
      
        AllProperties
      
      
      
        
          
            mailboxtoreadfrom@domain.tld
          
        
      
    
  

Now we need to connect to EWS, post this request, wait for the answer and parse it. Since this is a complex xml structure we just need to break it down to that level the information is stored in – in this example it is the “t_Items” node.

objXmlHttp.open "POST", strUrl, False, strUser, strPassword
objXmlHttp.setRequestHeader "Content-Type", "text/xml"
objXmlHttp.send strXmlData 'this is the soap request from above
If objXmlHttp.Status = "200" Then 'if the request was successful go on
  If objXmlDoc.loadXML(objXmlHttp.responseText) Then
    Set soap_Body = objXmlDoc.documentElement.childNodes.item(1) 'soap_body is the second node below the document root
    Set m_FindItemResponse = soap_Body.childNodes.item(0) 'm_FindItemResponse is the first node below soap_body
    Set m_ResponseMessages = m_FindItemResponse.childNodes.item(0) 'and so on...
    Set m_FindItemResponseMessage = m_ResponseMessages.childNodes.item(0)
    Set m_RootFolder = m_FindItemResponseMessage.childNodes.item(1)
    Set t_Items = m_RootFolder.childNodes.item(0)

    For Each calendarItem In t_Items.childNodes
      Dim t_Subject, t_Start, t_End, t_LegacyFreeBusyStatus, t_Location, t_IsRecurring, t_CalendarItemType, t_MyResponseType, t_Organizer
      t_ItemId = calendarItem.getElementsByTagName("t:ItemId").item(0).getAttribute("Id")
      t_Subject = calendarItem.getElementsByTagName("t:Subject").item(0).text
      t_Start = calendarItem.getElementsByTagName("t:Start").item(0).text
      t_End = calendarItem.getElementsByTagName("t:End").item(0).text
      t_LegacyFreeBusyStatus = calendarItem.getElementsByTagName("t:LegacyFreeBusyStatus").item(0).text
      t_Location = calendarItem.getElementsByTagName("t:Location").item(0).text
      t_IsRecurring = calendarItem.getElementsByTagName("t:IsRecurring").item(0).text
      t_CalendarItemType = calendarItem.getElementsByTagName("t:CalendarItemType").item(0).text
      t_MyResponseType = calendarItem.getElementsByTagName("t:MyResponseType").item(0).text
      t_Organizer = calendarItem.getElementsByTagName("t:Organizer").item(0).getElementsByTagName("t:Mailbox").item(0).getElementsByTagName("t:Name").item(0).text

      'Here you can do anything you like with all this information
    Next
  End If
Else
  wscript.echo "Error: " & objXmlHttp.Status & " - " & objXmlHttp.statusText 'If status is not 200
End If

Documentation for functions, methods and properties used in this post:

• t:ItemId
• t:Subject
• t:Start
• t:End
• t:LegacyFreeBusyStatus
• t:Location
• t:IsRecurring
• t:CalendarItemType
• t:MyResponseType
• t:Organizer
• t:Mailbox
• t:Name

As you might know the vbscript replace function does always search only “one round”. Here is an example, what exactly I mean:

Lets assume you want to correct the following string by replacing all “double-l’s” by “single-l’s”:

str = "Littllllle worllllllld!"

The code would be:

wscript.echo replace(str, "ll", "l")

But everything this line does is replace all existing “ll” by “l”. So lets have a look what’s left – the output is: Litllle worlllld!
Why? The original string contained 5 l in Little and 7 l in world. The function used replaces every ll, in Little there are 2 ll and 1 l, in world 3 ll and 1 l. After replacing all doubles you still have 3 l left in Little and 4 in world. As you can see replace only replaces existing strings, the lls that occur by replacing will not be touched… So you need to run a second round to replace more lls by ls…

Since I need this one very often, for example when replacing multiple new lines in html, I wrote a little function doing all the work for me. Here it is:

Function ReplaceAll(str, find, replacewith)
While InStr(str, find) > 0
str = Replace(str, find, replacewith)
Wend
ReplaceAll = str
End Function

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2\Security\MicrosoftVolumeEncryption")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_EncryptableVolume",,48)

Dim arEncryptionMethod
arEncryptionMethod = Array("None", "AES 128 With Diffuser", "AES 256 With Diffuser", "AES 128", "AES 256")

Dim arProtectionStatus
arProtectionStatus = Array("Protection Off", "Protection On", "Protection Unknown")

Dim arConversionStatus
arConversionStatus = Array("Fully Decrypted", "Fully Encrypted", "Encryption In Progress", "Decryption In Progress", "Encryption Paused", "Decryption Paused")

Dim arLockStatus
arLockStatus = Array("Unlocked", "Locked")

For Each objItem in colItems
  Dim EncryptionMethod
  Dim ProtectionStatus
  Dim ConversionStatus
  Dim EncryptionPercentage 'Percentage of the volume that is encrypted
  Dim VolumeKeyProtectorID
  Dim LockStatus

  objItem.GetEncryptionMethod EncryptionMethod
  objItem.GetProtectionStatus ProtectionStatus
  objItem.GetConversionStatus ConversionStatus, EncryptionPercentage
  objItem.GetKeyProtectors 0,VolumeKeyProtectorID
  objItem.GetLockStatus LockStatus

  WScript.Echo "DeviceID: " & objItem.DeviceID
  Wscript.Echo "DriveLetter: " & objItem.DriveLetter
  Wscript.Echo "EncryptionMethod: " & arEncryptionMethod(EncryptionMethod)
  Wscript.Echo "ProtectionStatus: " & arProtectionStatus(ProtectionStatus)
  Wscript.Echo "ConversionStatus: " & arConversionStatus(ConversionStatus)
  Wscript.Echo "EncryptionPercentage: " & EncryptionPercentage & "%"
  Wscript.Echo "LockStatus: " & arLockStatus(LockStatus)

  For Each objId in VolumeKeyProtectorID
    Dim VolumeKeyProtectorFriendlyName
    objItem.GetKeyProtectorFriendlyName objId, VolumeKeyProtectorFriendlyName
    If VolumeKeyProtectorFriendlyName <> "" Then
      Wscript.Echo "KeyProtectors: " & VolumeKeyProtectorFriendlyName
    End If
  Next
Next

Documentation for functions, methods and properties used in this post:

• Win32_EncryptableVolume
• GetEncryptionMethod
• GetProtectionStatus
• GetConversionStatus
• GetKeyProtectors
• GetLockStatus
• GetKeyProtectorFriendlyName