QTP and Method Chaining disclosed

With method chaining, you can chain object methods to an object in order to change it. It is the default paradigm of JQuery. After using it a while with JQuery, I figured out it is an extremely usefull method to use with QTP.

If you use QTP long enough, you start to create your own function. But because VBScript doesn't allow optional parameters in homebrew functions, existing functions become clumsy with all types of parameters you don't use most of the time.
I remember using functions like findTextInTable(oTbl, txtToFind, startRow, endRow, startColumn, endColumn, byRef foundRow, byRef foundColumn) where each parameter could also be an array or contain signal characters. This results in a function call like this:
findTextInTable(myTable, array("account xyz", "!customer \d+"), 4, "", "", 5, foundRow, "")
So far for self-explanatory code.

When you use object chaining, you use only the parameters you need AND your code will become self explanatory. The code above will become:
xTable.addFindText("account xyz").addRegexFindText("customer \d+").startRow(4).endColumn(5).getFindRow(foundRow)

Of course this need some programming skills to build this correctly into a class, so let's start with an easy example: A string wrapper. When we create the class for the stringwrapper, we use functions for the methods. Functions can return primitives or objects, and with each object call, we return the object itself. You can also use "Get Property", but that will restrict you in the amount of parameters you can pass with your method to be exactly the same as the Let/Set Property.

Class cls_xString

    Private value_

    Public Function SetValue(v)
        value_ = v
        Set SetValue = me
    End Function

    Public Default Function getValue()
        getValue = value_
    End Function

    Public Function ToUpper()
        value_ = uCase(value_)
        Set ToUpper = me
    End Function

    Public Function Append(v)
         value_ = value_ & v
        Set Append = me
    End Function

    Public Function Prepend(v)
        value_ = v & value_
        Set Prepend = me
    End Function

    Public Function Surround(v)
        value_ = v & value_ & v
        Set Surround = me
    End Function

End Class

We use another trick with the getValue; it is the default return value if the string class is called without a Set. To make the class usable globally, we need an initiator function that returns an object of class xString:

Public Function [new xString](initialValue)
    Set [new xString] = new cls_xString
    call [new xString].SetValue(initialValue)
End Function

And now we can create some testcode:
Dim myString
Set myString = [new xString]("W00t, Method Chaining is really Working!")
msgbox myString.ToUpper.Prepend("(").Append(")").Surround("'")

This will result in an editbox with text '(W00T, METHOD CHAINING IS REALLY WORKING!)'
The method are parsed from left to right; first the string is transformed to uppercase, then prepended by (, appended by ) and finally surrounded by '.

Other usage:
- Narrowing down a collection and get a single object
Set linkCollection = [new linkCollection](oPage)    ' Get all links from a page
Set myLink = linkCollection.withRegexText(".*Help.*").Index(3)

Or do directly an action on that object:
linkCollection.withRegexText(".*Help.*").Index(3).Click

- Narrowing down collections and do actions on them:
Set editCollection = [new editboxCollection](oPage)    ' Get all editboxes from a page
' Set all editboxes that are visible, enabled and empty with a value
editCollection.withProperty("visible:=true").withProperty("enabled:=true").withValue("").setValue("Foo Bar!")

- Do a custom action on an object
Private Function DisplayToString(object)
    MsgBox object.ToString()
End Function
Set editCollection = [new editboxCollection](oPage)    ' Get all editboxes from a page
' Show the toString value of all editboxes that are not visible on a page
editCollection.withProperty("visible:=false").each(getRef("DisplayToString"))

Method chaining is very versatile, with the trap of being used to much. Actually it does pretty much the same using the 'with' keyword with objects. It can make your code more clear, or just more obfuscated. Use it wisely.

Curious QTP behaviour when using on error: Proceed to Next Step

Because we build our own framework, the on error settings in QTP are default on "Proceed to Next Step" for our unattended continuous script. So when a test is scheduled in the middle of the night, the test won't stall on errors like a function with an argument too few or many, an array that is out of bounds or an accidentally undeclared variable (please build an undeclared variable checker HP, the Patterson boys could do it years ago, you can do it too!).

It works fine most of the time, although debugging is done with an "attended run" script and all possible error detection on: Popup Messagebox and Option Explicit everywhere.

The curious behaviour happened in an Select Case. Consider this code:

