VBScript for testers

[Back home]

a = "a sentence ending with "
msgbox(a)
 
b = "3"
msgbox(b)
 
msgbox(a & b)
 
c = b
msgbox(a & c)
 
d = 3
msgbox(d)
 
msgbox(a & d)
 
e = "hello "
f = "world"
msgbox("I said: " & e & f)
 
g = 4132
h = 8956
 
i = g + h
msgbox(i)
 
msgbox("the sum of " & g & " and " & h & " is: " & i)
 
g = "4132"
h = "8956"
msgbox(g + h)

a = 6
if a < 2 then
    msgbox("a less than 2")
else
    msgbox("a greater than 2")
end if

b = 1
do while b < 5
    msgbox("b equals " & b)
    b = b + 1
loop

 
i = 0
while not i = 5
    msgbox(i)
    i = i + 1
wend

for i = 0 to 10 step 1
    msgbox i 'don't need brackets
next
 
 
for c = 1 to 5
    msgbox("c equals " & c)
next

var = "A"
select case var
    case "A"
        msgbox("A")
    case "B"
        msgbox("B")
     case else
        msgbox("Neither A nor B")
end select

x = b
y = c
select case TRUE
    case x >= 0 and y <= 4
        msgbox("first case")
    case x >= 5 and y <= 10
        msgbox("second case")
     case else
        msgbox("error case")
end select

sub a_subroutine
    msgbox("I'm a subroutine")
end sub
 
a_subroutine
 
sub b_subroutine(X)
    msgbox(X)
end sub
 
b_subroutine("Bread")

function funa
    call funb("d") 'calling with literal
end function
 
function funb(c)
    msgbox("you sent " & c)
end function
 
funa
 
function add(a, b)
    add = a + b
end function
 
answer = add(1, 8)
msgbox("the answer was: " & answer)
 
 
function echo_function(message)
    wscript.echo(message)
end function
 
function error_function(message)
    wscript.stderr(message)
end function
 
function msgbox_function(message)
    msgbox(message)
end function
 
function msgbox_modal_function(message)
    msgbox(message), vbSystemModal
end function
 
function msgbox_quit_function(message)
    'http://vb6reference.tomswebdesign.net/msgbox.html
    ans = msgbox(message, vbOKCancel + vbInformation + vbDefaultButton1, "Press cancel to quit")
    if ans = 2 then
        wscript.quit
    end if
end function
 
function echo_autodismiss_function(message)
    set wshShell = CreateObject("WScript.Shell")
    popup = WshShell.Popup(message, 5, "Wait, I dismiss myself:", 0)
end function

'This only works with cscript.exe, not wscript.exe see
'http://stackoverflow.com/questions/774319/why-does-this-vbscript-give-me-an-error 
function console_function(message) 
    wscript.stdout.write(message)
    wscript.stdout.writeblanklines(1)
end function
 
function func_with_break(f)
    if f < 2 then
        func_with_break = "a less than 2"
        exit function
    else
        func_with_break = "a greater than 2"
        exit function
    end if
end function
 
function powerof(e)
    powerof = e * e
end function
 
msgbox_function("I'm a function")
 
msgbox_function(func_with_break(2))
 
msgbox_function(powerof(3))
 
a = 6
if a < 2 then
    msgbox_function("a less than 2")
    call echo_autodismiss_function("a equals " & a)
else
    msgbox_function("a greater than 2")
    call echo_autodismiss_function("a equals " & a)
end if
 
 
function whatami(avar)
    on error resume next
    dim val
    val = vartype(avar)
    set descs = CreateObject("Scripting.Dictionary")
    descs.add 0, "Empty (uninitialized)"
    descs.add 1, "Null (no valid data)"
    descs.add 2, "Integer"
    descs.add 3, "Long integer"
    descs.add 4, "Single-precision floating-point number"
    descs.add 5, "Double-precision floating-point number"
    descs.add 6, "Currency"
    descs.add 7, "Date"
    descs.add 8, "String"
    descs.add 9, "Automation object"
    descs.add 10, "Error"
    descs.add 11, "Boolean"
    descs.add 12, "Variant (used only with arrays of Variants)"
    descs.add 13, "A data-access object"
    descs.add 17, "Byte"
    descs.add 20, "LongLong integer (64 bit)"
    descs.add 8192, "Array"
    descs.add 8204, "Array + Variant"
    whatami = descs.item(val)
