Sunday 13 January 2013

Disabling the screensaver on an execution PC

More useful automation code

'Author: Mohamed Ali & Patrick Tsang
'Date: 11/03/2010

Const HKEY_CURRENT_USER = &H80000001
strComputer = "."


'Create Key
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")

strKeyPath = "Software\Policies\Microsoft\Windows\Control Panel\Desktop"
oReg.CreateKey HKEY_CURRENT_USER,strKeyPath
'Create String
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
strSSActiveNameValue = "ScreenSaveActive"
strSSActiveValue = "0"
strSSIsSecureNameValue = "ScreenSaverIsSecure"
strSSIsSecureValue = "0"
strSSTimeOutNameValue = "ScreenSaveTimeOut"
strSSTimeOutValue = "0"

oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strSSActiveNameValue,strSSActiveValue
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strSSIsSecureNameValue,strSSIsSecureValue
oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strSSTimeOutNameValue,strSSTimeOutValue

'Msgbox "Registry Updated: Screen Saver is now disabled."

Upload QTP scripts to Quality Center / ALM

More useful code. This time it's to add a whole bunch of tests to QC from QTP if they aren't uploaded already. This code is from a mate of mine who is now working in HP. We both shared a lot of useful code so I hope this is useful for you. For all code taken from this blog, please reference the author! That's all we ask :)

' Author: Mohamed Ali
' Date: 01/08/06
'CAUTION: USE THIS SCRIPT WITH EXTREME CARE SINCE IT ACCESSES QC.
'Note: QTP Must be open and QC connection must be setup BEFORE running this script

Const QTPPath = "G:\"
Const QCPath = "[QualityCenter] Subject\Automation\"
Dim qtApp, objFSO

Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(QTPPath)
Set colListOfFiles = objFolder.SubFolders
'open qtp if it isn't already open
qtApp.Visible = False
On Error Resume Next
  If qtApp.TDConnection.IsConnected Then ' If connection is successful
   For Each objFile in colListOfFiles
    'open temp locally then save file to QC
    qtApp.Open QTPPath & objFile.name
    qtApp.Test.SaveAs QCPath & objFile.name, True
   Next
  Else
   MsgBox "Please Setup QTP Connection to Quality Centre"
  End If
On Error GoTo 0


Thursday 10 January 2013

Utility Functions for SilkTest 4Net (VB.Net variant)

Utility functions for SilkTest 4Net (VB.NET variant)

This is currently for a 4th+ generation Keyword Driven Framework. Below are some more useful functions.


       'PT 20/11/2012 - This is to make reporting easier
       'Usage: result is boolean, message is string, functionname is the name of the calling function and sheetname is passed in.
       Public Sub Reporting (ByVal result, ByVal testStep, ByVal message, ByVal functionName, ByVal sheetName)
             
              If result = True Then
                     Workbench.Verify(result, result, "[" & testStep & "] " & functionName & "(): " & message)
              Else
                     Workbench.Verify(result, True, "[" & testStep & "] " & functionName & "(): " & message)
              End If
              'Workbench.Verify takes screenshots as well. Below is deprecated.
'             If Config.DEBUGMODE = "ON" Then
'                    ScreenShot (testStep, functionName, result, sheetName)
'             ElseIf Config.DEBUGMODE = "OFF" And result = False Then
'                    ScreenShot (testStep, functionName, result, sheetName)
'             End If
       End Sub


       'PT 06/12/2012 - Add key and value to a object dictionary.
       Public Sub AddKeyValToDictionary (ByRef dictionary, ByVal Key, ByVal Value)
              Try
                     dictionary.Add(Key, Value)
                     Reporting(True, "", _
                     "Key: " & Key & ", and Value: " & Value & _
                     ", added to the dictionary.", _
                     "AddKeyValToDictionary", "")
              Catch e As Exception
                     Reporting(False, "", _
                     "Exception thrown. The key is most likely duplicate. Please use a unique key.", "AddKeyValToDictionary", "")
              End Try
       End Sub


'PT 20/11/2012 - This is to compare text values, report on a response and return the result
       Public Function CompareText (ByVal testStep, ByVal text, ByVal text1) 'ByVal description
              'Workbench.Verify(text, text1, description)
              If String.Compare(text, text1) = 0 Then
                     Reporting(True, testStep, text & " and " & text1 & " matches.", "CompareText", "")
                     CompareText = True
                     Exit Function
              Else
                     Reporting(False, testStep, "The text do not match. Text: " & text & ", Text1: " & text1, "CompareText", "")
                     CompareText = False
                     Exit Function
              End If
       End Function