Option Explicit
Dim myCondition : myCondition = 2
Select Case myCondition
    Case 1 MsgBox "Wooh! Condition 1"
    Case 2 MsgBox "Displaying undeclared variable: " & undeclaredVariable
    Case 3 MsgBox "Meh, Condition 3"
End Select 

When you run this code in attended mode, you'll get a nice error nagging about the undeclared variable.
However, when you run this in unattended mode, you'll get a messagebox with the text: "Meh, condition 3"

QTP is doing what it says: Continue with the next step. But the step is not fulfilling the Select condition and program technical a major sin!
Because I ran this accidentally in unattended mode, it took me some while to get a finger behind the error. In the end, I learned to always debug in attended mode.

QTP and how to create an autodestruct class

Somewhere in our application under test, we have a webpage that only continues loading if the mouse is slightly moved. The page is loading while QTP is syncing the page. During the syncing, I cannot send mouse move commands from QTP to the application.

I don’t know why the application has this feature and “they” don’t want to fix it, so… work around time.

I created a low profile mousemove application in C that only does one thing: After 5 seconds it moves the mouse cursor one pixel to the right. And after 5 seconds it moves the cursor one pixel to the left. Repeat.

Actually it is an cut down version of out nolock.exe application, this application sniffs the mouse cursor movements. If it detects inactivity for 10 minutes, it moves the mouse cursor slightly in the same manner as discussed above. This program has a shortcut in the Windows Startup folder and prevent the screen from locking when automated tests are running.

But back to the autodestruct class. We want to have a “single line of code” to implement this in any function where we expect the screen to hang. This class starts the mouse moving as soon as it is created and stops the mouse moving when it is destroyed.

Private Const MOUSE_MOVE_APPL_NAME = “mouseMover.exe”

Private Const BINARIES_FOLDER = “C:\QTP_Framework\tooling\bin\”

Class cls_AutoDestructMouseMover

Private Sub class_initialize()

‘ Put the cursor somewhere to prevent it is on the extreme right position

call extern.SetCursorPos(100, 150)

‘ Run the external mouse move application

systemutil.Run BINARIES_FOLDER & _

MOUSE_MOVE_APPL_NAME, "", BINARIES_FOLDER

End Sub

Private sub class_terminate()

‘ Kill the mouse move application

systemUtil.CloseProcessByName MOUSE_MOVE_APPL_NAME

End Sub

End Class

And make a public accessor for the class:

Public function [new AutoDestructMouseMover]

Set [new AutoDestructMouseMover] = new cls_AutoDestructMouseMover

End Function

Now, we can implement the class whenever it is needed:

Public Function Example

‘ Create the object, make it move!

Dim autoDestructMouseMover : Set autoDestructMouseMover = [new AutoDestructMouseMover]

Call TimeConsumingFunction

‘ Destroy the object, let it stop!

Set autoDestructMouseMover = Nothing

End Function

But wait, we called it an “autodestruct” class, what about the autodestruct? Well, The last line of code is not necessary. When the Example function ends, it automatically destroys all variables and objectpointers with local scope. We can simply reduce the implementation of the autodestructor to one line of code (I know, I am cheating with the semicolon):

Public Function Example

‘ Create the object, make it move!

Dim autoDestructMouseMover : Set autoDestructMouseMover = [new AutoDestructMouseMover]

Call TimeConsumingFunction

End Function

And the autoDestructMouseMover object is automatically destroyed with the function clean up.

Nice. But are there more appliances for an autodestruct object? Oh, yes.

What do you think an autoDestructStackTracer?

Class cls_AutoDestructStackTracer

Private procedureName_

Public Sub Init(pName)

procedureName_ = pName

Print now & “ ADST Start “ & procedureName_

End Sub

Private sub class_terminate()

Print now & “ ADST Exit “ & procedureName_

End Sub

End Class

And make a public accessor for the class:

Public function [new AutoDestructStackTracer](pName)

Set [new AutoDestructStackTracer] = new cls_AutoDestructStackTracer

[new AutoDestructStackTracer].Init pName

End Function

And let’s test it:

Public Function ExampleParent

Dim autoDestructStackTracer : Set autoDestructStackTracer = [new AutoDestructStackTracer](“ExampleParent”)

Print “I’m with ExampleParent now!”

Call ExampleChild

End Function

Public Function ExampleChild

