Showing posts with label VBScript. Show all posts
Showing posts with label VBScript. Show all posts

February 15, 2012

Using Callbacks on the Regexp.Replace function

On our testprojects, I use regular expressions most of the time for the matching or testing of strings on our Application Under Test. But sometimes I have to use the Replace method of the RegExp object. This day, I discovered an advanced usage of the RegExp.Replace() method. Let me show you with an example:

Dim replacement
Dim regEx : Set regEx = New RegExp ' Create a regular expression.
Dim myString : myString = "Cake, and grief COUNSELING, will be Available at the CoNcLuSiOn of the test."

regEx.Pattern = "\b\w+\b" ' \b = inside word boundary, \w = word character,
                          ' so this pattern matches each single word
regEx.Global = True       ' Set the scope to Global

' normally we replace like this:
replacement = "word"
MsgBox regEx.Replace(mystring, replacement)

' resulting in: "word, word word word, word word word word word word word word word."

This looks familiar I think. But it is not very sophisticated. Wouldn't it be nice if we can replace each match with a custom replacement. With the use of a Function Reference, we can!

 ' We can actually perform a custom action on replace instead of doing a fixed replace
' We do this with making a reference to a function with getref
Set replacement = getRef("Capitelize")

' We need to create a function of course with the same name and three parameters
' 1. singleMatch : the string that matched to the pattern
' 2. position : the position the singlematch string was found
' 3. fullString : the full string (same as 'myString' in this case) without _any_ replacements
Function Capitelize(singleMatch, position, fullString)

    ' Capitelize returns the string singleMatch changed with the first character
    ' in uppercase and all others in lowercase
    Capitelize = ucase(left(singleMatch,1)) & lCase(mid(singleMatch,2))
End Function

MsgBox regEx.Replace(myString, replacement)
' This results in: "Cake, And Grief Counseling, Will Be Available At The Conclusion Of The Test."

Nice huh? Now we can match for a date and replace it on the fly by the correct format. We can replace straight quote characters for curly quotes with the correct orientation with much more ease, or only do a replace if it is within a certain character range in the string. "All new possibilities arise!"

January 27, 2012

Exist or be Created!

Just encountered a collegue having difficulties ensuring if a folder exists. And if a folder does not exists then it has to be created in its full path, not only the lowest level folder. The code was bloated with if/then’s, instr(), instrrev() and left()/right() functions. Even the lowest level folder name was hardcoded.

To help him out, we could go for the fancy recursive solution to show off our 1337 programming skillz, but I decided to just do it with a simple loop. Enjoy.