'PT 13/12/2012 - Returns true or false to say whether a key exists in a dictionary or not.
       Public Function KeyExistsInDictionary (ByVal dictionary, ByVal Key)
              KeyExistsInDictionary = dictionary.ContainsKey(Key)   
       End Function
      
       'PT 28/11/2012 - Access a key from a object dictionary. Returns blank if the key isn't found
       Public Function GetValFromDictionary(ByVal testStep, ByVal dictionary, ByVal dicKey)
              Dim value As String = ""
              If dictionary.TryGetValue(dicKey, value) Then
                     GetValFromDictionary = value
              Else
                     Reporting(False, testStep, "The key in the dictionary does not exist! Key: " & dicKey, "GetValFromDictionary", "")
                     GetValFromDictionary = ""
              End If
       End Function

       'PT 28/11/2012 - Get the keys from a dictionary. Return blank if the dictionary doesn't exist.
       Public Function GetKeysFromDictionary(ByVal dictionary)
              Dim keysCol As Dictionary(Of String, String).KeyCollection = dictionary.Keys
              GetKeysFromDictionary = keysCol
       End Function

       'PT 26/11/2012 - Create new web request for a NAB user, stage 1
       'NOTE: Returns status code
       Public Function NewHTTPWebReq_NAB1 (ByVal URL)
              Dim statusDesc, status, message, source, errString As String
              Dim innerException As Exception
              Dim CookieContainer As CookieContainer = New CookieContainer()
             
              'Ignore Cert problems
              'ServicePointManager.ServerCertificateValidationCallback = New System.Net.Security.RemoteCertificateValidationCallback(AcceptAllCertifications);

              'Create the web request 
              Console.WriteLine("SENDING REQUEST-------------------")
              Dim httpWebReq As HttpWebRequest = CType(WebRequest.Create(URL), HttpWebRequest) 'Config.NABQA_URL
              Console.WriteLine("URL: " & URL)
              httpWebReq.Method = "GET"
              httpWebReq.ContentType = "text/html"
             
              'Common header elements
              httpWebReq.Host = "nabqa0.sso.corp.dmz" 'https:// - not valid.
              httpWebReq.UserAgent = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:10.0.2) Gecko/20100101 Firefox/10.0.2"
              httpWebReq.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
              httpWebReq.KeepAlive = True
             
              'New header elements
              httpWebReq.Headers.Add("Accept-Language:en-gb,en;q=0.5")
              httpWebReq.Headers.Add("Accept-Encoding:gzip, deflate")
              httpWebReq.Headers.Add("iv-user:*") 'existing user
              httpWebReq.Headers.Add("iv-groups:*")
              httpWebReq.Headers.Add("vh-surname:*")
              httpWebReq.Headers.Add("vh-firstName:*")
              httpWebReq.Headers.Add("vh-otherName:*")
              httpWebReq.Headers.Add("vh-email:*")
              httpWebReq.Headers.Add("vh-clientCostCentre:d0003")
             
             
              'Proxy details
              Dim proxy As IWebProxy = CType(httpWebReq.Proxy, IWebProxy)                      
              proxy.Credentials = New NetworkCredential("*", "*")
              Console.WriteLine("Proxy: {0}", proxy.GetProxy(httpWebReq.RequestUri))

              'Get the cookies
              httpWebReq.CookieContainer = CookieContainer
              httpWebReq.AllowAutoRedirect = True 'was false
             
              'Send the web request
              Try
                     Dim httpWebRes As HttpWebResponse = CType(httpWebReq.GetResponse(), HttpWebResponse)
                     Console.WriteLine("Status Code: " & httpWebRes.StatusCode)
                     Console.WriteLine("Status Description: " & httpWebRes.StatusDescription)
                     Console.WriteLine("Content Length: " & httpWebRes.ContentLength)
                     Console.WriteLine("Content Type: " & httpWebRes.ContentType)
                     Console.WriteLine("Server: " & httpWebRes.Server)
                     Console.WriteLine("Last Modified: " & httpWebRes.LastModified)
                     Console.WriteLine("ENDING REQUEST-------------------")
            'Using writer As StreamWriter = New StreamWriter("myfile.txt")
                           For Each cookieValue As Cookie In httpWebRes.Cookies
                           'writer.WriteLine("Cookie: " + cookieValue.ToString())
                                         Console.WriteLine("Cookie: " + cookieValue.ToString())
                   Next
                   'writer.Close()
                     'End Using
                     httpWebRes.Close    
                     NewHTTPWebReq_NAB1 = httpWebRes.StatusCode
              Catch ex As WebException
                     statusDesc = CType(ex.Response, HttpWebResponse).StatusDescription
                     status = CType(ex.Response, HttpWebResponse).StatusCode
                     message = ex.Message
                     innerException = ex.InnerException
                     source = ex.Source
                     errString = ex.ToString()
                     Console.WriteLine("Status: " & status )
                     Console.WriteLine("Status Description: " & statusDesc)
                     Console.WriteLine("Message: " & message)
                     Console.WriteLine("Inner Exception: {0}", ex.InnerException)
                     Console.WriteLine("Source: " & source)
                     Console.WriteLine("Error: " & errString)
                     Console.WriteLine("ENDING REQUEST-------------------")
                     NewHTTPWebReq_NAB1 = status
              End Try
       End Function
       'PT 29/11/2012 - Kill a process
       Public Sub KillProcess (ByVal processName)
              Dim proc As System.Diagnostics.Process
              For Each proc In System.Diagnostics.Process.GetProcessesByName(processName)
                     proc.Kill()
              Next         
       End Sub