Dim autoDestructStackTracer : Set autoDestructStackTracer = [new AutoDestructStackTracer](“ExampleChild”)

Print “I’m with ExampleChild now!”

End Function

Call ExampleParent

Output:

18-11-2010 9:06:06 ADST Start ExampleParent

I’m with ExampleParent now!

18-11-2010 9:06:06 ADST Start ExampleChild

I’m with ExampleChild now!

18-11-2010 9:06:06 ADST Exit ExampleChild

18-11-2010 9:06:06 ADST Exit ExampleParent

And consider uses of an [new AutoDestructFunctionTimer](pName) to measure the performance of your different functions. Or a [new ScreenShotOnFunctionExit] (and more generalized: [new ExecuteOnFunctionExit](“call PerformScreenshot”)) when you have lots of functions with multiple exit points.

How to use classes in QTP revisited

Classes in QTP are a bit tricky if you want to use them for the first time. You have to know and understand the principle that a class got local scope for the QTP Function Library (.qfl file) it is in, and that if you want to use it in another library, you’ll have to create a constructor (I have shown this before, but I’ll do it again):


' Constructor:
Public Function [new CustomClass]()
     Set [new CustomClass] = new cls_CustomClass
End Function

' Class definition:
Class cls_CustomClass
     Private Sub Class_Initialize()
         Print "Custom Class: I am created!"
     End Sub
End Class

' using the object in another library:
Dim myClass
Set myClass = [new CustomClass]

This seems like a drawback, but it creates a great possibility. Normally, it is not possible to pass initialisation parameters into a new class, because Class_Initialize does not accept parameters. But using the constructor function, we can!

Option Explicit

' Make a private variable that we can pass into the class
Private PARAMETER_ARRAY

' Create a function that returns the requested class. Accepts
' a parameter array. Note: Do not use paramArray, it is reserved!
Public Function [new customClass](ByVal parameterArray)

     PARAMETER_ARRAY = parameterArray

     ' Return a clsCustomClass object
     Set [new CustomClass] = new cls_CustomClass

End Function

' Create the custom class. Classes are always declared Private in QTP
Class cls_CustomClass

     ' The sub Class_Initialize is used to initialize the object with the
     ' parameters passed into the constructor
     Private Sub Class_Initialize()
         ' Do something with the parameters
         Print join(PARAMETER_ARRAY, vbNewLine)
     End Sub

End Class

' Test code
Dim myClass
Set myClass = [new customClass](array("first parameter", "second parameter", "etc."))

Notice what we just did: We created a Private variable, that can only be used by CustomClass classes. So with the use of Private variables with local scope to the library where you put the class in, you create a static variable for the class!
A static variable in this context is a variable that keeps its value and can be used over multiple objects of the same class:

' Declaring the static variables
Private INSTANCE_COUNTER : INSTANCE_COUNTER = 0

' Constructor:
Public Function [new CustomClass]()
     Set [new CustomClass] = new cls_CustomClass
End Function

' Class definition:
Class cls_CustomClass
     Private Sub Class_Initialize()
         Print "I am created and I have " & INSTANCE_COUNTER & " sister(s)."
         INSTANCE_COUNTER = INSTANCE_COUNTER + 1
     End Sub

     Private Sub Class_Terminate()
         INSTANCE_COUNTER = INSTANCE_COUNTER – 1
     End Sub
End Class

' using the object in another library:
Dim a, b, c
Set a = [new CustomClass]
Set b = [new CustomClass]
Set c = [new CustomClass]

Results in:
I am created and I have 0 sister(s).
I am created and I have 1 sister(s).
I am created and I have 2 sister(s).

By using the static variable as a reference for the object itself, we can create a singleton object. A singleton is an object whereof only one instance at a time can exist. In object oriented languages, singletons are normally used for large objects, or objects that will go bad if multiple instances exists like deadlocks or instability.

Option explicit

Private SINGLETON : Set SINGLETON = Nothing

Public function [new Singleton]()
     If SINGLETON Is Nothing Then
         set SINGLETON = new cls_Singleton
     End If

     Set [new Singleton] = SINGLETON
End Function

Class cls_Singleton

     Private Sub Class_Initialize
         Print "I am unique!"
     End Sub

End Class

Dim st1, st2, st3
Set st1 = [new Singleton]
Set st2 = [new Singleton]
Set st3 = [new Singleton]

