Wednesday 9 January 2013

Utility Functions for QTP

Utility functions for Test Automation

Below is a list of utility functions that have been useful for creating 4th generation test automation frameworks and above. These are mainly for the tool HP QTP. This code was specifically created for a client in Australia called AMP.

'PT 05/09/2012 - The new reporter object
'PT 10/10/2012 - Adding extra handling for suite runs. If 3 or more errors, exit the test and go to the next one.
Public Sub s_Reporter (v_Result, v_TitleMessage, v_StepMessage)

    Select Case UCase(v_Result)
        Case "PASS"
            Reporter.ReportEvent micPass, v_TitleMessage, v_StepMessage
            GLOBALERRCOUNT = 0
            's_CaptureScreenshot
        Case "FAIL"
            Reporter.ReportEvent micFail, v_TitleMessage, v_StepMessage
            GLOBALERRCOUNT = GLOBALERRCOUNT +1
            's_CaptureScreenShot
        Case "DONE"
            Reporter.ReportEvent micDone, v_TitleMessage, v_StepMessage
            's_CaptureScreenShot
    End Select                           
                           
End Sub

'PT 28/02/2012 -  Imports the datatable into the run time table.
Public Sub s_ImportExcelSheetValues (strFilename, strSheetname)
    DataTable.AddSheet strSheetname
    DataTable.ImportSheet strFilename, strSheetname, strSheetname
End Sub

'PT 28/08/2012 - Generates a string value with the datetime format of:
' ddmmyyyy
Public Function f_GetDateTime ()
    Dim v_Temp, v_Date, v_Time, v_Day, v_Month, v_Year, v_ArrTemp, v_Hour, v_Min
   
    'v_Temp = date
    v_Temp = SYSTEMDATE 'PT 26/10/2012 - Added this as it needs to be the application system date
    v_ArrTemp = Split(v_Temp, "/")
    v_Day = CStr(v_ArrTemp(0))
    v_Month = CStr(v_ArrTemp(1))
    v_Year = CStr( v_ArrTemp(2))
    'v_Year = RIGHT(v_Year, 2)
    v_Temp = Time
   
    If Len(Hour(v_Temp)) = 1 Then
        v_Hour = "0" & CStr(Hour(v_Temp))
    Else
        v_Hour = CStr(Hour(v_Temp))
    End If
   
    If Len(Minute(v_Temp)) = 1 Then
        v_Min = "0" & CStr(Minute(v_Temp))
    Else
        v_Min = CStr(Minute(v_Temp))
    End If
   
    f_GetDateTime =   v_Day & v_Month &  v_Year  ' v_Hour & v_Min
   
End Function

'PT 19/10/2012 - Different date format
'Date format: dd/mm/yyyy
Public Function f_GetDateTime2 ()
    Dim v_Temp, v_Date, v_Time, v_Day, v_Month, v_Year, v_ArrTemp, v_Hour, v_Min
   
    v_Temp = date
    v_ArrTemp = Split(v_Temp, "/")
    v_Day = CStr(v_ArrTemp(0))
    v_Month = CStr(v_ArrTemp(1))
    v_Year = CStr( v_ArrTemp(2))
    'v_Year = RIGHT(v_Year, 2)
    v_Temp = Time
   
    If Len(Hour(v_Temp)) = 1 Then
        v_Hour = "0" & CStr(Hour(v_Temp))
    Else
        v_Hour = CStr(Hour(v_Temp))
    End If
   
    If Len(Minute(v_Temp)) = 1 Then
        v_Min = "0" & CStr(Minute(v_Temp))
    Else
        v_Min = CStr(Minute(v_Temp))
    End If
   
    f_GetDateTime2 =   v_Day & "/" &  v_Month & "/" & v_Year  ' v_Hour & v_Min
   
End Function

'PT 11/09/2012 - Get current date
'PT 26/10/2012 - Now based on system date
Public Function f_GetCurrentDate()
   'f_GetCurrentDate = Date
    f_GetCurrentDate = SYSTEMDATE
End Function