'PT 30/11/2012 - Date function
       'Example out: 20121130 is 30th Nov 2012
       Public Function GetDate ()
              Dim time As DateTime = DateTime.Now
              Dim format As String = "yyyyMMdd"
'             Console.WriteLine(time.ToString(format))
              GetDate = time.ToString(format)
       End Function
      
       'PT 06/12/2012 - Get date based on format
       Public Function GetDateFormat (ByVal dateFormat)
              Dim time As DateTime = DateTime.Now
              Dim format As String = dateFormat
              GetDateFormat = time.ToString(format)
       End Function
      
       'PT 29/11/2012 - Screenshot capability
       'ScreenShot (testStep, functionName, result, sheetName)
       'Screenshot file name format: TESTCASE_PASS_1_VEDACHECK_PROCESSLOGIN_20121130.bmp
       'Screenshot file name without test case: PASS_1_CompareText_20121130.bmp
       'PT 30/11/2012 - DEPRECATED. SilkTest automatically screenshots every step.
       Public Sub ScreenShot (ByVal testStep, ByVal functionName, ByVal result, ByVal sheetName)
             
              If sheetName <> "" Then   
                     desktop.CaptureBitmap(Config.SCREENSHOTDIR & "_" & sheetName & "_" & _
                     result & "_" & testStep & "_" & functionName & "_" & GetDate())
              Else
                     desktop.CaptureBitmap(Config.SCREENSHOTDIR & _
                     result & "_" & testStep & "_" & functionName & "_" & GetDate())                         
              End If
       End Sub
       'PT 17/12/2012 - Get Text parsed from a block based on the
       'criteria provided by SearchStr With the length Of LenToReturn
       Public Function GetText (ByVal TextBlock, ByVal SearchStr, ByVal LenToReturn)
              Dim StrPos As Integer
                     StrPos = Trim(TextBlock).IndexOf(SearchStr) + 1 'For some reason the IndexOf value is 1 short...
                     If StrPos <> -1 Then
                           GetText = Mid(TextBlock, StrPos, LenToReturn)
                     Else
                           GetText = "False"   
                     End If
       End Function
