Adafruit USB + Serial RGB Backlight Character LCD Backpack VBScript API

System Requirements:

  • Adafruit USB Serial RGB Backlight Character LCD Backpack

The Problem:

I recently needed a fast, cheap and modular way to output small amounts of information from a headless Windows 7 appliance, something that didn’t require a large amount of electrical engineering work or assembly while at the same time working over USB.

I accidentally stumbled upon a product by Adafruit, who seem to be tightly aligned with the Raspberry Pi/Arduino, however USB is USB which means that making it cooperate with Win32 wouldn’t be particularly challenging.

Being the lazy person that I am, I never much care for the idea of having to repeatedly type out control commands through a command line parser to get what I want and quite frankly, getting a NT Command Prompt to reliably pass anything out to a Serial Port is more or less a futile exercise unless you are using Plink or replace the shell entirely with something more robust.

My solution was quite simple, create a O-O VBScript API for running it via CScript that can in turn be called from the NT command line where required.

Buy Adafruit USB Serial RGB Backlight Character LCD Backpack, and other Adafruit components or & help support this site.

 

More Info

This API does what I require it to do. I have implemented all of the main command syntax from the Adafruit documentation (links below). It is classful and self contained. As long as you can create a FileSystemObject and can find the COM Port, you can make use of it.

[Update 25/04/2019] You can now obtain this code directly from Github.

View: AdafruitUsbSerial on GitHub

' AdafruitUsbSerial Application Programming Interface v1.0.4

' © C:Amie | www.c-amie.co.uk 1996 - 2014

' Not for commercial reproduction without the express permission of the author

' No warranty is offered or implied as a result of downloading or using this APIClass AdafruitUsbSerialprivate m_ForReadingprivate m_SCREEN_OFF

private m_SCREEN_ON

private m_AUTO_SCROLL_ON

private m_AUTO_SCROLL_OFF

private m_CLEAR_SCREEN

private m_SET_STARTUP_SPLASH

private m_SET_CURSOR_POSITION

private m_SET_CURSOR_HOME

private m_SET_CURSOR_BACK

private m_SET_CURSOR_FORWARD

private m_SET_UNDERLINE_ON

private m_SET_UNDERLINE_OFF

private m_SET_BLINK_ON

private m_SET_BLINK_OFF

private m_SET_RGB

private m_SET_CONTRAST

private m_SET_BRIGHTNESSprivate m_iPortNumber

private m_byteCharacterLength

private m_bolDebug

private m_bolAutoScroll

private m_bolUnderlineCursor

private m_bolBlinkCursorprivate m_fso private

sub Class_Initialize
m_ForReading = 1
m_SCREEN_OFF = chr(254) & chr(70)
m_SCREEN_ON = chr(254) & chr(66)
m_AUTO_SCROLL_ON = chr(254) & chr(81)
m_AUTO_SCROLL_OFF = chr(254) & chr(82)
m_CLEAR_SCREEN = chr(254) & chr(88)
m_SET_STARTUP_SPLASH = chr(254) & chr(64)
m_SET_CURSOR_POSITION = chr(254) & chr(71)
m_SET_CURSOR_HOME = chr(254) & chr(72)
m_SET_CURSOR_BACK = chr(254) & chr(76)
m_SET_CURSOR_FORWARD = chr(254) & chr(77)
m_SET_UNDERLINE_ON = chr(254) & chr(74)
m_SET_UNDERLINE_OFF = chr(254) & chr(75)
m_SET_BLINK_ON = chr(254) & chr(83)
m_SET_BLINK_OFF = chr(254) & chr(84)
m_SET_RGB = chr(254) & chr(208)
m_SET_CONTRAST = chr(254) & chr(80)
m_SET_BRIGHTNESS = chr(254) & chr(153)

m_iPortNumber = 1
m_byteCharacterLength = 32
m_bolDebug = false
m_bolAutoScroll = true
m_bolUnderlineCursor = false
m_bolBlinkCursor = false

set m_fso = CreateObject("Scripting.FileSystemObject")
end sub