Results in only one:
I am unique!

There is a drawback: Once a singleton object is created this way, it is not possible to destroy it without the use of some code violating the object oriented principle.

QTP variable name conventions

When you start with a new test automation project, your code is conveniently arranged and you still have a clear overview over the locations and naming of variables and functions. But later on it will become a disaster if you don’t manage it a little bit.
That is why I wrote a name convention article. It is not an official how-you-should-do-it document, it is just the way I do things and written from experience.

' Public and Private constants in capitals
Public Const MOUSEEVENTTF _MOVE = 1
Private Const APPLICATION_MAIN_WINDOW = "name:=My Application"

' Functions, Subs and local variables in lowerCamelCase
Public Function myCustomFunction(thisVariable, thatVariable)

     ' Variables with a known type can be declared with the type abbreviation in front of it
     Dim arrStaticArry(5), objFile, intCounter, blnReadOnly

     ' Variables with a unknown type are declared without a type abbreviation, This is also applicable for variables used in self commentary code.
     Dim customContainer, fileWasFound

     ' Consts with local scope are declared with the same format as variables
     Const cannotBeChanged = True

End Function

' Classes in UpperCamelCase. In QTP I use the cls_ tag in front of it for reasons explained later.
Class cls_EventListener

     ' Public variables are in UpperCamelCase too
     Public BufferLength

     ' Private variables with class scope are lowerCamelCase with an underscore behind it
     Private updateCounter_, eventNumber_

     ' Properties, Subs and Functions (public and private) are all in UpperCamelCase
     Public Property Get EventNumber()
         EventNumber = eventNumber_
     End Property
End Class

In QTP, a class gets a local scope. To make it global, you have to add a function returning that class. As a side effect, this gives you the opportunity to initialize the class. Of course you have to add an init method to your class if you do it this way.

Public Function [new EventListener](initializationParameters)
     Set [new EventListener] = new cls_EventListener
     [new EventListener].Init(initializationParameters)
End Function

Now, you can set a new class with the following code in another library:
Set EventListener = [new EventListener]("codebase:=Unicode")

Side note: The square brackets around a variable lets you enter every character for a variable, including spaces, special characters etc. If you find that inconvenient, you can use an underscore: new_EventListener to mimic normal VB functionality.
I use the square brackets when I want to express importance for example:

' Call the main routine of this script:
[___ !MAIN! ___]

' Or to enjoy my co workers (and to see if they ever peer review my code):
Dim [ O\-<>-/O ], [ ¿Que? ]

QTP Quick Reference Card

As a WinRunner user, I've got very used to the concept of automated testing. Changing to QTP was not much of a problem except for the language notation. For example, the thing I always do wrong:



Select Case anyVariable
    Case 1,2
        ...
    Case Default ... ***CRASH***

And you'll only discover it at runtime, because Default is displayed in blue as it is used to set the default property for a class. ('Default' is the 'Case Else' in C/C++ or TSL).

For all advanced users having trouble with VBScript notation on the expert view, I want to share my QTP Quick Reference Card (also called Cheat Sheet). It displays all general functions you'll want to use in QTP.

The PNG version:



Or the smaller and more portable PDF version:



If you have any comments or additions on this document, please leave a message in the comments.

Get the text from a tooltip with WinRunner

Getting the text form a standard tooltip in an HTML document with WinRunner took me some time to figure out. Actually it is one small statement that will do the trick, but finding out what statement kept me searching for a while.

win_get_info("{class: window, MSW_class:\"tooltips_class32\",displayed: 1}","text",text);

This will do it. Really.

And to wrap it into a function:
 
public function get_tooltip(object, out text)
{
        auto hwnd, rc;
       
        # First set the cursor position to the left corner of the screen. When you don't do this,
        # a formerly captured tooltip can be hovering over the object, making it impossible
        # for WinRunner to locate it.
        rc = move_locator_abs(1, 1);
       
        # Move the cursor to the object containing the tooltip 
        web_cursor_to_obj(object, 1, 1);
 
        # Move the cursor back and forth to trigger the tooltip to pop up
        move_locator_rel(0,1);
        move_locator_rel(0,-1);
 
        # Wait for the tooltip. This is time consuming, something to keep in mind when
        # you want to use this function
        wait(2);
       
        # Check on visibility of the tooltip window, otherwise a standard tooltip does not exist for this object               
        if((rc = win_exists("{class: window, MSW_class: \"tooltips_class32\",displayed: 1}")) == E_OK)
               
                # Capture the text
                return win_get_info("{class: window, MSW_class: \"tooltips_class32\",displayed: 1}","text",text);
       
        return rc;
}
 