'PT 08/01/2013 - Output values to specified sheet
       'The Value string is delimited and thus allows for multiple entries into excel.
       'The delimiter is the ";" character, note that the field labels and field values are paired.
       Public Sub OutputValToXLFile (ByVal DirName, ByVal FileName, ByVal WorksheetName, ByVal Value)
              Dim objExcel, objWorkbook, objWorksheet As Object
              Dim i, j As Integer
              Dim rowCount As Integer   
              Dim fileExists As Boolean
              Dim strArr As String()
              Dim arrSize As Integer

              'Check to see if the file you want to output to already exists
              fileExists = CheckFileInDir (DirName, FileName)

              'Config 'Initialise all the variables
              objExcel = CreateObject("Excel.Application")          
              objExcel.DisplayAlerts = False
             
              If fileExists = False Then
                     objWorkbook = objExcel.Workbooks.Add
                     objWorksheet = objExcel.Worksheets(1)
                    
                     'Add Entries to the worksheet.
                     If InStr(Value, ";") <> 0 Then
                           'Check to see if the values are paired properly otherwise exit and fail.
                           If arrSize Mod 2 <> 0 Then
                                  Reporting(False, "OutputValToXLFile", "The value passed in is not paired correctly!", "OutputValToXLFile", "")
                           End If
                    
                           'Write the header labels in the sheet first
                           objWorksheet.Cells(1, 1).Value = "Field Label" 'Header cells
                           objWorksheet.Cells(1, 2).Value = "Field Value" 'Header cells              
                           'Get the array size of the split array.
                           strArr = Value.Split(";")
                           arrSize = UBound(strArr)
                          
                           'Now iterate through the array and start filling in the excel file with the output
                           'Note that every pair is on a new row.
                          
                           'Set the row to the first one as it is for a new file
                           j = 1
                          
                           For i = 0 To arrSize + 1
                                  If i = arrSize + 1 Then
                                         Exit For
                                  End If
                                  If i Mod 2 = 0 Then
                                         j = j + 1
                                         If LEFT(strArr(i) , 1) = "0" Then strArr(i) = "'" & strArr(i)
                                         If LEFT(strArr(i + 1) , 1) = "0" Then strArr(i + 1) = "'" & strArr(i + 1)
                                         objWorksheet.Cells(j, 1) = CStr(strArr(i))
                                         objWorksheet.Cells(j, 2) = CStr(strArr(i + 1))
                                         i = i + 1
                                  End If
                           Next
                     End If
              Else
                    
                     objWorkbook = objExcel.Workbooks.Open (DirName & FileName)
                     objWorkbook.Worksheets(WorksheetName).Select          
                     objWorksheet = objWorkbook.Activesheet
                    
                     'Determine the sheet ranges
                     rowCount = objWorkbook.Activesheet.usedrange.rows.count
                     'colCount = objWorkbook.Activesheet.usedrange.columns.count               
             
                     'See if the value string is delimited
                     If InStr(Value, ";") <> 0 Then
                           strArr = Value.Split(";")
                           arrSize = UBound(strArr)
                     Else
                           Reporting(False, "OutputValToXLFile", "The value passed into this function is not delimited!", "OutputValToXLFile", "")
                     End If
                    
                     'Set the row to the first one as it is for a new file
                     j = rowCount
                    
                     For i = 0 To arrSize + 1
                           If i = arrSize + 1 Then
                                  Exit For
                           End If
                           If i Mod 2 = 0 Then
                                  j = j + 1
                                  If LEFT(strArr(i) , 1) = "0" Then strArr(i) = "'" & strArr(i)
                                  If LEFT(strArr(i + 1) , 1) = "0" Then strArr(i + 1) = "'" & strArr(i + 1)                               
                                  objWorksheet.Cells(j, 1).Value = CStr(strArr(i))
                                  objWorksheet.Cells(j, 2).Value = CStr(strArr(i + 1))
                                  i = i + 1
                           End If
                     Next
                                 
              End If
                    
              'Close off the excel object
              objWorkbook.SaveAs (DirName & FileName)
              objExcel.Quit
             
              'Clear the memory for all the objects.
              objExcel = Nothing
              objWorkbook = Nothing     
              objWorksheet = Nothing
       End Sub
      
       'PT 08/01/2013 - Check for file in file directory and return boolean result
       Public Function CheckFileInDir (ByVal DirectoryName, ByVal FileName)
              ' make a reference to a directory
           Dim dirIfno As New IO.DirectoryInfo(DirectoryName)
           Dim dirArr As IO.FileInfo() = dirIfno.GetFiles()
           Dim file As IO.FileInfo

          'list the names of all files in the specified directory
              'Console.WriteLine("File name: " & file.ToString)     
           For Each file In dirArr
                     If InStr(FileName.ToString, file.ToString) <> 0 Then
                           CheckFileInDir = True
                           Exit Function
                     Else
                           CheckFileInDir = False
              End If       
           Next            
       End Function 

'PT 09/01/2013 - Combines strings based on a delimmiter and returns it.
       Public Function StringDelimiter (ByVal str1, ByVal str2, ByVal str3, ByVal str4, ByVal delimiter)
                     StringDelimiter = str1 & delimiter & str2 & delimiter & str3 & delimiter & str4
       End Function