private sub Class_Terminate
set m_fso = nothing
end sub

' PROPERTIES
public property get PortNumber
PortNumber = m_iPortNumber
end property

public property let PortNumber(ByRef iIn)
m_iPortNumber = iIn
end property

public property get CharacterLength
CharacterLength = m_byteCharacterLength
end property

public property let CharacterLength(ByRef byteIn)
m_byteCharacterLength = byteIn
end property

public property get Debug()
Debug = m_bolDebug
end property

public property let Debug(ByRef bolIn)
m_bolDebug = bolIn
end property

public property get AutoScroll()
AutoScroll = m_bolAutoScroll
end property

public property let AutoScroll(ByRef bolIn)
if (bolIn) then
me.write(m_AUTO_SCROLL_ON)
else
me.write(m_AUTO_SCROLL_OFF)
end if
m_bolAutoScroll = bolIn
end property

public property get Underline()
Underline = m_bolUnderlineCursor
end property

public property let Underline(ByRef bolIn)
if (bolIn) then
me.write(m_SET_UNDERLINE_ON)
else
me.write(m_SET_UNDERLINE_OFF)
end if
m_bolUnderlineCursor = bolIn
end property

public property get Blink()
Blink = m_bolBlinkCursor
end property

public property let Blink(ByRef bolIn)
if (bolIn) then
me.write(m_SET_BLINK_ON)
else
me.write(m_SET_BLINK_OFF)
end if
m_bolBlinkCursor = bolIn
end property

' METHODS
public sub clearScreen()
me.write(m_CLEAR_SCREEN)
end sub public sub screenOn()
me.write(m_SCREEN_ON)
end sub

public sub screenOff()
me.write(m_SCREEN_OFF)
end sub

public sub changeSplashScreen(ByVal strIn)
strIn = Left(strIn, m_byteCharacters)
' Force it to be exactly 32 characters by padding
do while (Len(strIn) < m_byteCharacters)
strIn = (strIn & " ")
loop
me.clearScreen()
me.home()
me.write(m_SET_STARTUP_SPLASH)
me.write(strIn)
end sub

public sub backlight(ByRef byteR, ByRef byteG, ByRef byteB)
me.write(m_SET_RGB)
me.write(chr(byteR))
me.write(chr(byteG))
me.write(chr(byteB))
end sub

' Valid Range 0 - 255. Values between 180 and 220 are suggested
public sub contrast(ByRef byteIn)
me.write(m_SET_CONTRAST)
me.write(chr(byteIn))
end sub

' Valid Range 0 - 255.
public sub brightness(ByRef byteIn)
me.write(m_SET_BRIGHTNESS)
me.write(chr(byteIn))
end sub

public sub setCursorPosition(ByRef iX, ByRef iY)
me.write(m_SET_CURSOR_POSITION)
me.write(chr(iX))
me.write(chr(iY))
end sub

public sub home()
me.write(m_SET_CURSOR_HOME)
end sub

public sub back()
me.write(m_SET_CURSOR_BACK)
end sub

public sub goBack(ByRef iIn)
Dim i
for i = 1 to iIn
me.write(m_SET_CURSOR_BACK)
next
end sub

public sub forward()
me.write(m_SET_CURSOR_FORWARD)
end sub

public sub goForward(ByRef iIn)
Dim i
for i = 1 to iIn
me.write(m_SET_CURSOR_FORWARD)
next
end sub

public sub delete()
me.write(m_SET_CURSOR_BACK)
me.write(" ")
me.write(m_SET_CURSOR_BACK)
end sub

public sub write(ByRef strIn)
Dim serialWriter
if (me.Debug) then
wscript.echo strIn
end if
set serialWriter = m_fso.CreateTextFile("COM" & m_iPortNumber & ":",True)
serialWriter.Write(strIn)
serialWriter.Close()
set serialWriter = nothing
end sub