Keep in mind, this only works with standard tooltips, recognizable on the title='[text]' attribute in the HTML tag (not always visible when CSS is used). When the tooltip is a customized tooltip created by some JavaScript, most probably it is created as a frame object and you'll have to capture the text of that frame object in stead.

This Weekend's Code Play

Right now, I am almost finishing Gödel, Escher, Bach written by Douglas R. Hofstadter. Well, I'm on page 614, so I still have around 200 pages to go, but for me it feels like almost finishing. And this inspired me to a little piece of code in VBScript:




Dim a, p 
Dim YmPool(8)

Do
    mIP = afNe(a+3)*2
    NextElem = el
    
    If YmPool((a+2)*3) = aDig Or p = 1 Then 

        InTest = a
        LitNuod "nametag", "Gateman"

        Do Until a = t
            Set NineHt1 = ProgId
            a = (3*(2+a))
        Loop 

        MyFile = Me
        Let xEn = 2*(3+a)
        
    End If
    
    a = PI Mod (8)
Loop 

myMid p, amId

Do you see the catch?

My next challenge: Write an actual snippet in VBScript this way that makes sense and that is actually usable.

QTP: IBAN validation in VBScript

IBAN stands for International Bank Account Number and is the old new toy of the banking community. Also hot in Europe because of SEPA. IBAN should make life easier, and maybe it does. For IT guys, IBAN is just another standard. And despite IT guys like standards (that is why they have so many of them), IBAN is a standard designed by the banking people making things a little more complicated.

The things you want to do with IBAN is validate it or just calculate the checksum on your own. The formula for the checksum is not very complex, but has some twists in it. For example, when dealing with Alpha characters, the A is transposed to 10, the B to 11 etc. In the IT world, we would transpose A to 65, B to 66… The things you don't want is validate them exactly right for for every country on this little planet. Maybe they want it, but definitely, you don't. And if they want it, get yourself a new toy called SOAP and connect to it through a service.

After searching the internet, I discovered that code for IBAN validation through any Visual Basic language was rare. I gathered the snippets I found useful and created my own IBAN functions.

How it works is all in the comments in the code, keeping your scripts maintainable and documented if you want to use it:

' This code was created by Bas M. Dam and first published on
' http://automated-chaos.blogspot.com
' You can use and distribute this code freely, as long as you
' keep this commentblock intact.

' RETRIEVING THE CHECKSUM
' There are two methods to get the checksum. The first is the
' one used in automated processes where there is an iban prototype.
' the checksum is replaced by zeros:
' MsgBox getIBANchecksum("LC00BANK1234567890", empty) 'returns 86

' The other way is a more user fiendly appraoch if only the separate
' segments are known like bank code or clearing house:
' MsgBox getIBANchecksum("BANK1234567890", "LC") 'returns 86

' CREATE AN IBAN NUMBER
' This is implemented in the makeIBAN() function for your convenience
' Msgbox makeIBAN("LC", "BANK", empty, "1234567890")    
    ' returns LC86BANK1234567890

' Or just the simple implementation:
' Msgbox makeIBAN("LCBANK1234567890", empty, empty, empty)
    ' returns LC86BANK1234567890

' CHECK AN IBAN NUMBER
' And finally, you want to check if something is IBAN. You can
' use the getIBANchecksum function for it. If the result is 97,
' then you have a real IBAN, when it returns -1, there is something
' wrong with the IBAN and if it returns another number, the checksum
' is not correct
' Msgbox getIBANchecksum("LC86BANK1234567890", empty) 'returns 97
' Msgbox getIBANchecksum("LC68BANK1234567890", empty) 'returns 18
' Msgbox getIBANchecksum("LC68BANK1234567891", empty) 'returns 88
' Msgbox getIBANchecksum("LC86BANK123456789%", empty) 'returns -1

' To do this the simple way, you can make use of the isIBAN() function
' that simply returns True or False:
' Msgbox isIBAN("LC86BANK1234567890") 'returns True
' Msgbox isIBAN("LC68BANK1234567890") 'returns False
' Msgbox isIBAN("LC86BANK123456789%") 'returns False