'PT 11/09/2012 - Add or subtract the time specified
'Eg. - 51 years
Public Function f_GetDateAdd(v_Str)

    Dim v_Years, v_CurrentDateTime, v_NewDate
    Dim v_Months, v_Days

    v_CurrentDateTime = CStr(f_GetCurrentDate())

    If InStr(v_Str, "YEARS") <> 0 Then
        v_Years = Trim(LEFT(v_Str, Len(v_Str) - 5))
        v_NewDate = DateAdd("yyyy", v_Years, v_CurrentDateTime)
    ElseIf InStr(v_Str, "YEAR") <> 0 Then
        v_Years = Trim(LEFT(v_Str, Len(v_Str) - 4))
        v_NewDate = DateAdd("yyyy", v_Years, v_CurrentDateTime)
    ElseIf InStr(v_Str, "MONTHS") <> 0 Then
        v_Months = Trim(LEFT(v_Str, Len(v_Str) - 6))
        v_NewDate = DateAdd("m", v_Months, v_CurrentDateTime)
    ElseIf InStr(v_Str, "MONTH") <> 0 Then
        v_Months = Trim(LEFT(v_Str, Len(v_Str) - 5))
        v_NewDate = DateAdd("m", v_Months, v_CurrentDateTime)
    ElseIf InStr(v_Str, "DAYS") <> 0 Then
        v_Days = Trim(LEFT(v_Str, Len(v_Str) - 4))
        v_NewDate = DateAdd("d", v_Days, v_CurrentDateTime)
    ElseIf InStr(v_Str, "DAY") <> 0 Then
        v_Days = Trim(LEFT(v_Str, Len(v_Str) - 3))
        v_NewDate = DateAdd("d", v_Days, v_CurrentDateTime)
    ElseIf InStr(v_Str, "WEEKS") <> 0 Then
        v_Weeks = Trim(LEFT(v_Str, LEN(v_Str) - 5))
        v_NewDate = DateAdd("ww", v_Weeks, v_CurrentDateTime)
    ElseIf InStr(v_Str, "WEEK") <> 0 Then
        v_Weeks = Trim(LEFT(v_Str, LEN(v_Str) - 4))
        v_NewDate = DateAdd("ww", v_Weeks, v_CurrentDateTime)
    End If
   
    f_GetDateAdd = v_NewDate

End Function

'PT 28/08/2012 - Returns the current time in HH:MM format.
Public Function f_GetCurrentTime ()
    Dim v_Time, v_TimeLen, v_TempArr, v_Hour, v_Min

    v_Time = time
    v_TimeLen = CInt(Len(v_Time)) - 3
    v_Time = LEFT(v_Time, v_TimeLen)
    v_TempArr = Split(v_Time, ":")
    v_Hour = v_TempArr(0)
    If Len(v_Hour) = 1 Then
        v_Hour = "0" & CStr(v_Hour)
    End If
    v_Min = v_TempArr(1)
    If Len(v_Min) = 1 Then
        v_Min = "0" & CStr(v_Min)
    End If
    f_GetCurrentTime = v_Hour & ":" & v_Min
End Function

'PT 31/08/2012 - Gets the full path in a folder matching a string pattern and returns a boolean result
Public Function f_CheckFileInFolder(filepath, filename)
   Dim fso, f, f1, fc, v_Temp
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(filepath)
   Set fc = f.Files
   For Each f1 in fc
      v_Temp = f1.name
      If Instr(v_Temp, filename) <> 0 Then
        f_CheckFileInFolder = True
        Exit Function
      End If
   Next
   f_CheckFileInFolder = False
End Function

'PT 09/10/2012 - Get MQ message
'NOTE: The MQSERVER environment variable needs to be added to work. The syntax for it is below:
'MQSERVER= ChannelName/Protocol/Server(port)
'The MQSERVER variable is: *
' Refer to the config file for constants and their values
Public Function  f_GetMQMessage()

    Dim MQSess, QMgr, Queue, GetMsg, GetOptions,  v_Counter
    Dim Reading, MsgData, MQOO_INPUT_SHARED

    Reporter.Filter = REPORT_DISABLE

    v_Counter = 1
    MQOO_INPUT_SHARED = 2

    Set MQSess = CreateObject("MQAX200.MQSession")
    Set QMgr = CreateObject("MQAX200.MQQueueManager")

    Set QMgr = MQSess.AccessQueueManager(QUEUEMANAGER)
    Set Queue = QMgr.AccessQueue(QUEUEOUT,MQOO_INPUT_SHARED) '*

    On Error Resume Next
'    Set fso = CreateObject("Scripting.FileSystemObject")
'   Set f1 = fso.CreateTextFile("E:\\MQ\\msg.txt",8, True)

  Do While IsEmpty(MsgData) = True or MsgData =  "" 'Queue.completionCode() <> -1