public sub teletype(ByRef strIn, ByRef iDelayMs)
Dim i
Dim iLen
iLen = Len(strIn)
for i = 1 to iLen
me.write(Mid(strIn, i, 1))
WScript.Sleep(iDelayMs)
next
end sub

public function testComPort(ByRef byteNumber)
Dim serialWriter
if (me.Debug) then
wscript.echo "Attempting communications with COM" & byteNumber
end if
On Error Resume Next
set serialWriter = m_fso.CreateTextFile("COM" & byteNumber & ":",True)
serialWriter.Write("Initialising...")
serialWriter.Close()
set serialWriter = nothing
if (err.number = 0) then
testComPort = true
else
testComPort = false
end if
On Error Goto 0
end function

End Class

Copy it into your VBScript project file or into a dedicated class file and include it. Once it is in scope, the example below shows a general usage pattern for the main API.

It is recommended that all projects include and set the first 8 lines shown below, just so that you can ensure that you are tuning your project in the way that you want it. The remainder of the code shows examples of how to use the functions.

As a result of the USB driver allocating COM ports in a fairly dynamic way under Win32, you cannot expect to hard code your COM Port inside the project – particularly if the physical USB port that the backpack is connected to changes. Consequently, you can use testComPort() to attempt to locate the correct port as shown below. The function will terminate on the first port that it finds with an active serial output line available, if you have multiple active serial ports available on your project, the function may find the wrong port.

Finally, Adafruit recommends – at a minimum -adding a 10 millisecond delay between each command, which is not shown below. You should use WScript.Sleep(10) to achieve similar under VBScript. If you don’t, everything shown below with the exception of the executing of the Teletype macro will occur in well under a second.

Dim usbSerial

set usbSerial = new AdafruitUsbSerial

    usbSerial.PortNumber = 3              ' Set to COM3

    usbSerial.Debug = true                ' Inputs will be written back to WScript

    usbSerial.CharacterLength = 32        ' 32 is the default

    usbSerial.AutoScroll = true           ' Enable/Disable Auto Scroll

    usbSerial.Underline = true            ' Enable Cursor Underline

    usbSerial.Blink = true                ' Enable Cursor Blink' Find the first live COM Port if you don't know where it is

Dim iComPort

for iComPort = 1 to 30

    if (usbSerial.testComPort(iComPort)) then

        usbSerial.PortNumber = iComPort

        Exit For

    end if

next' Write Text

usbSerial.write("some text")' Write on both lines

usbSerial.write("line one" & vblf & "line two")' Clear the screen

usbSerial.clearScreen()' Screen Off

usbSerial.screenOff()

' Screen On
usbSerial.screenOn()

' Change the Backlight Colour
call usbSerial.backlight(255, 0, 255) ' Sets the RGB values (Fuchsia in this case)

' Set the screen brightness
usbSerial.brightness(180) ' 0 - 255

' Set the screen contrast
usbSerial.contrast(180) ' 0 - 255

' Set the Cursor Position
usbSerial.home()                  ' Moves to character 1, row 1
usbSerial.back()                  ' Moves the cursor back 1 character
usbSerial.forward()               ' Moves the cursor forward 1 character
usbSerial.goBack(5)               ' Steps the cursor back 5 characters
usbSerial.goForward(6)            ' Progresses the cursor forward 6 characters
usbSerial.setCursorPosition(5,1)  ' Sets the cursor to Character 5 on Row 1
usbSerial.delete()                ' Moves the cursor back 1 and clears the previous character

' Teletype (Macro)
call usbSerial.teletype("this will teletype out", 100) ' Write the text, with a 0.1 second character delay

' Change the Adafruit Splash Screen (Auto truncated/padded to usbSerial.CharacterLength)
usbSerial.changeSplashScreen("This is a splash screen message")

' Clean up and free resources
set usbSerial = nothing

Thanks to a structured API it is as easy as that!

View: Adafruit: Command Reference
View: Adafruit: Sending Text

See Also

View: Adafruit

Buy Adafruit USB Serial RGB Backlight Character LCD Backpack, and other Adafruit components from Amazon & help support this site:

0x80090020 when attempting to load a .PFX Private Key Certificate into a CAPICOM_MEMORY_STORE using Store.Load() or Certificate.Load() using CAPICOM 2.1.0.2

System Requirements:

  • Windows Server 2008, R2
  • Windows Vista
  • Windows 7
  • Windows 8, 8.1
  • 7.0, 7.5, 8.0
  • ASP 3.0 (Classic)
  • CAPICOM 2.1.0.2

The Problem:

Ah encryption, that most noble of things. One thing that is sure to drive every developer close to the brink on the odd occasion. The one time where clear, concise API documentation should be considered mandatory – and the one place where good API documentation it seems is an obligation itself not to provide. Be it Microsoft, Java, BouncyCastle, PHP it would seem they are all blighted with the same issue.

Attempting to use legacy API on an unsupported platform should seem like an exercise in masochism, however, you know how much I like to avoid using .net whenever I can.

If you attempt to do this

Dim cert
set cert = Server.CreateObject("CAPICOM.Certificate")
call cert.load("c:\myPrivateKey.pfx", "test", CAPICOM_KEY_STORAGE_EXPORTABLE)

or this

const CAPICOM_MEMORY_STORE = 0
const CAPICOM_LOCAL_MACHINE_STORE = 1
const CAPICOM_STORE_OPEN_READ_WRITE = 1
const CAPICOM_KEY_STORAGE_EXPORTABLE = 1Dim store
set store = Server.CreateObject("CAPICOM.Store")
call store.Open(CAPICOM_MEMORY_STORE, "MemoryStore1", CAPICOM_STORE_OPEN_READ_WRITE)
call store.load("c:\myPrivateKey.pfx", "test", CAPICOM_KEY_STORAGE_EXPORTABLE)

you will get back

error '80090020'
/file.asp, line ###

If you send in a .cer file instead of a .pfx, it works without error but doesn’t allow you to access the Private Key.

More Info

Taking the two code samples in order

Dim cert
set cert = Server.CreateObject("CAPICOM.Certificate")
call cert.load("c:\myPrivateKey.pfx", "test", CAPICOM_KEY_STORAGE_EXPORTABLE)

Should you be getting a 0x80070056 error, your password is wrong. If the file doesn’t have a password, only send parameter 1 (which is about to cause you a problem). To resolve the 0x80090020 error while using a CAPICOM_MEMORY_STORE, you need to stop CAPICOM from attempting to insert the certificate as a resource for a user. If the IIS worker process that you are using doesn’t connect to a user account and has no permissions, the default parameter CAPICOM_CURRENT_USER_KEY or 0 will throw 0x80090020.

To change the scope, ensure that you use the fourth parameter and set the value to CAPICOM_LOCAL_MACHINE_KEY.

const CAPICOM_CURRENT_USER_KEY = 0
const CAPICOM_LOCAL_MACHINE_KEY = 1Dim cert
set cert = Server.CreateObject("CAPICOM.Certificate")
call cert.load("c:\myPrivateKey.pfx", "test", CAPICOM_KEY_STORAGE_EXPORTABLE, CAPICOM_LOCAL_MACHINE_KEY)

To resolve the second issue, modify the original code to make use of the now fixed certificate.load() call and import it vie the long route.

const CAPICOM_MEMORY_STORE = 0
const CAPICOM_LOCAL_MACHINE_STORE = 1
const CAPICOM_STORE_OPEN_READ_WRITE = 1
const CAPICOM_KEY_STORAGE_EXPORTABLE = 1Dim cert
Dim store
set store = Server.CreateObject("CAPICOM.Store")
call store.Open(CAPICOM_MEMORY_STORE, "MemoryStore1", CAPICOM_STORE_OPEN_READ_WRITE)set cert = Server.CreateObject("CAPICOM.Certificate")
call cert.load("c:\myPrivateKey.pfx", "test", CAPICOM_KEY_STORAGE_EXPORTABLE, CAPICOM_LOCAL_MACHINE_KEY)

call store.add(cert)