' SPECIAL CHARACTERS
' You can use typographical characters as stated in the skipChars string.
' For now, the following characters can be used: space.-_,/
' These characters are often used to make an IBAN more readible, but are
' not taken into the checksum calculation. between the landcode
' and checksum, never a typographical character can be used.
' Msgbox isIBAN("LC86 BANK 1234 5678 90") 'returns True
' Msgbox isIBAN("LC86BANK1234.56.78.90")  'returns True
' Msgbox isIBAN("LC-86-BANK-1234-567890") 'returns False, there can not
                    'be a separation char between
                    'landcode and checksum.
' Msgbox isIBAN("LC*86*BANK*1234*567890") 'returns False, * is not a special char

' Function to check on an IBAN
Public Function isIBAN(sIban)

  isIBAN = (getIBANchecksum(sIban, empty) = 97)
   
End Function

' Function to create an IBAN. Any of the arguments can be empty, as
' long as the first not empty argument starts with the landcode
Public function makeIBAN(landcode, bankcode, sortcode, accountnr)

    dim realLandcode, sPurged

    sPurged = mid(landcode & bankcode & sortcode & accountnr, 3)
    realLandcode = left(landcode & bankcode & sortcode & accountnr, 2)
    
    makeIBAN = realLandcode & getIBANchecksum(sPurged, realLandcode) & sPurged
   
End Function

' Function to get an IBAN checksum. Landcode can be empty, but then, the landcode
' must be included in the first two characters of sIban, followed by two zero's
Public Function getIBANchecksum(sIban, landcode)

  Dim sLCCS        'Land Code and Check Sum
  Dim sIbanMixed
  Dim sIbanDigits
  Dim char
  Dim i
  Dim skipChars
  skipChars = " .-_,/"
    
  ' Marginal length check
  If Len(sIban) < 5 Or Len(sIban) > 35 Then
    getIBANchecksum = -1
    Exit Function
  End If

  If landcode = empty Then
    sLCCS = Left(sIban, 4)     '   Extract land code and check sum
    sIbanMixed = Right(sIban, Len(sIban) - 4) & UCase(sLCCS)
  else
    sLCCS = landcode & "00"
    sIbanMixed = sIban & UCase(sLCCS)
  End If
   
    For i = 1 To Len(sIbanMixed)
        char = Mid(sIbanMixed, i, 1)

        'Check on digits
        If IsNumeric(char) Then         
           sIbanDigits = sIbanDigits & char    
    
        'Check on typographical characters
        elseif instr(skipChars, char) Then  
           'skip this character, but continue
    
        'Check on non-uppercase other characters
        elseif Asc(char) < 65 OR Asc(char) > 90 then
           getIBANchecksum = -1
           Exit function
   
        'Transform characters to digits
        else
           sIbanDigits = sIbanDigits & (Asc(char) - 55)
        End If
    Next

    getIBANchecksum = 98 - largeModulus(sIbanDigits, 97)
      
End Function

' Calculates the modulus of large integers that are actually
' strings. Also usefull for implementation in Excel VBA
' (there is a known bug in Excel and large number modulus)
Private Function largeModulus(sNumber, modulus)
    Dim i, sRebuild(), j, r
    
    j = 0
    sNumber = cStr(sNumber)
    
    For i = 1 To Len(sNumber) + 6 Step 6
        ReDim Preserve sRebuild(j)
        
        sRebuild(j) = Mid(sNumber, i, 6)
        j = j + 1
    Next

    r = sRebuild(0) Mod modulus
    
    For i = 0 To UBound(sRebuild) - 1
        r = (r & sRebuild(i + 1)) Mod modulus
    Next
    
    largeModulus = r
    
End Function

The knowledge about the IBAN validation and some code tricks I retrieved from the internet, so it is my turn to to give it back to the community. The functions are also useful in Excel VBA, but not extensively tested. The isIBAN() function is great to use it in your spreadsheet itself, or use it as conditional formatting:

Continued: Creating a Queue data type in QTP

DONG, Housekeeping message: If you have questions, additional information, an opinion or just something to share, you are very welcome to leave it in the comments. I like to get personal mail too, but as mentioned on coding horrors: on a blog, the comments are the best part. And since I just started, I still need some!