'        WScript.Echo "Qu'eue Accessed"
            If v_Counter <> 2000 Then 'Using the counter as a time limit.
                Set GetMsg = MQSess.AccessMessage()
                Set GetOptions = MQSess.AccessGetMessageOptions()
               Call Queue.Get(GetMsg, GetOptions)
        '        WScript.Echo "Looping " & Queue.ReasonCode & " " & Queue.completionCode()
        '        If Queue.ReasonCode=2033 Then
        '               Exit Do
        '            Else
                      MsgData= GetMsg.MessageData
        '               f1.Write(MsgData & "+NextMsg+") ' +NextMsg+ is a delimiter between two messages
                    f_GetMQMessage = MsgData
                    Reporter.Filter = REPORT_ENABLE
                    'wait 3
                    v_Counter = v_Counter + 1
            Else
                s_Reporter "Fail", "Get MQ Message from queue manager: " & QUEUEMANAGER & ", and queue: " & QUEUEOUT, "There is no message in the queue. " _
                                        & "Please check to see if it is a processing error or whether it is a broker not running."
               QMgr.Commit
                Queue.Close
                QMgr.Disconnect
                Exit Function
            End If
'        END If 
   Loop
'   f1.Close

    s_Reporter "Done", "Get MQ Message from queue manager: " & QUEUEMANAGER & ", and queue: " & QUEUEOUT, "The message obtained was: " & MsgData

   QMgr.Commit
    Queue.Close
    QMgr.Disconnect

End Function

'PT 09/10/2012 - Put an MQ Message on a queue
''NOTE: The MQSERVER environment variable needs to be added to work. The syntax for it is below:
'MQSERVER= ChannelName/Protocol/Server(port)
'The MQSERVER variable is: MQSERVER=*
' Refer to the config file for constants and their values
Public Sub s_PutMQMessage(v_MessageData)
    Dim MQSess, QMgr, Queue, AccessQ, AccessOptions
    Dim MsgData, OPEN_OPTION

    OPEN_OPTION = 1 + 16

    Reporter.Filter = REPORT_DISABLE

    Set MQSess = CreateObject("MQAX200.MQSession")
    Set QMgr = CreateObject("MQAX200.MQQueueManager")

    Set QMgr = MQSess.AccessQueueManager(QUEUEMANAGER)
    Set Queue = QMgr.AccessQueue(QUEUEIN,OPEN_OPTION)

    Set AccessQ = MQSess.AccessMessage()
    AccessQ.MessageData = v_MessageData
    Set AccessOptions = MQSess.AccessPutMessageOptions()

    Call Queue.Put(AccessQ, AccessOptions)

    Reporter.Filter = REPORT_ENABLE
    s_Reporter "Done", "Put MQ Message on the Q Manager: " & QUEUEMANAGER & ", and the queue: " & QUEUEIN, "The message placed was: " & v_MessageData

    Queue.Close
    QMgr.Disconnect
End Sub

'PT  05/09/2012 - Compares an XML file and the string contents of the file
'Returns a boolean result
Public Function f_CompareXML (XMLPath, FilePath)

Dim oDoc, oDocStr, oDoc2, oDoc2Str, res, v_Doc1, v_Doc2

'Initialise objects
Set oDoc = XMLUtil.CreateXML()
Set oDocStr = xmlutil.CreateXML()
Set oDoc2 = XMLUtil.CreateXML()
Set oDoc2Str = XMLUtil.CreateXML()

'Load objects and variables
oDoc.LoadFile FilePath
oDocStr.Load oDoc.ToString
oDoc2.LoadFile XMLPath
oDoc2Str.Load oDoc2.ToString
'v_Doc1  = oDocStr.Load (oDoc.ToString ())
'v_Doc2 = oDoc2Str.Load (oDoc2.ToString())

'Compare the object strings
res = oDocStr.Compare(oDoc2Str)

If res = 1 Then
    'Pass
    'Reporter.ReportEvent micPass, "Compare XML", "The files: " & XMLPath & ", " & FilePath & " match."
    s_Reporter "Pass", "Compare XML", "The files: " & XMLPath & ", " & FilePath & " match."
    f_CompareXML = True