end function 'type
 
dim ary : ary = Array("foo", "bar")
set dic = CreateObject("Scripting.Dictionary")
msgbox_quit_function(whatami(ary))
msgbox_quit_function(whatami(dic))
msgbox_quit_function(whatami(42314.4123412341234))
msgbox_quit_function(whatami(42314))
msgbox_quit_function(whatami(4))
msgbox_quit_function(whatami("4"))

dim myarray : myarray = Array("foo", "bar", "foobar", "foo", "barbar", "foofoo") 'doesnt have .count() method
msgbox_quit_function("myarray has " & (ubound(myarray) - lbound(myarray) + 1) & " elements")
 
 
dynlist = Array("foo", "bar", "foobar", "foo", "barbar", "foofoo", "barfoo")
msgbox_function join(dynlist, "-")
for each i in dynlist
    if i = "bar" then
        msgbox_function(i)
    end if
next
 
ary = Array("A", "B", "C", "D", "E")
 
msgbox(LBound(ary))
msgbox(UBound(ary))
 
for i = 0 to UBound(ary)
    msgbox(i)
next
 
 
function indexof(arr, elem)
    'Array() doesn't have .indexOf in VBS, this puts it there, courtesy of https://gist.github.com/sholsinger/943116
    on error resume next
    dim x: x = -1
    dim i
    if isarray(arr) then
        for i = 0 to ubound(arr)
            if arr(i) = elem then
                x = i
                'exit for
            end if
        next
    end if
     
    err.clear()
    indexof = x
end function
 
 
list = Array("apple","Orange","Grapes")
for each i in list
    msgbox_quit_function("element " & indexof(list, (i)) & " in list is: " & i)
next

' http://www.robvanderwoude.com/vbstech_data_arraylist.php
set list = CreateObject("System.Collections.ArrayList")

for i = 0 to 5
    list.add "item: " & i
next

size = list.count()
echo_function("list size is " & size)
echo_function("list element three is " & list(3))
msgbox_quit_function("list element three is " & list(3))

for each element in list
    console_function(element)
next

if list.contains("item: 4") then
    msgbox("VARRRRRRRRRRRRRRRRRRRR")
end if

set myArray = CreateObject("System.Collections.ArrayList")
with myArray
  .Add "Dog"
  .Add "Cat"
  .Add "Fish"
end with

index = myArray.indexof("Cat",0)
msgbox_function index
 
 
set list = CreateObject("System.Collections.ArrayList")
list.add "item: "
list.add "serceg"
list.add "2"
size = list.count()
msgbox_function(size)
 
 
set dynlist2 = CreateObject("System.Collections.ArrayList") 'has .count() method
for each i in array("foo", "bar", "foobar", "foo", "barbar", "foofoo", "barfoo")
    dynlist2.add(i)
next
size2 = dynlist2.count()
msgbox_function(size2)
 
 
set list = CreateObject("System.Collections.ArrayList")
list.add "Banana"
list.add "Apple"
list.add "Pear"
 
list.sort
list.reverse
 
msgbox_quit_function list.count
msgbox_quit_function list.item(0)
msgbox_quit_function list.indexof("Apple", 0)
msgbox_quit_function join(list.toarray(), ", ")

'http://www.robvanderwoude.com/vbstech_data_sortedlist.php
set slist = CreateObject("System.Collections.Sortedlist")
slist.add "First", "1"
slist.add "Second", "2"
slist.add "Third", "3"
slist.add "Fourth", "4"
slist.add "Fifth", "5"

msgbox_function "slist size: " & slist.capacity
msgbox_function "slist contains: " & slist.count
 
str = ""
for i = 0 to slist.count - 1
    'msgbox_function slist.getkey(i) & " " & slist.getbyindex(i)
    str = str & slist.getkey(i) & " " & slist.getbyindex(i) & vbcrlf