In addition to a question I received through email: The class to create a queue on the linked list I published Monday, and how to perform a count on this queue.

Public function queue()
  set queue = new clsQueue
End Function

Class clsQueue

  Private ll

  Private Sub Class_Initialize  ' Setup Initialize event.
    set ll = linkedList     ' Create a linked list instance
    End Sub

  Public function pop()
    If ll.count = 0 Then exit function  ' No items in the list
        pop = ll.getfirst()     ' Return the last item
    ll.deleteFirst        ' and delete it
  End Function

  Public sub push(element)    
    ll.add element        ' Add an item to the list
    End sub

  Public function peek()      
    peek = ll.getfirst()      ' Peek at the top item
  End Function

  Public property get count()
    'return the amount of nodes
    count = ll.count
  End Property
  
End Class

And this is the part where inheritance and polymorphism is missing. The class looks kind of the same as the stack class, but .getlast() is replaced by .getfirst(). I wish everything in life was this simple… The count property is added, so you can now count the items in the queue. If you want to add a count property to the stack, just do the same in the clsStack.

Abstract data types in QTP: The linked list

Normally the need for abstract datatypes in Test Automation is not very high. But you will see, just if you don’t have direct access to them, you’ll need them most. Today I had to store some data and it would be nice if I could pop and push it on some stacks. The basis for stacks (and queues) is a linked list. This was a nice Monday morning starter. Linked lists are simple, if you have the right toolset. Unfortunately, QTP and VBScript do not support pointers, so I had to be a little creative. First of all, I created a node class. Each node has a unique index number and a reference to the index numbers of its left and right neighbours. The data is conserved in a public available data element that can contain objects or variants.

' This is a setup for a linked list. This linked list is the basis for
' queues and stacks. With a little adaptation this can be transformed to
' a binary three or more complex abstract data types.

Option explicit

' Initializer for a new listnode. If you keep it private, you don't need this
' caller function
Private function listNode()
    Set listNode = new clsListNode
End Function

' class for a node. The nodeIndex functions as pointerreference
Class clsListNode

    Public data              'Data, can be a variable or an object (not an array)
    Public prevNode
    Public nextNode
    Private nodeIndex        'Index reference

    ' I use a property get to make a defaulter
    Public default property get index()    
        index = nodeIndex    
    End Property

    ' and a property let to set a new indexer
    Public property let index(inr)
        nodeIndex = inr
    End Property
End class

To keep track of the nodes, I created an array called collection containing node elements. Collection() is a list of references, but is never referred directly except when we add a new node. If a new node is added, the subscript of collection is incremented to create a new unique reference. Because elements can be added or deleted randomly, do not use collection() and its subscript as a continuous or a chronological list!

With add(), we can add an element to the end of the linked list. With getlast() and getfirst() the last and first data elements on the linked list are returned and with deletelast() and deletefirst() the last and first nodes are deleted.

Count() is a helper function, returning the amount of nodes in the list.

' Make the linked list caller
Public function linkedList()
    set linkedList = new clsLinkedList
End Function