If you receive 0x80070005, you are either getting an Access Denied error to the MEMORY_STORE or you are attempting to import a certificate into the instantiated store which already exists. Similarly, if you receive 0x80070056, your password is wrong.

‘Bug’ in ASP 3.0 Application.Contents iterator causes undesired deletion patterns when Application.Contents.Remove() is called from within a for each / for loop

System Requirements:

  • Windows NT 4.0 Server SP4+
  • Windows Server 2000
  • Windows Server 2003
  • Windows Server 2008, R2
  • Windows Server 2012, R2
  • Windows Server 2016
  • Windows Server 2019
  • Windows 2000 Professional
  • Windows XP
  • Windows Vista
  • Windows 7
  • Windows 8, 8.1
  • windows 10
  • IIS 4.0, 5.0, 5.1, 6.0, 7.0, 7.5, 8.0, 10.0
  • ASP 3.0 (Classic)

The Problem:

I remember, long ago in approximately 2001 – in my less competent days – fighting to make something work and ultimately concluded that it was a hapless endeavour and ultimately went about it in a different way. The task was to clear down all but a small number of elements from the ASP 3.0 Application.Contents object.

What I concluded then, is something that I’ve only just re-remembered now after finally making a determined effort to hunt down a bug in a module on HPC:Factor – which is being used elsewhere – and in which a recent change brought the issue back to light.

There is an iterator issue come bug (depending on your point of view) in the ASP 3.0 Application object.

More Info

We’ll lead by example with this one. After spending an hour or so reacquainting myself with the problem while fixing (read making more robust) the HPC:Factoor class module, a fairly simple process can be used to demonstrate it. Whether or not you see this as a natural feature, or a sincere bug is something that I’ll leave to you. There are always ways around this sort of thing, so I guess that what counts is whether you think it should be fixed in the iterator or by the end user.

Take the following code

Option Explicit
Dim strKey
Application.Contents.RemoveAll()
Application.Contents("one") = "a"
Application.Contents("two") = "b"
Application.Contents("three") = "c"
Application.Contents("four") = "d"
for each strKey in Application.Contents
  Response.Write strKey & " == " & Application.Contents(strKey) & "<br />"
next

It’s obviously going to print out the following

one == a two == b three == c four == d

So what if we now do this:

for each strKey in Application.Contents
  Application.Contents.Remove(strKey)
next
for each strKey in Application.Contents
  Response.Write strKey & " == " & Application.Contents(strKey) & "<br />"
next

Clearly it should print

For dramatic effect, that’s “absolutely nothing being printed”. The application object should be completely empty.

Wrong! It prints:

two == b
four == d

What’s going on is quite simple. The for each iterator being called from the Application.Contents collection is indexed, in other words when items are added or removed they are given a numeric, integer based index in order to aid lookup.

This index becomes stateful as it initially exists at call time for the “for each” provider and its content is copied out to the iterator, By Value (ByVal). It should really be passed out By Reference (ByRef) i.e. via a Pointer.

What this means (using comments to explain the process) is that the following logic occurs:

Option Explicit
Dim strKey
Application.Contents.RemoveAll()            ' Delete all indexes, release pointers to all data
Application.Contents("one") = "a"           ' Create Index 1, Key:"One", Value:"a"
Application.Contents("two") = "b"           ' Create Index 2, Key:"two", Value:"b"
Application.Contents("three") = "c"         ' Create Index 3, Key:"three", Value:"c"
Application.Contents("four") = "d"          ' Create Index 4, Key:"four", Value:"d"
' Application.Contents.Count = 4

for each strKey in Application.Contents     ' Create an iterator of the index [1 - 4]
  ' Iterator Index i = 1
  Application.Contents.Remove(strKey)     ' Remove item at index 1
  ' Index 1 removed, compact index
  ' Index 1, Key:"two", Value:"b"
  ' Index 2, Key:"three", Value:"c"
  ' Index 3, Key:"four", Value:"d"
  ' Application.Contents.Count = 3
  ' Move to NEXT
  ' Iterator Index = 2 (i = (i + 1))
  Application.Contents.Remove(strKey)     ' Remove item at index 2
  ' Index 2 removed, compact index
  ' Index 1, Key:"two", Value:"b"
  ' Index 2, Key:"four", Value:"d"
  ' Application.Contents.Count = 2
  ' Move to NEXT
  ' Iterator Index = 3 (i = (i + 1))
  ' 3 is greater than 2 (the index is > count), exit