Else
    'Fail
    'Reporter.ReportEvent micFail, "Compare XML", "The files: " & XMLPath & ", " & FilePath & " do not match."
    s_Reporter "Fail", "Compare XML", "The files: " & XMLPath & ", " & FilePath & " do not match."
    f_CompareXML= False
End If
End Function

'PT 05/09/2012 - Compare file (binary compare)
'Returns a boolean result
Public Function f_BCompareFile(fileOne, fileTwo)

Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("fc /b " & fileOne & " " & fileTwo)

output = oExec.StdOut.ReadAll()

    If InStr(1,output, "No differences encountered", 1) Then
        'Files are the same
        'Reporter.ReportEvent micPass, "Binary File Comparison", "The file: " & fileOne & " and the second file: " & fileTwo & " are the same."
        s_Reporter "Pass", "Binary File Comparison", "The file: " & fileOne & " and the second file: " & fileTwo & " are the same."
        f_BCompareFile = True
    Else
        'Files are different
        'Reporter.ReportEvent micFail, "Binary File Comparison", "The file: " & fileOne & " and the second file: " & fileTwo & " are NOT the same."
        s_Reporter "Fail", "Binary File Comparison", "The file: " & fileOne & " and the second file: " & fileTwo & " are NOT the same."
        f_BCompareFile = False
    End If
End Function

'PT 10/09/2012 - Strips the special characters out of strings
'So far: only the chars ".", "(", ")" have been stripped
Public Function f_StripSpecialChars (v_Str)
    Dim v_Temp
    v_Temp = Replace(v_Str, ".", "")
    v_Temp = Replace (v_Temp, "(", "" )
    v_Temp = Replace(v_Temp, ")", "")
    v_Temp = Replace(v_Temp, "#", "")
    v_Temp = Replace(v_Temp, "/", "")
    v_Temp = Replace(v_Temp, "?", "")
    v_Temp = Replace(v_Temp, "-", "")
    v_Temp = Replace(v_Temp, "%", "")
    'v_Temp = Replace(v_Temp, " ", "")
    'v_Temp = Replace(v_Temp, ":", "")
    f_StripSpecialChars = v_Temp
End Function

'PT 18/09/2012 - Generate a random number
'Can make any random int value to whatever length required.
' By default it will provide a single random number.
Public Function f_GenRndNo(v_Length)
   
    Dim v_Number, i

    If v_Length = "" Then
        v_Length = 1
    End If

    For i = 1 to v_Length
        v_Number = v_Number & CStr(int(rnd*10))
        While v_Number = "0"
            v_Number = v_Number & CStr(int(rnd*10))
        Wend
    Next
    f_GetRndIntNumber = v_Number

End Function

'PT 08/10/2012 - Strip a string of all letters
Public Function f_StripAllLettersFromStr(v_Str)
    Dim v_Temp

    v_Temp = Replace(Trim(UCase(v_Str)), "A", "")
    v_Temp = Replace(v_Temp, "B", "")
    v_Temp = Replace(v_Temp, "C", "")
    v_Temp = Replace(v_Temp, "D", "")
    v_Temp = Replace(v_Temp, "E", "")
    v_Temp = Replace(v_Temp, "F", "")
    v_Temp = Replace(v_Temp, "G", "")
    v_Temp = Replace(v_Temp, "H", "")
    v_Temp = Replace(v_Temp, "I", "")
    v_Temp = Replace(v_Temp, "J", "")
    v_Temp = Replace(v_Temp, "K", "")
    v_Temp = Replace(v_Temp, "L", "")
    v_Temp = Replace(v_Temp, "M", "")
    v_Temp = Replace(v_Temp, "N", "")
    v_Temp = Replace(v_Temp, "O", "")
    v_Temp = Replace(v_Temp, "P", "")
    v_Temp = Replace(v_Temp, "Q", "")
    v_Temp = Replace(v_Temp, "R", "")
    v_Temp = Replace(v_Temp, "S", "")
    v_Temp = Replace(v_Temp, "T", "")
    v_Temp = Replace(v_Temp, "U", "")
    v_Temp = Replace(v_Temp, "V", "")
    v_Temp = Replace(v_Temp, "W", "")
    v_Temp = Replace(v_Temp, "X", "")
    v_Temp = Replace(v_Temp, "Y", "")
    v_Temp = Replace(v_Temp, "Z", "")

    f_StripAllLettersFromStr = Trim(v_Temp)
End Function

No comments:

Post a Comment