' The linked list call
Class clsLinkedList

    private    collection()       ' a single dimensional array of listNodes
    Private lastItemIndex         ' index of the last item
    Private firstItemIndex        ' index of the first item
    Private indexNumber           ' counter for nodes in the list. Only increment, never decrement!
    Private nodeCount             ' amount of nodes. Ugly but fast.
  
    Private Sub Class_Initialize  ' Setup Initialize event.
        lastItemIndex = null   
        firstItemIndex = null
        indexNumber = 0
        nodeCount = 0
    End Sub

    Public sub add(data)

        ' add new listNode element to the array
        ReDim preserve collection(indexNumber)
        set collection(indexNumber) = listNode

        With collection(indexNumber)
            ' Make the collection compatible for objects as well as normal variables
            If isObject(data) Then
                set .data = data
            else
                .data = data
            End If

            .prevNode = lastItemIndex    ' The previous node of the new node is the current
                                         ' last node reference
            .nextNode = null             ' As it is the last item, there is no reference
                                         ' to the next item
            .index() = indexNumber       ' Set the index of the node to a unique number

            If not isnull(.prevNode) Then     ' If the newly created node has a left neighbour:
                collection(.prevNode).nextNode = indexNumber    ' the nextnode reference of the left
            else                                                ' neighbour is the index of the newly created
                firstItemIndex = .index       ' Else, this is the first node and the first node reference is the
            end if                            ' index of the newly created node
        end with

        lastItemIndex = indexNumber          ' As this is the last node, set the reference to this indexnumber
        indexNumber = indexNumber + 1        ' make a new indexnumber for a unique reference next time
        nodeCount = nodeCount + 1            ' and increment the nodecounter
    End sub

    Public property get getlast()
        If nodeCount = 0 Then exit property                ' No nodes? exit!

        If isobject(collection(lastItemIndex).data) then   ' Object or variant?
            Set getlast = collection(lastItemIndex).data   ' return object
        else
            getlast = collection(lastItemIndex).data       ' return variant
        end if   
    End Property

    Public property get getfirst()

        If nodeCount = 0 Then exit property

        If isobject(collection(firstItemIndex).data) then
            Set getfirst = collection(firstItemIndex).data
        else
            getfirst = collection(firstItemIndex).data
        end if
   
    End Property

    Public sub deletelast()

        If nodeCount = 0 Then exit sub    'Exit on no nodes

        Dim tempLastIndex
        tempLastIndex = lastItemIndex     'Make a temp for the last index number
       
        ' Check if there is a previous node
        If not isnull(collection(lastItemIndex).prevNode)  Then   
                ' Set the reference for the last item to the index of the left neighbour
            lastItemIndex = collection(collection(lastItemIndex).prevNode).index
                ' Set the reference for the next node of the left neighbour to null
            collection(lastItemIndex).nextNode = null
        End If

        ' destroy the node element
        Set collection(tempLastIndex) = nothing

        ' decrement the node counter
        nodeCount = nodeCount - 1
    End Sub

    Public sub deletefirst()

        If nodeCount = 0 Then exit sub
       
        Dim tempFirstIndex
        tempFirstIndex = firstItemIndex

        ' Check if there is a next node
        If not isnull(collection(firstItemIndex).nextNode)  Then
                ' Set the reference for the first item to the index of the right neighbour
            firstItemIndex = collection(collection(firstItemIndex).nextNode).index
                ' Set the reference for the previous node of the right neighbour to null
            collection(firstItemIndex).prevNode = null
        End If

        Set collection(tempFirstIndex) = nothing
        nodeCount = nodeCount - 1
    End Sub

    Public property get count()
        'return the amount of nodes
        count = nodeCount
    End Property
   
end class 


Some test statements to show how it works::


Dim ll, mc
Set ll = linkedList

    ll.add "first"
    ll.add "second"
    ll.add "third"
    ll.add "fourth"
    ll.add "fifth"
   
msgbox ll.getFirst()            ' >first
msgbox ll.getLast()             ' >fifth

' Delete the first item
ll.deletefirst
msgbox ll.getFirst()            ' >second

msgbox ll.count                 ' >4

' Delete the last two items
ll.deletelast
ll.deletelast
msgbox ll.getLast()             ' >third


The linked list class makes it very easy to create stacks and queues. Here is an example of how to create a stack:


Public function stack()
    set stack = new clsStack
End Function

Class clsStack

    Private ll
    Private Sub Class_Initialize    ' Setup Initialize event.
        set ll = linkedList         ' Create a linked list instance
    End Sub

    Public function pop()
        If ll.count = 0 Then exit function    ' No items in the list
        pop = ll.getlast()          ' Return the last item
        ll.deleteLast               ' and delete it
    End Function

    Public sub push(element)       
        ll.add element              ' Add an item to the list
    End sub

    Public function peek()           
        peek = ll.getlast()         ' Peek at the top item
    End Function

End Class

And some sample code for a little demonstration:

Dim myStack
set myStack = stack         ' Set as new stack

myStack.push "item1"        ' Add some items
myStack.push "item2"
myStack.push "item3"

msgbox myStack.pop()        ' >item3
msgbox myStack.peek()       ' >item2
msgbox myStack.pop()        ' >item2 

The thing that is missing for generic use is an insertbefore() and an insertafter() method on the linked list. But to implement this, you'll need a virtual reference table that maps the collection() array index to a chronologic ánd continuous index. Another way to do this is a looping mechanism where you can walk through the elements with a getnext() or getprevious() method.
For now, the stack and queue functionality is sufficient for my needs.