The problem is that the Index is being compacted on a successful call to .Remove(). The count of the number of items in Application.Contents is being updated to reflect the correct number of items, but the iterator isn’t being told i = (i – 1) after the successful completion of the Remove() method.

The same thing happens if you use “for” rather than “for each”:

Option Explicit
Dim i
Application.Contents.RemoveAll()
Application.Contents("one") = "a"
Application.Contents("two") = "b"
Application.Contents("three") = "c"
Application.Contents("four") = "d"
for i = 1 to Application.Contents.Count
  Application.Contents.Remove(i)
next

This also results in data still remaining inside the Application Object due to the same error, except here we are directly calling the iteration number ourselves via i so we also get 2 and 4 left in the collection as with calling .Remove() from the “for each”.

If the Application.Contents.Remove method supported a success/failure return type – for example a boolean true for item removed and boolean false for no such item in collection, then the fix would be simple:

for i = 1 to Application.Contents.Count
  if (Application.Contents.Remove(i)) then
    i = (i - i)
  end if
next

Sadly the method doesn’t support a return type.

The Fix

This bug means that there are only two ways to deal with it The first way would be to iterate across the collection, store the Keys in an array and then in a second pass remove all of the items that you want to delete by using an external array.

It does the job and allows you to continue to use keys, but why use two loops when you can use one? In the knowledge that the following is true:

  1. The index is compacting
  2. The iterator is not being reduced by 1 after a successful call to .Remove()

The second and simplest approach to solve the problem is to force the for loop to decrement it for you. In other words, reverse iterate instead of forward iterate through the collection.

Dim i

Application.Contents.RemoveAll()
Application.Contents("one") = 1
Application.Contents("two") = 2
Application.Contents("three") = 3
Application.Contents("four") = 4
for i = Application.Contents.Count to 1 step -1
  Application.Contents.Remove(i)
next

for i = 1 to Application.Contents.Count
  Response.Write Application.Contents.Key(i) & " == " & Application.Contents.Item(i) & "<br />"
next

By going backwards, the index is decremented and so is the external iterator, meaning that they keep in sync with each other.

To adapt this further, if you only want to remove certain items from the collection and want to delete based upon the key, use the following.

Dim i
Application.Contents.RemoveAll()
Application.Contents("one") = 1
Application.Contents("two") = 2
Application.Contents("three") = 3
Application.Contents("four") = 4
for i = Application.Contents.Count to 1 step -1
  if ((Application.Contents.Key(i) = "one") OR (Application.Contents.Key(i) = "three")) then
    Application.Contents.Remove(i)
  end if
next

for i = 1 to Application.Contents.Count
  Response.Write Application.Contents.Key(i) & " == " & Application.Contents.Item(i) & "<br />"
next

Using our example above, the output will correctly be:

two == b
four == d

Memory Leak in SvcHost.exe on Microsoft.XmlHttp (IXMLHTTPRequest) .Send() when called from CScript.exe or WScript.exe

System Requirements:

  • Windows Server 2008 R2

The Problem:

Svchost.exe, that black box amongst many other black boxes. If you ever happened to be in the business of watching what your scripts are getting up to on a Sunday morning and you are using Microsoft.XmlHttp, then you might be in for a surprise.

Every 2 hours a batch process on a group of servers fires off a script that in turn iteratively runs a second VBS script some 200-300 times. The script, calls a Web Service and performs a push/pull of instructions. Within a few days of the patch Tuesday reboot, you start noticing that memory use is going up, and up, and up.