Public Function EnsureFolder(fPath)
    dim fso, fols, fol, pathBuild
    set fso=CreateObject("Scripting.FileSystemObject")

    fols = split(fpath, "\")

    For each fol in fols
        If fol = "" Then exit for
        pathBuild = pathBuild & fol & "\"
        If Not fso.FolderExists(pathBuild) Then
            Call fso.CreateFolder(pathBuild)
        End If
    Next

    EnsureFolder = pathBuild
End Function

December 13, 2011

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.

November 18, 2010

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.

April 26, 2009

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.

April 8, 2009

A few ways to use arrays

When you first encounter Arrays in QTP it is not very easy to understand quickly. VBScript makes use of a few types of arrays: Static, Dynamic, Assigned to a normal variable and Dictionary objects (the dictionary object is not discussed in this article.). Static and Dynamic arrays can be one dimensional or multidimensional.

First the simple static array. Static because it can only contain a fixed amount of items; Simple because we only put strings in it referred by the indexnumber (or subscript) of the array:


' Simple static array
Dim weekdays(6)

weekdays(0) = "Mon"
weekdays(1) = "Tue"
weekdays(2) = "Wed"
weekdays(3) = "Thu"
weekdays(4) = "Fri"
weekdays(5) = "Sat"
weekdays(6) = "Sun"

When you don't have plans to use the subscript, you can also create the array directly. And yes, it works the same with index numbers as with the weekdays array, but it is good programming practice to use the former method if you want to call the array items by subscript number.

' Simple assigned array
Dim workdays
workdays = array("Mon", "Wed", "Thu", "Fri")

As you can see, the variable does not have to be declared as an array, so theoretically every variable can be set as an array just as every variable can be set as an object. Although, with arrays you don't need the set statement.

Sometimes it is more convenient to dynamically increase and decrease the array size. Then you have to create a dynamic array. This is an array declared the same way as in the simple static array, but without the number of elements, just empty parenthesis: dim myArray()
To set the amount of array items, you have to use ReDim like ReDim myArray(n) where n is the amount of items you want to use +1 (The first subscript is always 0). Other then in a static array declaration (like Dim myArray(5)), the number of subscripts in a ReDim statement can be a variable or constant.
Whenever you use ReDim, the array is reĂŻnitialized, except when you use the Preserve command, indicating you want to reuse the already set values:

' Simple dynamic assigment of an array
Dim myPets()
ReDim myPets(2)
myPets(0) = "Dog"
myPets(1) = "Cat"
myPets(2) = "Hippopotamus"

ReDim Preserve myPets(3)
myPets(3) = "Rabbit"

msgbox "My pets: " & join(myPets, ", ")

The join(array[, separation character(s)]) function lets you easily merge an array to a string.
Another trick is to use join to make an html table easily:
newTableRow = "" & join(arrElements, "") & ""

Multidimensional arrays
A multidimensional array is used to store data or objects in a matrix. You can create virtually create as much dimensions if you want (not really unlimited of course, but keep in mind this good rule with programming: If you have to ask what the limit is for some kind of instance, probably there is something wrong with your design)


' Multidimensional static array, the next code is pure and alone for demonstration purposes
' it is not optimised, maybe even not correct and there are better ways to achieve this
Dim bcCalendar(2100, 12, 31)
Dim dayCounter, maxDay, cYear, cMonth, cDay
dayCounter = 6

For cYear = 0 to 2100
    For cMonth = 1 to 12
        Select Case cMonth
            Case 1,3,5,7,8,10,12    maxDay = 31
            Case 4,6,9,11           maxDay = 30
            Case 2                  maxDay = 28 + abs((cYear mod 400 = 0) or ((cYear mod 4 = 0) and not (cYear mod 100 = 0)))
        End Select

        For cDay = 1 to maxDay
            bcCalendar(cYear, cMonth, cDay) = weekday((dayCounter mod 7)+1)
            dayCounter = dayCounter + 1
        Next
    Next
Next

msgbox "Charles Darwin was born on a " & WeekdayName(bcCalendar(1809, 2, 12))



Passing arrays
Arrays are passed the same way as variables are:

Default: By Reference
With ByRef in the function declaration: By Reference
With ByVal in the function declaration: By Value
With parenthesis around the argument in the function call: always By Value (ByRef in the function declaration is omitted)

Arrays filled with objects
Arrays do not only have to contain variables, they can also contain objects, which is great to make a collection of QTP gui objects, dictionaries, but also class objects to create child classes under a parent.
Arrays can even contain other arrays. This is useful if you want to create a fully dynamic multidimensional array. (Normally, in a multidimensional array, only the last item is expandable with a redim preserve statement.)

November 4, 2008

How to make use of Function Pointers in a Keyword Driven Approach


A commonly used automated test methodology is working with user defined keywords. The tester defines the keyword with parameters next to it and the automated testtool processes this keyword and executes the corresponding function.

There are two ways I know of to make this work in QTP, both with advantages and drawbacks.
A "select case" construction gives you flexibility, but with every keyword you have to add a case manually.

Select Case KeyWord
   Case "login" call login()
   Case "enter user" call enterUser()
   Case Else msgbox "Invalid Keyword: '" & KeyWord & "'"
End Select

Using an eval or execute can lead to type mismatch errors. You can circumvent this by putting in an "On error resume next", but this will lead to no error handling at all by the VBScript engine. Any undefined variable normally results in a "Variable is undefined" error, which can be a great help. You are losing that with an "on error resume next" statement.
Also, a execute or eval does not return a value or object, unless you are capturing that with a variable in the string of the execute itself.

On error resume next
Execute ("TestResult = " & KeyWord & "()") ' -> Any error within the processing of the KeyWord will not be trapped.
On error goto 0

In this post, I will show you another way to dynamically assign keywords to functions in a fast way, with trapping of invalid keywords on a soft way (programmatically and not by the VBScript engine), and keeping the normal error behaviour. This can be done by creating a function pointer to the function and verifying if the function pointer is valid. If so, it can be executed as if it is a normal function:

Dim fp

On error resume next
Set fp = GetRef(KeyWord)
On error goto 0

If IsObject(fp) then
   TestResult = fp
Else
   MsgBox "Keyword '" & KeyWord & "' could NOT be mapped to a valid function."
End if


A function pointer can be used just as a normal function. A drawback of VBScript is the use of fixed arguments, but this can be solved as found elsewhere on teh internets: Passing an array or a dictionary object to the function.

Dim aryArguments
Call GetArguments(aryArguments) 'A function to set all arguments into an array
TestResult = fp(aryArguments) 'Pass the arguments to the function pointed to by the function pointer


And a quick example:

Public Function SumSquares(byRef aryArg)
  Dim i, b
  For i = lbound(anyArg) to ubound (aryArg)
     b = b + aryArg(i)^2
  Next i
  SumSquares = b
End Function

Public Function SqrtSquares(byRef aryArg)
  Dim i, b
  For i = lbound(anyArg) to ubound (aryArg)
     b = b + aryArg(i)^2
  Next i
  If b >= 0 Then SqrtSquares = Sqr(b)
End Function

Public Function HandleKeyword(byval keyWord, byRef aryArg)
  Dim fp

  On error resume next
  Set fp = GetRef(keyWord)
  On error goto 0

  If IsObject(fp) then
     HandleKeyword = fp(aryArg)
  Else
     MsgBox "Keyword '" & KeyWord & "' could NOT be mapped to a valid function."
   HandleKeyword = "INVALID KEYWORD"
  End if
End Function

Dim Arguments
Arguments = array(3, 4, 5)

MsgBox HandleKeyword("SumSquares", Arguments) ' -> shows "50"
MsgBox HandleKeyword("SqrtSquares", Arguments) ' -> shows ~ "7.07107"
MsgBox HandleKeyword("SumFactoerials", Arguments) ' -> shows "INVALID KEYWORD"

October 14, 2008

Parenthesis DO matter

One thing I never knew: Parenthesis matter in QTP (and VBScript). And they surely make a difference. I discovered this during debugging a function call. There was different behaviour between these two function calls:
foo(bar)
call foo(bar)

After some research over the internet and in QTP self, I came to the following conclusions: Passing an argument to a function surrounded by parenthesis means: "Protect me" or in other words: treat me as byVal even if it is defined in the function as byRef.

Example:
sub samplesub (a, b) ' a and b are by default handled as byRef
    a = a + b
end sub

And this is happening when we call samplesub:
x = 1
y = 2
z = 4
samplesub x, y
samplesub (z), y
msgbox x ' displays "3"
msgbox z ' displays "4" because z was passed as if it was passed byVal

The same applies when you call a function:

function samplefunc(c)
    c = c^2-1
    samplefunc = (c mod 2 = 1)
end function

q = 8
samplefunc q
msgbox q ' returns 63

' When you accidentally forgot to call:
p = 9
samplefunc(p)
msgbox p ' returns 9, because p is returned byVal

' With call:
r = 10
call samplefunc(r)
msgbox r ' returns 99, because r is returned byRef

' With call and argument protected:
s = 11
call samplefunc( (s) )
msgbox s ' returns 11, s is returned byVal

' And a last example of a function call with multiple argument with combined protection:
call multifunc( (IamProtected), IamUnprotected )

Rules in short:
A sub/function call with an argument in protected mode overrides a byRef in the function.
A sub/function call with an argument in unprotected mode is returned byRef by default unless it is overridden in the function by a byVal.
An literal or const is always returned byVal.

Syntax proposal:
OK, it is ugly, but if you use parenthesis because they are part of the call, you should use them with spaces between the first and last argument and no space between the function:

call f( a, b )

If you want to use arguments in protected mode, you should use no spaces between the parenthesis and the arguments, but do use them between the function/sub and the parenthesis belonging to the function/sub call:

f (a), (b)
or
call f( (a), (b) )

July 7, 2008

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.

June 28, 2008

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.

June 25, 2008

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 fo
rmula 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 it
self, or use it as conditional formatting: