Some Basic Useful re-usable Scripts in QTP

General Functions which might be useful in the projects:-

Array Basics
Some basic info about creating and using arrays.
' The easiest way create an array is to simply declare it as follows
Dim strCustomers()
' Another method is to define a variable and then set it as an array afterwards
Dim strStaff
strStaff = Array("Alan","Brian","Chris")
' Yet another way is to use the split command to create and populate the array
Dim strProductArray
strProductArray = "Keyboards,Laptops,Monitors"
strProductArray = Split(strProductArray, ",")
' To itterate through the contents of an array you can use the For Each loop
Dim strItem
For Each strItem In strProductArray
MsgBox strItem
Next
' This will also itterate through the loop
Dim intCount
For intCount = LBound(strProductArray) To UBound(strProductArray)
Msgbox strProductArray(intCount)
Next
' This will itterate through the array backwards
For intCount = UBound(strProductArray) To LBound(strProductArray) Step -1
Msgbox strProductArray(intCount)
Next
' To add extra data to an array use Redim Preserve
Redim Preserve strProductArray(3)
strProductArray(3) = "Mice"
' To store the contents of an array into one string, use Join
Msgbox Join(strProductArray, ",")
' To delete the contents of an array, use the Erase command
Erase strProductArray
Date Manipulation Examples
Some date manipulation functions.

' show todays date
MsgBox Date

' show the time
MsgBox Time

' show both the date and time
MsgBoxNow

' calculate the minimum Date of Birth for someone who is 18 years old
strMinDoB = DateAdd("yyyy", -18, Date)
MsgBox strMinDob

' show the number of years difference between strMinDob and today
MsgBox DateDiff("yyyy", strMinDob, Date)

' show the hour portion of the time
MsgBox DatePart("h", Time)

' show the day portion of the date
MsgBox Day(strMinDob)

' show the month portion of the date
MsgBox Month(strMinDob)

' show the year portion of the date
MsgBox Year(strMinDob)

' show the weekday portion of the date
' Sunday=1, Monday=2, --> Saturday=7
MsgBox WeekDay(strMinDob)



Note: Acceptable 'Interval' parameters for DatePart, DateAdd and DateDiff...

"yyyy" = Year
"q" = Quarter
"m" = Month
"y" = Day of year
"d" = Day
"w" = Weekday
"ww" = Week of year
"h" = Hour
"n" = Minute
"s" = Second

Get Child Obects
Find all checkboxes on a webpage.
Here's a basic example that will find and tick all of the checkboxes on the QTP Helper login screen.
Dim objDescription
Dim objCheckBoxes
Dim iCount

' create description objects used to locate check boxes
Set objDescription = Description.Create()

' set the object properties so it looks only for web check boxes
objDescription("micclass").Value = "WebCheckBox"

' check that the user isn't already logged in
If Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Exist(1) Then

' click logout
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Click

End If

' get the check boxes from the page
Set objCheckBoxes = Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").ChildObjects(objDescription)

' for each check box found
For iCount = 0 to objCheckBoxes.Count - 1

' tick the check box
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebCheckBox(objCheckBoxes(iCount)).Set "ON"

Next


Compare Arrays
Compare the contents of two arrays.
' Example usage
sA = Array("A", "B", "D")
sB = Array("A", "C", "B")

MsgBox CompareArrays(sA, sB)
' =============================================================
' function: CompareArrays
' desc : Compares the content of two arrays and checks that
' they each contain the same data, even if in a
' different order
' params : arrArray1 is the base array
' arrArray2 is the array to compare
' returns : True if they contain same data, False otherwise
' =============================================================
Function CompareArrays(arrArray1, arrArray2)

Dim intA1
Dim intA2
Dim blnMatched

' check that the arrays are the same size
If UBound(arrArray1) <> UBound(arrArray2) then

' arrays are different size, so return false and exit function
CompareArrays = False
Exit Function

End if

' for each element in the first array
For intA1 = LBound(arrArray1) to UBound(arrArray1)

' initialise this to false
blnMatched = False

' for each element in the second array
For intA2 = LBound(arrArray2) to UBound(arrArray2)

' compare the content of the two arrays
If arrArray1 (intA1) = arrArray2 (intA2) Then
blnMatched = True
Exit For
End If

Next ' next element in second array

' if the element was not found in array two, return false and exit function
If Not blnMatched then
CompareArrays = False
Exit Function
End If

Next ' next element in first array

' if the function got this far, then the arrays contain the same data
CompareArrays = True

End Function ' CompareArrays


Custom Report Entry
Creating a customised entry in the results.

' Example usage
CustomReportEntry micFail, "Custom Report Example", "

This is a custom report entry!

"

' =============================================================
' function: CustomReportEntry
' desc : Creates a customized entry in the result file, you
' can use standard HTML tags in the message.
' params : strStatus is the result, micPass, micFail etc
' strStepName is the name of the step
' strMessage is the failure message, this can contain
' html tags
' returns : Void
' =============================================================
Function CustomReportEntry(strStatus, strStepName, strMessage)

' create a dictionary object
Set objDict = CreateObject("Scripting.Dictionary")

' set the object properties
objDict("Status") = strStatus
objDict("PlainTextNodeName") = strStepName
objDict("StepHtmlInfo") = strMessage
objDict("DllIconIndex") = 206
objDict("DllIconSelIndex") = 206
objDict("DllPAth") = "C:\Program Files\Mercury Interactive\QuickTest Professional\bin\ContextManager.dll"

' report the custom entry
Reporter.LogEvent "User", objDict, Reporter.GetContext

End Function 'CustomReportEntry









Bcreating Custom Libraries
An example of how to create your own custom library.
This example will show you how to create your own customised code
library, using Visual Basic 6 as an example.

First thing to do is open Visual Basic and create a new Active X DLL project...


Before we add any code, we should give the Project and the Class Library sensible names.

Here I've called the project "QTP"...


For the Class Library I've simply called it "Library"...


Now we can add a function to our Library. For this example I'm going to use a very
basic function which will simply display a message box with a given parameter value...



Next thing we need to do is create the DLL, this can be done from the File menu in Visual Basic...


Note that during the development of the DLL, you can simply press F5 to run the code in Visual
Basic. We can then still call the function from QTP, this allows us to put break-points inside
the Visual Basic code and do some debugging.

Another thing to note is that when you finish the DLL and want to use it on other machines,
you will need to register the DLL on the system. This can be done by simply dragging and dropping
the DLL onto the file "RegSvr32.exe", which can be found in your Windows\System32 folder.

Now that we have our new library ready, we can call the functions from QTP...


Dim objDLL

' create an object for our new library
Set objDLL = CreateObject("QTP.Library")

' call the function from the library
objDLL.QTPHelper_Example "Easy!"

' destroy the object
Set objDLL = Nothing


And here is the end result...


Using methods like this will open up several new doors for your automation by allowing you to
execute code which isn't as easy to implement in VB Script as it is in other languages.



Running DOS Commands
Running Dos Commands

' =============================================================
' Sub : ExecuteDosCommand
' desc : Run a single-line DOS command
' params : Command to run
' returns : void
' =============================================================
Sub ExecuteDosCommand(strCommand)

Dim objShell

' create the shell object
Set objShell = CreateObject("WSCript.shell")

' run the command
objShell.run strCommand

' destroy the object
Set objShell = Nothing

End Sub 'ExecuteDosCommand



Export Data Sheet
Export a data sheet at runtime.
' =============================================================
' function: ExportDataSheet
' desc : Exports a data sheet
' params : strFile - full path to save the exported xls, note
' that any existing xls will be deleted
' strSheet - sheet to export
' returns : void
' =============================================================
Function ExportDataSheet(strFile, strSheet)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the xls doesn't already exist
If objFS.FileExists(strFile) Then
' delete it if it exists
ObjFS.DeleteFile strFile

End If
' export the data table
DataTable.ExportSheet strFile, strSheet
' destroy the object
Set objFS = Nothing
End Function 'ExportDataSheet


Execute a Stored Procedure
Some code that should help you execute a stored procedure.

' set the parameters of your database here
strDatabaseName = ""
strUser = ""
strPassword = ""
strStoredProcedureName = ""

' create the database object
Set objDB = CreateObject("ADODB.Command")
' set the connection string
objDB.ActiveConnection = "DRIVER={Microsoft ODBC for Oracle}; " & _
"SERVER=" & strDatabaseName & _
";User ID=" & strUser & ";Password=" & strPassword & " ;"

' set the command type to Stored Procedures
objDB.CommandType = 4
objDB.CommandText = strStoredProcedureName

' define Parameters for the stored procedure
objDB.Parameters.Refresh
' set parameters for stored procedure (i.e. two parameters here)
objDB.Parameters(0).Value = "Param1"
objDB.Parameters(1).Value = "Param2"

' execute the stored procedure
objDB.Execute()
' destroy the object
Set objDB = Nothing

Execute Method In Regular Expressions
Executing a regular expression to find text within a string.

MsgBox RegularExpExample("QTP.", "QTP1 QTP2 qtp3 QTP4")

' =============================================================
' function: RegularExpExample
' desc : Example of how to use the regular expression object
' to find text within a string
' params : strPattern is the regular expression
' strString is the string to use the expression on
' returns : An example string showing the results of the search
' =============================================================
Function RegularExpExample(strPattern, strString)

Dim objRegEx, strMatch, strMatches
Dim strRet

' create regular expression object
Set objRegEx = New RegExp

' set the pattern
objRegEx.Pattern = strPattern

' set it be not case sensitive
objRegEx.IgnoreCase = True

' set global flag so we search all of the string, instead of just searching
' for the first occurrence
objRegEx.Global = True

' execute search
Set strMatches = objRegEx.Execute(strString)

' for each match
For Each strMatch in strMatches

strRet = strRet & "Match found at position '" & _
strMatch.FirstIndex & "' - Matched Value is '" & _
strMatch.Value & "'" & vbCRLF

Next

RegularExpExample = strRet

End Function ' RegularExpExample



Export Data Table
Export a data table at runtime.
' =============================================================
' function: ExportDataTable
' desc : Exports a data table
' params : strFile - full path to save the exported xls, note
' that any existing xls will be deleted
' returns : void
' =============================================================
Function ExportDataTable(strFile)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the xls doesn't already exist
If objFS.FileExists(strFile) Then
' delete it if it exists
ObjFS.DeleteFile strFile

End If
' export the data table
DataTable.Export strFile
' destroy the object
Set objFS = Nothing
End Function 'ExportDataTable
Export Data Sheet
Export a data sheet at runtime.
' =============================================================
' function: ExportDataSheet
' desc : Exports a data sheet
' params : strFile - full path to save the exported xls, note
' that any existing xls will be deleted
' strSheet - sheet to export
' returns : void
' =============================================================
Function ExportDataSheet(strFile, strSheet)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the xls doesn't already exist
If objFS.FileExists(strFile) Then
' delete it if it exists
ObjFS.DeleteFile strFile

End If
' export the data table
DataTable.ExportSheet strFile, strSheet
' destroy the object
Set objFS = Nothing
End Function 'ExportDataShee

Read From Excel File
Read all the data from an Excel file.

' =============================================================
' function: ReadXLS
' desc : Reads a sheet from an XLS file and stores the content
' in a multi-dimensional array
' params : strFileName is XLS file to read, including path
' strSheetName is the name of the sheet to read, i.e "Sheet1"
' returns : Multi-dimensional array containing all data from
' the XLS
' =============================================================
Function ReadXLS(strFileName,strSheetName)

Dim strData()
Dim objFS, objExcel, objSheet, objRange
Dim intTotalRow, intTotalCol
Dim intRow, intCol

' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' ensure that the xls file exists
If Not objFS.FileExists(strFileName) Then

' issue a fail if the file wasn't found
Reporter.ReportEvent micFail, "Read XLS", "Unable to read XLS file, file not found: " & strFileName
' file wasn't found, so exit the function
Exit Function

End If ' file exists

' create the excel object
Set objExcel = CreateObject("Excel.Application")

' open the file
objExcel.Workbooks.open strFileName

' select the worksheet
Set objSheet = objExcel.ActiveWorkbook.Worksheets(strSheetName)

' select the used range
Set objRange = objSheet.UsedRange

' count the number of rows
intTotalRow=CInt(Split(objRange.Address, "$")(4)) - 1

' count the number of columns
intTotalCol= objSheet.Range("A1").CurrentRegion.Columns.Count

' redimension the multi-dimensional array to accomodate each row and column
ReDim strData(intTotalRow, intTotalCol)

' for each row
For intRow = 0 to intTotalRow - 1

' for each column
For intCol =0 to intTotalCol - 1

' store the data from the cell in the array
strData(intRow, intcol) = Trim(objSheet.Cells(intRow + 2,intcol + 1).Value)

Next ' column

Next ' row

' close the excel object
objExcel.DisplayAlerts = False
objExcel.Quit

' destroy the other objects
Set objFS = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

' return the array containing the data
ReadXLS = strData

End Function ' ReadXLS

File Browser
Opens a standard dialog which allows the user to choose a file.
' =============================================================
' function : FileBrowser
' desc : Opens a standard Open File Dialog
' params : strTitle - the title to apply to the dialog
' strFilter - the filter to apply to the dialog
' returns : The selected file, including path
' =============================================================
Public Function FileBrowser(strTitle, strFilter)

Dim objDialog
' create a common dialog object
Set objDialog = CreateObject("MSComDlg.CommonDialog")
' set the properties and display the dialog
With objDialog
.DialogTitle = strTitle
.Filter = strFilter
.MaxFileSize = 260
.ShowOpen
End With
' return the selected file
FileBrowser = objDialog.FileName
' destroy the object
Set objDialog = Nothing

End Function ' FileBrowser
File Exists
Check to see if a local or network file exists.
' =============================================================
' function: CheckFileExists
' desc : Checks to see if a file exists
' params : strFile - full path of the file to find
' returns : True if file exists, False otherwise
' =============================================================
Function CheckFileExists(strFile)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source file exists
If objFS.FileExists(strFile) Then
' file exists, return true
CheckFileExists = True

Else

' file exists, return false
CheckFileExists = False

End If

End Function 'CheckFileExists


Folder Exists
Check to see if a local or network folder exists.
' =============================================================
' function: CheckFolderExists
' desc : Checks to see if a folder exists
' params : strFolder - full path of the folder to find
' returns : True if folder exists, False otherwise
' =============================================================
Function CheckFolderExists(strFile)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source file exists
If objFS.FolderExists(strFolder) Then
' file exists, return true
CheckFolderExists = True

Else

' file exists, return false
CheckFolderExists = False

End If
' destroy the object
Set objFS = Nothing

End Function 'CheckFolderExists


Create Folder
Create a local or network folder.
' =============================================================
' function: FolderCreate
' desc : Creates a folder
' params : strFolderPath - the folder to create (full path)
' returns : void
' =============================================================
Function FolderCreate(strFolderPath)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' create the folder
If Not objFS.FolderExists(strFolderPath) Then
objFS.CreateFolder strFolderPath
End If
' destroy the object
Set objFS = Nothing

End Function 'FolderCreate


Delete Folder
Delete a local or network folder.
' =============================================================
' function: FolderDelete
' desc : Deletes a folder and all of it's contents
' params : strFolder - the folder to delete
' returns : void
' =============================================================

Function FolderDelete(strFolder)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source folder exists
If Not objFS.FolderExists(strFolder) Then
' fail if the source does not exist
reporter.ReportEvent micFail, "Delete Folder", "Unable to Delete Folder '"& strFolder &"', It Does Not Exist"
Else
' delete the folder
objFS.DeleteFolder strFolder

End If
' destroy the object
Set objFS = Nothing

End Function 'FolderDelete
Move Folder
Move a local or network folder.
' =============================================================
' function: FolderMove
' desc : Moves a folder and all of its files to a new path
' params : strSourceFolder - the folder to copy
' strDestinationFolder - the location to copy to
' returns : void
' =============================================================
Function FolderMove(strSourceFolder, strDestinationFolder)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source folder exists
If Not objFS.FolderExists(strSourceFolder) Then
' fail if the source does not exist
reporter.ReportEvent micFail, "Move Folder", "Source Folder '"& strSourceFolder &"' Does Not Exist"
Else
' check that the destination folder doesn't already exist
If Not objFS.FolderExists(strDestinationFolder) Then

' move the folder
objFS.MoveFolder strSourceFolder, strDestinationFolder
Else
' fail if the target folder was already in place
reporter.ReportEvent micFail, "Move Folder", "Unable to Move Folder as the Target '" & strDestinationFolder & "' Already Exists"

End If

End If
' destroy the object
Set objFS = Nothing

End Function 'FolderMove
Copy Folder
Copy a local or network folder.
' =============================================================
' function: FolderCopy
' desc : Copys a folder and all of its files to a new path
' params : strSourceFolder - the folder to copy
' strDestinationFolder - the location to copy to
' returns : void
' =============================================================

Function FolderCopy(strSourceFolder, strDestinationFolder)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source folder exists
If Not objFS.FolderExists(strSourceFolder) Then
' fail if the source does not exist
reporter.ReportEvent micFail, "Copy Folder", "Source Folder '"& strSourceFolder &"' Does Not Exist"
Else
' create the destination folder if it doesn't already exist
If Not objFS.FolderExists(strDestinationFolder) Then
objFS.CreateFolder(strDestinationFolder)
End If
' copy the folder
objFS.CopyFolder strSourceFolder, strDestinationFolder

End If
' destroy the object
Set objFS = Nothing

End Function 'FolderCopy
Folder Exists
Check to see if a local or network folder exists.
' =============================================================
' function: CheckFolderExists
' desc : Checks to see if a folder exists
' params : strFolder - full path of the folder to find
' returns : True if folder exists, False otherwise
' =============================================================
Function CheckFolderExists(strFile)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source file exists
If objFS.FolderExists(strFolder) Then
' file exists, return true
CheckFolderExists = True

Else

' file exists, return false
CheckFolderExists = False

End If
' destroy the object
Set objFS = Nothing

End Function 'CheckFolderExists
Read a Text File
Example of how to read a text file line-by-line.

' reading a file line by line

Const ForReading = 1

' create file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' first check that the file exists
If objFS.FileExists("c:\TextFile.txt") Then

' open the text file for reading
Set objFile = objFS.OpenTextFile("c:\TextFile.txt", ForReading, False)

' do until at end of file
Do Until objFile.AtEndOfStream

' store the value of the current line in the file
strLine = objFile.ReadLine

' show the line from the file
MsgBox strLine

Loop ' next line

' close the file
objFile.Close

Set objFile = Nothing

Else ' file doesn't exist

' report a failure
Reporter.ReportEvent micFail, "Read File", "File not found"

End if ' file exists

' destroy the objects
Set objFS = Nothing


Write to a File
Example of how to write text to a file.

' =============================================================
' function: AppendFile
' desc : Writes a line of text to a text file, text file is
' created if it doesn't already exist
' params : strFileName is the name of the file to write to
' strLine is the text to write to the file
' returns : void
' =============================================================
Function AppendFile(strFileName, strLine)

Dim objFS

Const ForAppending = 8

' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' open/create the text file
Set objFile = objFS.OpenTextFile(strFilename, ForAppending, True)

' write the line
objFile.WriteLine strLine

' close the file
objFile.Close

End Function ' AppendFile


Get Temporary File Name
Generate a unique temporary file name.
' =============================================================
' function: GetTemporaryFileName
' desc : Generates a unique file name in the windows
' temporary folder
' params : none
' returns : A unique temporary file, including path
' =============================================================
Function GetTemporaryFileName
Const TemporaryFolder = 2
Dim objFS
Dim objTempFolder
' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' get the path to the temporary folder
Set objTempFolder = objFS.GetSpecialFolder(TemporaryFolder)
' return the path plus a unique temporary file name
GetTemporaryFileName = objTempFolder.Path & "\" & objFS.GetTempName
' destroy the object
Set objFS = Nothing
Set objTempFolder = Nothing
End Function 'GetTemporaryFileName
Create Unique File Name
Create a unique file name.

' =============================================================
' function: UniqueFileName
' desc : Creates a unique file name
' params : strType - file extension
' returns : unique file name of specified type
' =============================================================
Function UniqueFileName(strType)

dim strReturn

' make sure there is a dot before the type
If left(strType,1) <> "." then strType = "." & strType

' create the file name using the date & time, and remove the / and : chars
strReturn = day(date) & month(date) & year(date) & hour(time) & minute(time) & second(time) & strType

' return the file name
UniqueFileName = strReturn

End Function 'UniqueFileName


Compare Files
Compare the contents of two text files.

' =============================================================
' function: CompareFiles
' desc : Compares two text files
' params : strFile1 is the first file
' strFile2 is the second file
' returns : True if they are the same, False otherwise
' =============================================================
Function CompareFiles(strFile1, strFile2)

Dim objFS
Dim objFileA, objFileB
Dim strLineA, strLineB
dim intCompareResult

' create a file scripting object
Set objFS = CreateObject("Scripting.FileSystemObject")

' open each of the files for reading
Set objFileA = objFS.OpenTextFile(strFile1, 1)
Set objFileB = objFS.OpenTextFile(strFile2, 1)

' repeat the following until we hit the end of one of the files
Do While ((objFileA.AtEndOfStream <> True) OR (objFileB.AtEndOfStream <> True))

' read the next line from both files
strLineA = objFileA.ReadLine
strLineB = objFileB.ReadLine

' perform a comparison on the line from each file
intCompareResult = StrComp(strLineA,strLineB,0)

' if the value of the comparison is not 0, lines are different
If (intCompareResult <> 0) Then

' found a difference in the files, so close them both
objFileA.Close
objFileB.Close

' destroy the object
Set objFS = Nothing

' return false
CompareFiles = False

' exit the function
Exit Function

End If ' if different

Loop ' until end of file

' close both files
objFileA.Close
objFileB.Close

' destroy the object
Set objFS = Nothing

' if function got this far, means files are the same, so return True
CompareFiles = True

End Function 'CompareFiles

Create Desktop Shortcut
Create a shortcut on the desktop.

' =============================================================
' function: CreateDesktopShortcut
' desc : Creates a shortcut on the desktop
' params : strTargetPath is the full path to the file you
' are creating the shortcut to, i.e. c:\doc\me.txt
' strLinkName is the name of the shortcut, as it
' appears on the desktop
' strDesc is the description to set within the shortcut
' returns : void
' =============================================================
Sub CreateDesktopShortcut(strTargetPath, strLinkName, strDesc)

Dim objShell, objShortCut
Dim strDesktopFolder

' ensure that the link name is valid
if Right(Lcase(strLinkName,4)) <> ".lnk" Then strLinkName = strLinkName & ".lnk"

' create a shell object
Set objShell = CreateObject("WScript.Shell")

' get the desktop folder
strDesktopFolder = objShell.SpecialFolders("AllUsersDesktop")

' create required shortcut object on the desktop
Set objShortCut = objShell.CreateShortcut(strDesktopFolder & "\" & strLinkName)

' set the path within the shortcut
objShortCut.TargetPath = strTargetPath

' set the description
objShortCut.Description = strDesc

' save the shortcut
objShortCut.Save

End Sub ' CreateDesktopShortcut


Read From Excel File
Read all the data from an Excel file.

' =============================================================
' function: ReadXLS
' desc : Reads a sheet from an XLS file and stores the content
' in a multi-dimensional array
' params : strFileName is XLS file to read, including path
' strSheetName is the name of the sheet to read, i.e "Sheet1"
' returns : Multi-dimensional array containing all data from
' the XLS
' =============================================================
Function ReadXLS(strFileName,strSheetName)

Dim strData()
Dim objFS, objExcel, objSheet, objRange
Dim intTotalRow, intTotalCol
Dim intRow, intCol

' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' ensure that the xls file exists
If Not objFS.FileExists(strFileName) Then

' issue a fail if the file wasn't found
Reporter.ReportEvent micFail, "Read XLS", "Unable to read XLS file, file not found: " & strFileName
' file wasn't found, so exit the function
Exit Function

End If ' file exists

' create the excel object
Set objExcel = CreateObject("Excel.Application")

' open the file
objExcel.Workbooks.open strFileName

' select the worksheet
Set objSheet = objExcel.ActiveWorkbook.Worksheets(strSheetName)

' select the used range
Set objRange = objSheet.UsedRange

' count the number of rows
intTotalRow=CInt(Split(objRange.Address, "$")(4)) - 1

' count the number of columns
intTotalCol= objSheet.Range("A1").CurrentRegion.Columns.Count

' redimension the multi-dimensional array to accomodate each row and column
ReDim strData(intTotalRow, intTotalCol)

' for each row
For intRow = 0 to intTotalRow - 1

' for each column
For intCol =0 to intTotalCol - 1

' store the data from the cell in the array
strData(intRow, intcol) = Trim(objSheet.Cells(intRow + 2,intcol + 1).Value)

Next ' column

Next ' row

' close the excel object
objExcel.DisplayAlerts = False
objExcel.Quit

' destroy the other objects
Set objFS = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

' return the array containing the data
ReadXLS = strData

End Function ' ReadXLS


Get Child Obects
Find all checkboxes on a webpage.
Here's a basic example that will find and tick all of the checkboxes on the QTP Helper login screen.
Dim objDescription
Dim objCheckBoxes
Dim iCount

' create description objects used to locate check boxes
Set objDescription = Description.Create()

' set the object properties so it looks only for web check boxes
objDescription("micclass").Value = "WebCheckBox"

' check that the user isn't already logged in
If Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Exist(1) Then

' click logout
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Click

End If

' get the check boxes from the page
Set objCheckBoxes = Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").ChildObjects(objDescription)

' for each check box found
For iCount = 0 to objCheckBoxes.Count - 1

' tick the check box
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebCheckBox(objCheckBoxes(iCount)).Set "ON"

Next


Get Disk Information
Get information about one of your disk drives.

Dim intSectors, intBytes, intFreeC, intTotalC, intTotal ,intFreeb

' include this windows api
extern.Declare micLong, "GetDiskFreeSpace", "kernel32.dll", "GetDiskFreeSpaceA", micString+micByref, micLong+micByref, micLong+micByref,micLong+micByref,micLong+micByref

' set these values
intSectors = 255
intBytes = 255
intFreeC = 255
intTotalC = 255

' calculate the disk space, using C: in this example
intSpaceAvailable = extern.GetDiskFreeSpace("c:\", intSectors, intBytes, intFreeC, intTotalC)

' calculate the totals
intTotal = intTotalC * intSectors * intBytes
intFreeb = intFreeC * intSectors * intBytes

' show the outputs
msgBox intSectors
msgBox intBytes
msgBox intFreeC
msgBox intTotalC
msgbox intTotal
msgBox intFreeb
Get IP Address
Get your machines IP address.

' =============================================================
' function: GetIPAddress
' desc : Returns the IP address of the PC
' params : Void
' returns : IP Address
' =============================================================
Function GetIPAddress()

' get the ip addresses
Set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")

' for each item in the collection
For Each IPConfig in IPConfigSet

' if the item isn't empty
If Not IsNull(IPConfig.IPAddress) Then

' loop through the addresses
For i = LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)

' set the return alue
ipAddr = IPConfig.IPAddress(i)

Next

End If

Next

' destroy the object
Set IPConfigSet = Nothing

' return the ip
GetIPAddress = ipAddr

End Function ' GetIPAddress

Get System Information
Get system information like User Name and Computer Name.

Dim objNet

' create a network object
Set objNet = CreateObject("WScript.NetWork")

' show the user name
MsgBox "User Name: " & objNet.UserName

' show the computer name
MsgBox "Computer Name: " & objNet.ComputerName

' show the domain name
MsgBox "Domain Name: " & objNet.UserDomain

' destroy the object
Set objNet = Nothing

Get System Variable Value
Get a value from a Windows System Variable.

' for example to get the oracle home path
MsgBox GetSystemVariable("ORACLE_HOME")

' =============================================================
' function: GetSystemVariable
' desc : Get the value of a system variable
' params : strSysVar is the variable name
' returns : Content of variable name
' =============================================================
Function GetSystemVariable(strSysVar)

Dim objWshShell, objWshProcessEnv

' create the shell object
Set objWshShell = CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("Process")

' return the system variable content
GetSystemVariable = objWshProcessEnv(strSysVar)

End Function ' GetSystemVariable

Get Temporary File Name
Generate a unique temporary file name.
' =============================================================
' function: GetTemporaryFileName
' desc : Generates a unique file name in the windows
' temporary folder
' params : none
' returns : A unique temporary file, including path
' =============================================================
Function GetTemporaryFileName
Const TemporaryFolder = 2
Dim objFS
Dim objTempFolder
' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' get the path to the temporary folder
Set objTempFolder = objFS.GetSpecialFolder(TemporaryFolder)
' return the path plus a unique temporary file name
GetTemporaryFileName = objTempFolder.Path & "\" & objFS.GetTempName
' destroy the object
Set objFS = Nothing
Set objTempFolder = Nothing
End Function 'GetTemporaryFileName
Import Data Sheet
Import a data sheet into your test at runtime.
' =============================================================
' function: ImportDataSheet
' desc : Imports a single data sheet
' params : strFile - full path of the xls file with the sheet
' strSource - name of the sheet on the xls
' strTarget - name of the sheet to import it to
' returns : void
' =============================================================
Function ImportDataSheet(strFile, strSource, strTarget)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source file exists
If objFS.FileExists(strFile) Then
' ensure that our target sheet exists
DataTable.AddSheet strTarget
' import the sheet
DataTable.Importsheet strFile, strSource, strTarget
Else
' fail if the xls was not found
Reporter.ReportEvent micFail, "Import Data Table", "Unable to Import Data Table From '" & strFile & "', File Does Not Exist"
End If
' destroy the object
Set objFS = Nothing
End Function 'ImportDataSheet


Import Data Table
Import a data table into your test at runtime.
' =============================================================
' function: ImportDataTable
' desc : Imports a data table
' params : strFile - full path of the xls file to import
' returns : void
' =============================================================
Function ImportDataTable(strFile)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source file exists
If objFS.FileExists(strFile) Then
' import the data table
DataTable.Import strFile
Else
' fail if the xls was not found
Reporter.ReportEvent micFail, "Import Data Table", "Unable to Import Data Table From '" & strFile & "', File Does Not Exist"
End If
' destroy the object
Set objFS = Nothing
End Function 'ImportDataTable


Sending Key Presses (SendKeys)
Examples of how to simulate key presses.
Dim objShell
' Create the shell object
Set objShell = CreateObject ("WSCript.shell")
' Various key press examples
objShell.SendKeys "Hello" ' Hello
objShell.SendKeys "{F4}" ' F4
objShell.SendKeys "^{F4}" ' CTRL-F4
objShell.SendKeys "+{F4}" ' SHIFT-F4
objShell.SendKeys "%{F4}" ' ALT-F4
' Destroy the object
Set objShell = Nothing

Locate Method (Checking text within text)
Using Locate to determine if specific text exists within a string.

MsgBox LocateText("www.QTPHelper.com", "QTP")
MsgBox LocateText("www.QTPHelper.com", "QTP.*.com")

' =============================================================
' function: LocateText
' desc : Uses a regular expression to locate text within a string
' params : strString is the string to perform the search on
' strPattern is the regular expression
' returns : True if the pattern was found, False otherwise
' =============================================================
Function LocateText(strString, strPattern)

Dim objRegEx

' create the regular expression
Set objRegEx = New RegExp

' set the pattern
objRegEx.Pattern = strPattern

' ignore the casing
objRegEx.IgnoreCase = True

' perform the search
LocateText = objRegEx.Test(strString)

' destroy the object
Set objRegEx = Nothing

End Function ' LocateText


Write to a Log File
Write information to a log file.

' =============================================================
' function: WriteLog
' desc : Writes a message to a log file. File is created
' inside a Log folder of the current directory
' params : strCode is a code to prefix the message with
' strMessage is the message to add to the file
' returns : void
' =============================================================
Function WriteLog(strCode, strMessage)

Dim objFS
Dim objFile
Dim objFolder
Dim strFileName

' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' is there a log folder in the directory that we are currently working
If Not objFS.FolderExists(objFS.GetAbsolutePathName(".") & "\log") Then

' if there is no log folder, create one
Set objFolder = objFS.CreateFolder(objFS.GetAbsolutePathName(".") & "\log")

End If ' folder exists

' set a name for the log file using year, month and day values
strFileName = objFS.GetAbsolutePathName(".") & "\log\" & year(date) & month(date) & day(date) & ".log"

' create the log file
Set objFile = objFS.OpenTextFile(strFileName, 8, True)

' in case of any issues writing the file
On Error Resume Next

' write the log entry, include a carriage return
objFile.Write Date & ", " & Time & ", " & strCode & ", " & strMessage & vbcrlf

' disable the on error statement
On Error GoTo 0

' close the log file
objFile.Close

' destrory the object
Set objFS = Nothing

End Function ' WriteLog


Loop Basics
Some basic information about various loop types.
' Loops allow you to run a group of statements repeatidly.
'
' There are four types of loop available, all very easy to
' use and understand. This code sample will explain how
' to use each type of loop.
'

' Do...Loop

' The Do...Loop will run a block of statements repeatidly
' while a condition is True, or until a condition becomes True

' Check these two examples of Do...While, there is one major difference
' between them. In Example A the cose will check the value of intCounter
' before it enters the loop, but in Example B the code will enter the
' loop regardless of the value of intCounter.

' Example A
intCounter = 0
Do While intCounter < 5
intCounter = intCounter + 1
MsgBox intCounter
Loop

' Example B
intCounter = 0
Do
intCounter = intCounter + 1
MsgBox intCounter
Loop While intCounter <5

' Here is the same examples using the Do...Until
' Example A
intCounter = 0
Do Until intCounter = 6
intCounter = intCounter + 1
MsgBox intCounter
Loop

' Example B
intCounter = 0
Do
intCounter = intCounter + 1
MsgBox intCounter
Loop Until intCounter = 6
' For...Next

' For...Next Loops will execute a series of statements until a specific counter value
' is reached.
For iCounter = 1 To 5
MsgBox iCounter
Next

' You can add a Step keyword to define how much the counter should increase with each
' itteration of the loop
For iCounter = 1 To 10 Step 2
MsgBox iCounter
Next

' The Step keyword can also be used to itterate backwards
For iCounter = 5 to 1 Step -1
MsgBox iCounter
Next


' For...Each

' Another variation on the For...Next loop is the For...Each loop. The For...Each
' loop is used to execute a series of statements for each object in a collection,
' i.e. each element of an array. For example...
Dim strPeopleList
Dim strPerson
strPeopleList = Array("Alan", "Bob", "Craig", "Dan")
For Each strPerson in strPeopleList
MsgBox strPerson
Next


' While...Wend Loops
'
' This type of loop will execute a series of statements as long as
' a given condition is true.
' Note: It's advisable to avoid using this type of loop, you should
' us the Do...Loop instead
' Here's an example anyway...
iCounter = 0
While iCounter < 5
iCounter = iCounter + 1
Msgbox iCounter
Wend
Minimize QTP
Minimize the main QTP window.

' =============================================================
' function: MinimizeQTP
' desc : Minimize QTP window
' params : None
' returns : void
' =============================================================
Function MinimizeQTP()

dim objQTP

' create a qtp object
Set objQTP = getObject("","QuickTest.Application")

' set the window state to minimized
objQTP.WindowState = "Minimized"

' destroy the object
Set objQTP = Nothing

End Function 'MinimizeQTP


Move File
Move a file from one location to another.
' =============================================================
' function: FileMove
' desc : Moves a file from one location to another
' params : strFile - full path to the source file
' strTarget - the folder to move the file to
' returns : void
' =============================================================
Function FileMove(strFile, strTarget)

Dim objFS

' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' check that the source file exists
If Not objFS.FileExists(strFile) Then

' fail if the source does not exist
reporter.ReportEvent micFail, "Move File", "Unable to Move the File '"& strFile &"', It Does Not Exist"

Else

' create the destination folder if it doesn't already exist
If Not objFS.FolderExists(strTarget) Then

objFS.CreateFolder(strTarget)

End If

' move the file
objFS.MoveFile strFile, strTarget

End If

' destroy the object
Set objFS = Nothing

End Function 'FileMove
Move Folder
Move a local or network folder.
' =============================================================
' function: FolderMove
' desc : Moves a folder and all of its files to a new path
' params : strSourceFolder - the folder to copy
' strDestinationFolder - the location to copy to
' returns : void
' =============================================================
Function FolderMove(strSourceFolder, strDestinationFolder)
Dim objFS
' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")
' check that the source folder exists
If Not objFS.FolderExists(strSourceFolder) Then
' fail if the source does not exist
reporter.ReportEvent micFail, "Move Folder", "Source Folder '"& strSourceFolder &"' Does Not Exist"
Else
' check that the destination folder doesn't already exist
If Not objFS.FolderExists(strDestinationFolder) Then

' move the folder
objFS.MoveFolder strSourceFolder, strDestinationFolder
Else
' fail if the target folder was already in place
reporter.ReportEvent micFail, "Move Folder", "Unable to Move Folder as the Target '" & strDestinationFolder & "' Already Exists"

End If

End If
' destroy the object
Set objFS = Nothing

End Function 'FolderMove
Displaying Dialog Boxes
How to display and use various types of dialog box.
' display a basic message box
MsgBox "Hi, this is a message box", vbOkOnly, "Message Title"


' prompt the user with a question
strAnswer = InputBox("Hi, how are you today?","Question")
' show the user what they just typed
MsgBox "You are - " & strAnswer


' ask the user to select an option
strAnswer = MsgBox("Do you want to proceed?", vbYesNo, "Question")
' show the user what they just selected
If strAnswer = vbNo Then
MsgBox "You selected No"
Else
MsgBox "You selected Yes"
End If
Note: Here are the various message types you can play with...
vbOKOnly
vbOKCancel
vbAbortRetryIgnore
vbYesNoCancel
vbYesNo
vbRetryCancel
vbCritical
vbQuestion
vbExclamation
vbInformation


Capture Screenshot
Capture and save a PNG of the entire screen.
' =============================================================
' function: ScreenShot
' desc : Creates a png of the entire screen
' params : n/a
' returns : name of saved png
' =============================================================
Function ScreenShot()
dim strPNG
dim objDesktop
' set a unique file name using the date/time
strPNG = "C:\Screenshot_" & day(date) & month(date) & year(date) & _
& hour(time) & minute(time) & second(time) & ".png"
' desktop object
Set objDesktop = Desktop
' capture a png of the desktop
obj.CaptureBitmap strPNG, true
' return the file name
ScreenShot = strPNG
' destroy the object
Set objDesktop = Nothing
End Function 'ScreenShot


Override Existing Object Method
Override an existing object method.
' override the Set method with SetWithDebug
RegisterUserFunc "WebEdit", "Set", "SetWithDebug"

' =============================================================
' function : SetWithDebug
' desc : Sets the value of an edit box with additional logging
' =============================================================
Function SetWithDebug(objEdit, strValue)

' your additional logging here
' set the text
SetWithDebug = objEdit.Set(strValue)

End Function


Registering a Procedure
Register a procedure with an object class.

' add GetItemsCount as a method of the WebList class
RegisterUserFunc "WebList", "GetItemsCount", "GetItemsCountFunction"

' =============================================================
' function : GetItemsCountFunction
' desc : Returns the number of items from a weblist
' =============================================================
Function GetItemsCountFunction(objWebList)

If (objWebList = Nothing) Then
GetItemsCount = 0
Else
GetItemsCount = objWebList.GetROProperty("Items Count")
End If

End Function

Using Programmatic Descriptions
Using Programmatic Descriptions to interact with a web page.
This example will illustrate how to use programmatic descriptions to interact with a web page, www.QTPHelper.com to be more exact...
Note that I've used a simple regular expression in the Browser and Page description, just in case the titles change in the future.
' click the Home link
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").Link("Text:=Home").Click

' check that the user isn't already logged in
If Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Exist(1) Then

' click logout
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Click

End If ' user logged in

' set the username
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit("Name:=username").Set "User"

' set the password
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit("Name:=passwd").Set "Password"

' tick the remember-me tickbox
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebCheckBox("Name:=remember").Set "ON"


Query a Database
Simple example of how to query an access database.
dim objDB
dim objRS
dim intCounter
' create a database and recordset objects
Set objDB = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.RecordSet")
' configure the connection
objDB.Provider="Microsoft.Jet.OLEDB.4.0"
objDB.Open "c:\MyTestDatabase.mdb"
' count the number of records in the employee table
objRS.Open "SELECT COUNT(*) from Employee" , objDB
Msgbox "There are " & objRS.Fields(0).Value & " records in the employee table."
' destroy the objects
Set objDB = Nothing
Set objRS = Nothing
Read a Text File
Example of how to read a text file line-by-line.

' reading a file line by line

Const ForReading = 1

' create file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' first check that the file exists
If objFS.FileExists("c:\TextFile.txt") Then

' open the text file for reading
Set objFile = objFS.OpenTextFile("c:\TextFile.txt", ForReading, False)

' do until at end of file
Do Until objFile.AtEndOfStream

' store the value of the current line in the file
strLine = objFile.ReadLine

' show the line from the file
MsgBox strLine

Loop ' next line

' close the file
objFile.Close

Set objFile = Nothing

Else ' file doesn't exist

' report a failure
Reporter.ReportEvent micFail, "Read File", "File not found"

End if ' file exists

' destroy the objects
Set objFS = Nothing


Read From Excel File
Read all the data from an Excel file.

' =============================================================
' function: ReadXLS
' desc : Reads a sheet from an XLS file and stores the content
' in a multi-dimensional array
' params : strFileName is XLS file to read, including path
' strSheetName is the name of the sheet to read, i.e "Sheet1"
' returns : Multi-dimensional array containing all data from
' the XLS
' =============================================================
Function ReadXLS(strFileName,strSheetName)

Dim strData()
Dim objFS, objExcel, objSheet, objRange
Dim intTotalRow, intTotalCol
Dim intRow, intCol

' create the file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' ensure that the xls file exists
If Not objFS.FileExists(strFileName) Then

' issue a fail if the file wasn't found
Reporter.ReportEvent micFail, "Read XLS", "Unable to read XLS file, file not found: " & strFileName
' file wasn't found, so exit the function
Exit Function

End If ' file exists

' create the excel object
Set objExcel = CreateObject("Excel.Application")

' open the file
objExcel.Workbooks.open strFileName

' select the worksheet
Set objSheet = objExcel.ActiveWorkbook.Worksheets(strSheetName)

' select the used range
Set objRange = objSheet.UsedRange

' count the number of rows
intTotalRow=CInt(Split(objRange.Address, "$")(4)) - 1

' count the number of columns
intTotalCol= objSheet.Range("A1").CurrentRegion.Columns.Count

' redimension the multi-dimensional array to accomodate each row and column
ReDim strData(intTotalRow, intTotalCol)

' for each row
For intRow = 0 to intTotalRow - 1

' for each column
For intCol =0 to intTotalCol - 1

' store the data from the cell in the array
strData(intRow, intcol) = Trim(objSheet.Cells(intRow + 2,intcol + 1).Value)

Next ' column

Next ' row

' close the excel object
objExcel.DisplayAlerts = False
objExcel.Quit

' destroy the other objects
Set objFS = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

' return the array containing the data
ReadXLS = strData

End Function ' ReadXLS

Read from the Registry
Read a value from a key in the registry.

' =============================================================
' function : RegistryRead
' desc : Read a value from the registry
' params : strRoot is the root key, i.e. "HKLM", "HKCU"
' strPath is the path to read, i.e.
' "Software\Test\Automation"
' returns : Value from the registry key
' =============================================================
Function RegistryRead(strRoot, strPath)

' create the shell object
Set objShell = CreateObject("WScript.Shell")

' read the key
strValue = objShell.RegRead(strRoot & "\" & strPath)

' return the value
RegistryRead = strValue

' destroy the object
Set objShell = Nothing

End Function 'RegistryRead

Registering a Procedure
Register a procedure with an object class.

' add GetItemsCount as a method of the WebList class
RegisterUserFunc "WebList", "GetItemsCount", "GetItemsCountFunction"

' =============================================================
' function : GetItemsCountFunction
' desc : Returns the number of items from a weblist
' =============================================================
Function GetItemsCountFunction(objWebList)

If (objWebList = Nothing) Then
GetItemsCount = 0
Else
GetItemsCount = objWebList.GetROProperty("Items Count")
End If

End Function

Replace Method
Using the replace method to find and replace text in a string.

MsgBox ReplaceText("Automating with QTP is rubbish.", "rubbish.", "great!")

MsgBox ReplaceText("QTP is a great automation tool but I can't use it","but.*","!")

' =============================================================
' function: ReplaceText
' desc : Uses a regular expression to replace text within a string
' params : strString is the string to perform the replacement on
' strPattern is the regular expression
' strReplacement is the replacement string
' returns : The finished string
' =============================================================
Function ReplaceText(strString, strPattern, strReplacement)

Dim objRegEx

' create the regular expression
Set objRegEx = New RegExp

' set the pattern
objRegEx.Pattern = strPattern

' ignore the casing
objRegEx.IgnoreCase = True

' make the replacement
ReplaceText = objRegEx.Replace(strString, strReplacement)

' destroy the object
Set objRegEx = Nothing

End Function ' ReplaceText


Write to the Registry
Write a value to the Registry.

' =============================================================
' Sub : RegistryWrite
' desc : Writes a key value to the registry
' params : strRoot is the root key, i.e. "HKLM", "HKCU"
' strPath is the path to create, i.e.
' "Software\Test\Automation"
' strValue is the value to write in the key
' returns : void
' =============================================================
Function RegistryWrite(strRoot, strPath, strValue)

' create the shell object
Set objShell = CreateObject("WScript.Shell")

' write the key
objShell.RegWrite strRoot & "\" & strPath, strValue, "REG_SZ"

' destroy the object
Set objShell = Nothing

End Function 'RegistryWrite


Read from the Registry
Read a value from a key in the registry.

' =============================================================
' function : RegistryRead
' desc : Read a value from the registry
' params : strRoot is the root key, i.e. "HKLM", "HKCU"
' strPath is the path to read, i.e.
' "Software\Test\Automation"
' returns : Value from the registry key
' =============================================================
Function RegistryRead(strRoot, strPath)

' create the shell object
Set objShell = CreateObject("WScript.Shell")

' read the key
strValue = objShell.RegRead(strRoot & "\" & strPath)

' return the value
RegistryRead = strValue

' destroy the object
Set objShell = Nothing

End Function 'RegistryRead


Delete from the Registry
Delete a key from the registry.

' =============================================================
' function: RegistryDelete
' desc : Deletes a key from the registry
' params : strRoot is the root key, i.e. "HKLM", "HKCU"
' strPath is the path to delete, i.e.
' "Software\Test\Automation"
' returns : void
' =============================================================
Function RegistryDelete(strRoot, strPath)

' create the shell object
Set objShell = CreateObject("WScript.Shell")

' delete the key
strValue = objShell.RegDelete(strRoot & "\" & strPath)

' destroy the object
Set objShell = Nothing

End Function 'RegistryDelete


Custom Report Entry
Creating a customised entry in the results.

' Example usage
CustomReportEntry micFail, "Custom Report Example", "

This is a custom report entry!

"

' =============================================================
' function: CustomReportEntry
' desc : Creates a customized entry in the result file, you
' can use standard HTML tags in the message.
' params : strStatus is the result, micPass, micFail etc
' strStepName is the name of the step
' strMessage is the failure message, this can contain
' html tags
' returns : Void
' =============================================================
Function CustomReportEntry(strStatus, strStepName, strMessage)

' create a dictionary object
Set objDict = CreateObject("Scripting.Dictionary")

' set the object properties
objDict("Status") = strStatus
objDict("PlainTextNodeName") = strStepName
objDict("StepHtmlInfo") = strMessage
objDict("DllIconIndex") = 206
objDict("DllIconSelIndex") = 206
objDict("DllPAth") = "C:\Program Files\Mercury Interactive\QuickTest Professional\bin\ContextManager.dll"

' report the custom entry
Reporter.LogEvent "User", objDict, Reporter.GetContext

End Function 'CustomReportEntry


Write to a Log File
Write information to a log file.

' =============================================================
' function: WriteLog
' desc : Writes a message to a log file. File is created
' inside a Log folder of the current directory
' params : strCode is a code to prefix the message with
' strMessage is the message to add to the file
' returns : void
' =============================================================
Function WriteLog(strCode, strMessage)

Dim objFS
Dim objFile
Dim objFolder
Dim strFileName

' create a file system object
Set objFS = CreateObject("Scripting.FileSystemObject")

' is there a log folder in the directory that we are currently working
If Not objFS.FolderExists(objFS.GetAbsolutePathName(".") & "\log") Then

' if there is no log folder, create one
Set objFolder = objFS.CreateFolder(objFS.GetAbsolutePathName(".") & "\log")

End If ' folder exists

' set a name for the log file using year, month and day values
strFileName = objFS.GetAbsolutePathName(".") & "\log\" & year(date) & month(date) & day(date) & ".log"

' create the log file
Set objFile = objFS.OpenTextFile(strFileName, 8, True)

' in case of any issues writing the file
On Error Resume Next

' write the log entry, include a carriage return
objFile.Write Date & ", " & Time & ", " & strCode & ", " & strMessage & vbcrlf

' disable the on error statement
On Error GoTo 0

' close the log file
objFile.Close

' destrory the object
Set objFS = Nothing

End Function ' WriteLog
Check Service is Running
Check to see if a windows service is running.

' =============================================================
' function: CheckIfServiceIsRunning
' desc : Check to see if a service is running
' params : strServiceName is the name of the service
' returns : True if running, False otherwise
' =============================================================
Function CheckIfServiceIsRunning(strServiceName)

Dim objShell, blnStatus

' create the shell object
Set objShell= CreateObject("Shell.Application")
blnStatus = objShell.IsServiceRunning(strServiceName)

' return status of service
CheckIfServiceIsRunning = blnStatus

End Function 'CheckIfServiceIsRunning


Basic String Manipulation
Basic functions for string manipulation.

Function: String
Accepts a number and a character. Returns a string created with the character that is repeated the given number of times.

' example
MsgBox String(5,"A")


Function: Len
Returns the number of characters from a given string.

' example
strMyName = "Joe Bloggs"
MsgBox "The Name '" & strMyName & "' is " & Len(strMyName) & " characters long"


Function: Instr
Accepts two strings and returns True if the second string is contained within the first.

' example
If Instr("Hello, welcome to www.QTPHelper.com!", "QTP")>0 Then MsgBox "Found"


Function: Left
Returns the given number of left-most characters from a string

' example
MsgBox Left("Joe Bloggs", 3)


Function: Right
Returns the given number of right-most characters from a string

' example
MsgBoxRight("Joe Bloggs", 6)


Function: LCase
Returns a given string in lower-case

' example
MsgBox LCase("JoE BloGGs")


Function: UCase
Returns a given string in upper-case

' example
MsgBox UCase("joe bloggs")
Get System Information
Get system information like User Name and Computer Name.

Dim objNet

' create a network object
Set objNet = CreateObject("WScript.NetWork")

' show the user name
MsgBox "User Name: " & objNet.UserName

' show the computer name
MsgBox "Computer Name: " & objNet.ComputerName

' show the domain name
MsgBox "Domain Name: " & objNet.UserDomain

' destroy the object
Set objNet = Nothing


Get Disk Information
Get information about one of your disk drives.

Dim intSectors, intBytes, intFreeC, intTotalC, intTotal ,intFreeb

' include this windows api
extern.Declare micLong, "GetDiskFreeSpace", "kernel32.dll", "GetDiskFreeSpaceA", micString+micByref, micLong+micByref, micLong+micByref,micLong+micByref,micLong+micByref

' set these values
intSectors = 255
intBytes = 255
intFreeC = 255
intTotalC = 255

' calculate the disk space, using C: in this example
intSpaceAvailable = extern.GetDiskFreeSpace("c:\", intSectors, intBytes, intFreeC, intTotalC)

' calculate the totals
intTotal = intTotalC * intSectors * intBytes
intFreeb = intFreeC * intSectors * intBytes

' show the outputs
msgBox intSectors
msgBox intBytes
msgBox intFreeC
msgBox intTotalC
msgbox intTotal
msgBox intFreeb

Get System Variable Value
Get a value from a Windows System Variable.

' for example to get the oracle home path
MsgBox GetSystemVariable("ORACLE_HOME")

' =============================================================
' function: GetSystemVariable
' desc : Get the value of a system variable
' params : strSysVar is the variable name
' returns : Content of variable name
' =============================================================
Function GetSystemVariable(strSysVar)

Dim objWshShell, objWshProcessEnv

' create the shell object
Set objWshShell = CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("Process")

' return the system variable content
GetSystemVariable = objWshProcessEnv(strSysVar)

End Function ' GetSystemVariable

Using Description Objects
Using Description Objects to interact with a web page.
This example will illustrate how to use description objects to interact with a web page, www.QTPHelper.com to be more exact...
Note that for the Browser and Page I've used programmatic descriptions, but for the buttons, edits and check-boxes I've used Description Objects. Also take note of the regular expression in the Browser and Page description, just in case the titles change in the future.
You can add more properties to your description objects if you need to, i.e. if your web page has numerous objects of the same type with similar property values.
Dim objLogout
Dim objUser
Dim objPass
Dim objRemember

' create description objects for each item we are dealing with
Set objLogout = Description.Create()
Set objUser = Description.Create()
Set objPass = Description.Create()
Set objRemember = Description.Create()

' define the properties of each item
objLogout("Name").Value = "Logout"
objUser("Name").Value = "username"
objPass("Name").Value = "passwd"
objRemember("Name").Value = "remember"

' check that the user isn't already logged in
If Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton(objLogout).Exist(1) Then

' click logout
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton(objLogout).Click

End If

' set the user name
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit(objUser).Set "User"

' set the password
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit(objPass).Set "Password"

' tick the remember-me tickbox
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebCheckBox(objRemember).Set "ON"


Using Programmatic Descriptions
Using Programmatic Descriptions to interact with a web page.
This example will illustrate how to use programmatic descriptions to interact with a web page, www.QTPHelper.com to be more exact...
Note that I've used a simple regular expression in the Browser and Page description, just in case the titles change in the future.
' click the Home link
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").Link("Text:=Home").Click

' check that the user isn't already logged in
If Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Exist(1) Then

' click logout
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebButton("Name:=Logout").Click

End If ' user logged in

' set the username
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit("Name:=username").Set "User"

' set the password
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebEdit("Name:=passwd").Set "Password"

' tick the remember-me tickbox
Browser("Title:=QTP Helper.*").Page("Title:=QTP Helper.*").WebCheckBox("Name:=remember").Set "ON"









What is QuickTest Automation Object Model?
It's a way to write scripts so as to automate your QuickTest operations.

Some places where we can use AOM
This is a small list of places (but not limited to) where we can use AOM. Thumb Rule - Use it at any place where you find yourself doing repetitive tasks while using QTP.
• AOM can come handy when you have a large no of scripts to be uploaded to QC. A simple script can save you hours of manual work!
• Use AOM to initialize QTP options and settings like add-ins etc.
• You can use AOM to call QTP from other application: For ex: You can write a macro for calling QTP from excel.
Caution: AOM should be used outside of QTP and not within the script (during playback). Though there is no harm using it inside but some of the AOM statements might fail.

How to write AOM scripts?
You need to understand that the very root of QT AOM is Application Object. Every automation script begins with the creation of the QuickTest "Application" object. Creating this object does not start QuickTest. It simply provides an object from which you can access all other objects, methods and properties of the QuickTest automation object model.You can create only one instance of the Application object. You do not need to recreate the QuickTest Application object even if you start and exit QuickTest several times during your script. Once you have defined this object you can then successfully work and perform operations on other objects given in Quick Test Pro > Documentation > QuickTest Automation Reference.
For ex: Let us connect to TD QC using AOM and open a script "qtp_demo"
Dim qt_obj 'Define a Quick Test object
qt_obj = CreateObject("Quick Test.Application") ' Instantiate a QT Object. It does not start QTP.
qt_obj.launch ' Launch QT
qt_obj.visible ' Make QT visible
qt_obj.TDConnection.Connect "http://tdserver/tdbin", _ 'Referencing TDConnection Object
"TEST_DOMAIN", "TEST_Project", "Ankur", "Testing", False ' Connect to Quality Center
If qt_obj.TDConnection.IsConnected Then ' If connection is successful
qt_obj.Open "[QualityCenter] Subject\tests\qtp_demo", False ' Open the test
Else
MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
To quickly generate an AOM script with the current QTP settings. Use the Properties tab of the Test Settings dialog box (File > Settings) OR the General tab of the Options dialog box (Tools > Options) OR the Object Identification dialog box (Tools > Object Identification). Each contain a "Generate Script" button. Clicking this button generates a automation script file (.vbs) containing the current settings from the corresponding dialog box.
You can run the generated script as is to open QuickTest with the exact configuration of the QuickTest application that generated the script, or you can copy and paste selected lines from the generated files into your own automation script.
Reference: Quick Test Pro > Documentation > QuickTest Automation Reference.





What is QuickTest Automation Object Model?
It's a way to write scripts so as to automate your QuickTest operations.

Some places where we can use AOM
This is a small list of places (but not limited to) where we can use AOM. Thumb Rule - Use it at any place where you find yourself doing repetitive tasks while using QTP.
• AOM can come handy when you have a large no of scripts to be uploaded to QC. A simple script can save you hours of manual work!
• Use AOM to initialize QTP options and settings like add-ins etc.
• You can use AOM to call QTP from other application: For ex: You can write a macro for calling QTP from excel.
Caution: AOM should be used outside of QTP and not within the script (during playback). Though there is no harm using it inside but some of the AOM statements might fail.

How to write AOM scripts?
You need to understand that the very root of QT AOM is Application Object. Every automation script begins with the creation of the QuickTest "Application" object. Creating this object does not start QuickTest. It simply provides an object from which you can access all other objects, methods and properties of the QuickTest automation object model.You can create only one instance of the Application object. You do not need to recreate the QuickTest Application object even if you start and exit QuickTest several times during your script. Once you have defined this object you can then successfully work and perform operations on other objects given in Quick Test Pro > Documentation > QuickTest Automation Reference.
For ex: Let us connect to TD QC using AOM and open a script "qtp_demo"
Dim qt_obj 'Define a Quick Test object
qt_obj = CreateObject("Quick Test.Application") ' Instantiate a QT Object. It does not start QTP.
qt_obj.launch ' Launch QT
qt_obj.visible ' Make QT visible
qt_obj.TDConnection.Connect "http://tdserver/tdbin", _ 'Referencing TDConnection Object
"TEST_DOMAIN", "TEST_Project", "Ankur", "Testing", False ' Connect to Quality Center
If qt_obj.TDConnection.IsConnected Then ' If connection is successful
qt_obj.Open "[QualityCenter] Subject\tests\qtp_demo", False ' Open the test
Else
MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
To quickly generate an AOM script with the current QTP settings. Use the Properties tab of the Test Settings dialog box (File > Settings) OR the General tab of the Options dialog box (Tools > Options) OR the Object Identification dialog box (Tools > Object Identification). Each contain a "Generate Script" button. Clicking this button generates a automation script file (.vbs) containing the current settings from the corresponding dialog box.
You can run the generated script as is to open QuickTest with the exact configuration of the QuickTest application that generated the script, or you can copy and paste selected lines from the generated files into your own automation script.
Reference: Quick Test Pro > Documentation > QuickTest Automation Reference.