next
msgbox_function str

slist.removeat 4
msgbox_function "slist contains: " & slist.count
 
str = ""
for i = 0 to slist.count - 1
    str = str & slist.getkey(i) & " " & slist.getbyindex(i) & vbcrlf
next

msgbox_function str

slist.clear
msgbox_function "slist contains: " & slist.count

set hash = CreateObject("System.Collections.Hashtable")
hash.add "Andrew", "757-9999"
hash.add "Jennifer", "777-7777"
hash.add "John","888-8888"
hash.add "Daniel","999-9999"
msgbox_function(hash("John"))
hash.remove "John"
msgbox_function(hash("John")) 'null
msgbox_modal_function("Daniel's number: " & hash.item("Daniel"))

' http://windowsitpro.com/scripting/understanding-vbscript-dictionary-object-alternative-arrays
' http://www.snb-vba.eu/VBA_Dictionary_en.html
set dict = CreateObject("Scripting.Dictionary")
dict.add "Italy", "Rome"
dict.add "Germany", "Berlin"
dict.add 1, "Venice"
dict.add 2, "Munchen"
 
msgbox_function "dict has " & dict.count & " items"
 
if dict.exists(1) then
    msgbox_function dict.item("Germany")
end if
 
msgbox_function dict.item("Italy")
msgbox_function dict("Italy") 'item is optional
 
dict.item("Italy") = "Johannesburg" 'update with new value
 
for each elem in dict
    msgbox_function elem & " - "  & dict(elem)
next
 
msgbox_function dict.items()(0) 'index based
 
dict.remove ("Italy")
dict.remove dict.keys()(1)
dict.removeall
echo_autodismiss_function "dict has " & dict.count & " items"

with CreateObject("scripting.dictionary")
    .item("first") = Date
    x = .item("first")
    echo_autodismiss_function .item("first")
    .item("first") = "new"
    echo_autodismiss_function .item("first")
    .add "last", "content"
    echo_autodismiss_function .item("last")
end with
 
echo_autodismiss_function x

set dictA = CreateObject("Scripting.Dictionary")
dictA.add "PRSIF01", Array("N", "N")
dictA.add "DECIF01", Array("2", "3")
dictA.add "VDPIF01", Array("4", "N")
 
printDictWithArrayElements(dictA)
msgbox dictA.keys()(0)
msgbox join(dictA.item("PRSIF01"))
msgbox dictA.item("PRSIF01")(0)
msgbox dictA.item("DECIF01")(1)
dictA.item("DECIF01") = Array("2", "4") 'can't update one element in the array http://stackoverflow.com/a/15097463/3355860
msgbox dictA.item("DECIF01")(1)
printDictWithArrayElements(dictA)
 
function printDictWithArrayElements(dictA)
    set s = CreateObject("System.Text.StringBuilder")
    for each elem in dictA
        s.Append_3(elem).Append_3(" - ").Append_3(join(dictA(elem))).Append_3(vbNewLine) 'note the join for the array
    next
    msgbox(s.toString)
end function

'TODO:
'System.Collections.Queue
'System.Collections.Stack
'System.IO.StringWriter
'System.IO.MemoryStream;

'Substring
number = "01110"
firstTwo = Mid(number, 1, 2) 'starts at 1, count 2
msgbox cint(firstTwo)

sentence = "A man, a plan, a canal, panama."
ary = split(sentence," ")
echo_autodismiss_function replace(ary(1), ",", "")

'http://stackoverflow.com/a/11855191/3355860
set s = CreateObject("System.Text.StringBuilder")
for each elem in dict
    s.Append_3(elem).Append_3(" - ").Append_3(dict(elem)).Append_3(vbNewLine)
next
echo_autodismiss_function s.ToString()

max=99999
min=10000
Randomize
 
msgbox (Int((max-min+1)*Rnd+min))

function randomString( byval strLen )
    const LETTERS = "abcdefghijklmnopqrstuvwxyz0123456789"
    min = 1
    max = Len(LETTERS)
 
    Randomize
    for i = 1 to strLen
        str = str & Mid( LETTERS, Int((max-min+1)*Rnd+min), 1 )
    next
    RandomString = str