You’ve done all of your deallocations, right? “set xmlHttp = nothing”? Yep, but despite that, memory use continues to grow. The culprit, svchost.exe. It grows until it’s into the page file and then grows a little bit more. Every run of the script puts between 4 and 100KB onto the memory footprint. At the end of the month, the servers are groaning because of memory starvation and your SAN array’s are not happy because of all of the paging.

True story.

More Info

I have been able to reproduce this on 3 separate and wholly independent Server 2008 systems (read different clients, enterprise/retail licensing, server hardware and install images) as well as on related servers (read from the same image on same or similar hardware). I have attempted to reproduce it on Windows Server 2012 R2 and I was not successful. Server 2012 R2 does not appear to be impacted by the issue. Running the iterator loop below for 10 minutes yields no increase in the memory use curve on the operating system, just a constant cycle of assign, release, assign, release that you would expect to see.

After a lot of diagnostics and a lot of me initially assuming that the problem was the web service (many, many wasted hours… although I did find a few bugs in the service code itself…) I managed to narrow it down to Microsoft.XmlHttp. More specifically, it’s in the way that CScript or WScript interfaces with Microsoft.XmlHttp at initialisation.

As you probably know, svchost itself is just a service wrapper. Inspection of the wrapper reveals a number of services running inside the wrapper. In this case the specific services are:

  • COM+ Event System
  • Windows Font Cache Service
  • Network List Service
  • Network Store Interface Service
  • Secure Socket Tunneling Protocol Service
  • WinHTTP Web Proxy Auto-Discovery

There are two things here that could be interesting, COM+ Event System and WinHTTP Web Proxy. Microsoft.XMLHTTP itself relies upon the WinHTTP stack for operation, but we are also using a COM interface to call it from VBScript.

While we cannot shutdown the COM+ Event Service and expect the operating system to survive for long, we can the WinHTTP Web Proxy Auto-Discovery Service. Did it release the memory consumed in the leak? No. So in the balance of probabilities, it’s coming from COM+.

The problem with that is in the need to reboot the server to safely clear the memory leak, hence why Patch Tuesday has been the true savior in keeping a gradual performance bottle neck from becoming a full scale meltdown. So what is going on?

I stripped off all of the web service and customisation parts and went back to vanilla Microsoft implementation examples. We cannot get much simpler than this.

Option Explicit
Dim xmlset xml = CreateObject("Microsoft.XmlHttp")
xml.open "POST", "http://127.0.0.1", false
xml.send "he=llo"
set xml = nothing

Save it to a VBS and run it via CScript, run it a lot. Run it in a BAT file loop

:start
ccscript.exe testfile.vbs
goto start

Watch the svchost.exe processes until you spot the instance with the rising service working set (or private set). Now you know which one to focus on.

It’s memory leaked. Hold on, we’ve created the instance of Microsoft.XmlHttp (which is actually an instance of IXMLHTTPRequest), done something and told CScript to deallocate it (set xml = nothing). Why is it leaking memory?

The third parameter on .Open() is bAsync – is it an asynchronous request? It’s false above, meaning that the request is synchronous. It continues to leak. It would be more likely to leak asynchronously than synchronously, however changing that to true makes no difference.

So where is the leak being triggered? By process of line elimination we can reveal that the memory is committed into the svchost wrapper during xml.send(). Run it without .Send() as below and there is no growth in the scvhost process memory footprint no matter how many times you run it..

Option Explicit
Dim xmlset xml = CreateObject("Microsoft.XmlHttp")
xml.open "POST", "http://127.0.0.1", false
' COMMENTED OUT      xml.send "he=llo"
set xml = nothing

In the MSDN documentation for the .Send() method, it states

“If the input type is a BSTR, the response is always encoded as UTF-8. The caller must set a Content-Type header with the appropriate content type and include a charset parameter.”

So far we haven’t done that and we are sending a VBString – which is ultimately a BSTR in C++, so add in the necessary setRequestHeader beneath the .Open() method call in case it is a case of not following the documentation:

Option Explicit
Dim xmlset xml = CreateObject("Microsoft.XmlHttp")
xml.open "POST", "http://127.0.0.1", false
xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; Charset=UTF-8"
xml.send "he=llo"
set xml = nothing

It isn’t. There is no change, it still results in an increase in process memory after cscript.exe has shutdown.

We have confirmed that there is a memory leak, where it is and what is triggering it. We can also be confident that given the extremely simple nature of the sample code printed above – and its match to the samples documentation – that it is being implemented correctly.

So the next step is to try and prove that there is an issue in the COM implementation between CreateObject and set nothing. This is achieved by running the allocate/deallocate (set/set nothing) in a loop as shown below

Option Explicit
Dim i
Dim xmlwscript.echo TypeName(xml)              ' This returns "empty" on this testfor i = 0 to 999

set xml = CreateObject("Microsoft.XmlHttp")
xml.open "POST", "http://127.0.0.1", false
xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; Charset=UTF-8"
xml.send "he=llo"
wscript.echo xml.responsexml.xml    ' This returns nothing on this test
wscript.echo xml.statusText         ' This returns "OK" on this test
set xml = nothing

next

wscript.echo TypeName(xml)              ' This returns "nothing" on this test

At this point you would expect to see a large increase in the svchost.exe memory footprint.

It does not happen.

1000 iterations and instantiation of the IXMLHTTPRequest later and there is no obvious exponential increase in the memory footprint of svchost.exe. It simply increments once i.e. the additional memory consumption is no worse than running the script with only 1 call to CreateObject/set nothing despite the fact that .send() has been called 1000 times.

What does that mean? Well, it would seem to suggest that the fault isn’t actually in IXMLHTTPRequest (Microsoft.XMLHTTP), but actually in VBScript itself. As a speculative suggestion, I would suggest that VBScript is registering event callbacks with COM+’s Event Management System on the first call to .Send() which are not being cleaned up by the garbage collector when “set nothing” is called in the code. So either there is a bug in VBScript or there is a bug in the event handling interface for COM+ event registration through which IXMLHTTPRequest is registering its own actions.

Most people aren’t going to notice this problem, they are morelikely to iterate instance of Microsoft.XmlHttp inside VBScript than they are to repeatedly externally iterate accross it. It just so happens that I need to fire it externally to the script processor via the command shell. The chances are that if you are reading this, so do you.

The Fix

As of writing, I have not found a direct way to force VBScript to release the memory from scvhost, short of rebooting (or migrating to Windows Server 2012). Calling Microsoft.XmlHttp from WScript or CScript seems to be the problem and the fact that the web service scripts are using an external iterator to repeatedly call n new instances of CScript are exacerbating the situation. Simply put, the transaction load is the catalyst for spotting the leak. In most cases growth would be very subtle as would growth were the iteration internal to the CScript.exe script instance.

While not necessarily ideal, if you are in the position of being able to change provider, you can substitute Microsoft.XMLHTTP for MSXML2.ServerXmlHttp, which provides most of the functionality without making use if WinHTTP. This provider does not exhibit the memory growth issue as in its client counterpart, however its use requires MSXML 3 or 6 and you lose some functionality.

The fact that I could not reproduce the issue under Windows Server 2012 R2 suggests that the culprit has been fixed – either intentionally or inadvertantly. By default, Microsoft.XMLHTTP is a COM Class ID reference to msxml3.dll. Under Windows Server 2008 R2 the file version is SP11 at 8.110.7601.18334, under 2012 R2 the file version is simply 8.110.9600.16483. Yet oddly, with all systems fully patched, vbscript.dll under Windows Server 2008 R2 is version 5.8.9600.17041 (KB2929437) while its counterpart under Server 2012 R2 is 5.8.9600.17031.

What I can tell you is that these systems have been running this recursion script every 2 hours since the beginning of 2012 and the issue has only been observed in more recent months, therefore I suspect that Microsoft have a regression bug on their hands. Until it is fixed however, I have a load of (thankfully firewalled, private network) web service that have a DOS vulnerability. So do you.