end function
 
msgbox (randomString(10))

haystack = "This is the Hectic System (Version 8.24.18) @127.0.0.1 - User: blablabla : Interface Generator (Version 8.24.18)"
 
set regex = new RegExp
 
with regex
    .Pattern = "Hectic System \(Version (\d)+\.(\d)+\.(\d)+\)"
    .IgnoreCase = True
    .Global = True
end with
 
set needle = regex.Execute(haystack)
 
msgbox(needle.Item(0))

set fileobject = CreateObject("Scripting.FileSystemObject")
set file = fileobject.OpenTextFile("Test.xml", 1)
content = file.readall
echo_autodismiss_function content
file.close

set fileobject = CreateObject("Scripting.FileSystemObject")
set file = fileobject.CreateTextFile("outfile.txt",True)
file.write "test string" & vbCrLf
file.close

set objDoc = CreateObject("MSXML.DOMDocument")
objDoc.Load "Test.xml"
 
'Iterate over all elements contained in the  element:
set objRoot = objDoc.documentElement
s = ""
t = ""
for each child in objRoot.childNodes
   s = s & child.getAttribute("name") & " "
   t = t & child.getAttribute("value") & " "
next
msgbox s    ' Displays "alpha beta gamma "
msgbox t    ' Displays "1 2 3 "

set objNode = objDoc.selectSingleNode("/root/property[@name='beta']")
msgbox objNode.getAttribute("value")     ' Displays 2

set objDoc = CreateObject("Microsoft.XMLDOM")
objDoc.async = False
objDoc.Load "Untitled1.xml"
 
set objNode = objDoc.documentElement.selectSingleNode("/corpReturn:CorporateIncomeTaxReturn/corpReturn:WizardInfo/corpReturn:GrossIncomeAmt")
console_function objNode.text
 
set objNode = objDoc.documentElement.selectNodes("/corpReturn:CorporateIncomeTaxReturn/corpReturn:WizardInfo/corpReturn:GrossIncomeAmt")
for each Row in objNode
    console_function  Row.text
next
 
set objNode = objDoc.documentElement.selectNodes("/corpReturn:CorporateIncomeTaxReturn/corpReturn:WizardInfo")
for each Row in objNode
    console_function(Row.nodeName & " : " & Row.text & "\n")
next

server = "linuxbox"
user = "test"
pass = "test"
DBName = "test"
set dbConn = CreateObject("ADODB.Connection")
dbConn.ConnectionString = "Driver={MySQL ODBC 5.1 ANSI Driver};server=" & server & ";uid=" & user & ";pwd=" & pass & ";database=" & DBName & ";Option=3;"
dbConn.Open

testdate = "2015-11-01"
set objRecordset = dbConn.Execute("SELECT Lastname FROM Persons WHERE PersonID = 1;")
if(objRecordset.BOF AND objRecordset.EOF) then
    msgbox "No records returned"
elseif vartype(objRecordset.Fields("Lastname").Value) = 1 then 'Null
    msgbox "No records returned"
else
    res = objRecordset.Fields("Lastname").Value
    echo_autodismiss_function res
end if

set objRecordset = dbConn.Execute("SELECT Lastname FROM Persons;")
while not objRecordset.EOF
 lastname = objRecordset.Fields("Lastname").Value
 msgbox lastname
 objRecordset.MoveNext
wend

dbConn.Execute("UPDATE Persons SET City = 'Berlin' WHERE PersonID = 1;")

dbConn.Close

'TODO: this needs work
surl="http://linuxbox:8080/EAR/services/myService?wsdl"
srequest="saying=Hi"
 
'assumed msxml2 core service well installed
set oxmlhttp=createobject("msxml2.xmlhttp")
with oxmlhttp
    .open "post",surl,false
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send srequest
end with
 
set oparser=createobject("msxml2.domdocument")
oparser.loadXML oxmlhttp.responseXML.documentElement.text
 
set oroot=oparser.documentElement
wscript.echo oxmlhttp.responseXML.documentElement.text
 
set oroot=nothing
set oparser=nothing
set oxmlhttp=nothing