What is Quick Test Professional Tool ?http://qtpfaq.wordpress.com/category/new-qtp-9x/

http://qtpfaq.wordpress.com/category/new-qtp-9x/

Basic(ASP, Visual Basic, VBScript, etc...)

//http://home.att.net/~gobruen/progs/basic/index.html#vbs

Verify Whether DataBase is Exist or Not and if it's not Restore given Database in Data Base through QTP

'Variable Declaration
Option Explicit
Dim Dsn_conn , rs , oServer , strServer,strUid,strQry , strDBName , fso, msg , FileStatus
Dim objConnection , oRestore ,SQLDMORestore_Database , strFilePath , strActualPath
' Action parameters
strServer=parameter("Server")''''' Server Name where SQL is Running
strUid=parameter("Uid") '''''' User Id which have permissions to logon SQL
strDBName=Parameter("DBName") '''' DB Name which DB you have to Restore
strFilePath=Parameter("FilePath") '' Path of the DB file
Set objConnection=Createobject("ADODB.Connection")
Dsn_conn= "DRIVER=SQL Server;SERVER="&strServer&";UID="&strUid&";APP=QuickTest
Professional;WSID="&strServer&";Trusted_Connection=Yes"
objConnection.Open(Dsn_conn)
If err.number <> 0 Then
Reporter.ReportEvent 1 ,"DBConnection","Unable to Connect to the database"&"Err Description = " & err.Description
Else
Reporter.ReportEvent 0 ,"DBConnection","Connection Succeeded"
End If
Set rs=CreateObject("ADODB.RecordSet")
' Verify whether Data base is Exist or not
strQry = "if not exists(select * from sys.databases where name = 'selftest') create database selftest"
Set rs=objconnection.execute(strQry)
'rs.Close
objConnection.Close
' Verify whether DB File is Exist in C Drive or not
strActualPath="C:\selftest.bak"
FileStatus=ReportFileStatus(strActualPath)
Function ReportFileStatus(filespec)
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
msg = "True"
Else
msg = "False"
End If
ReportFileStatus = msg
set fso=nothing
End Function
' Copy the DB File From given path to C Drive
If Filestatus="True" Then
Call RestoreDBFromFile(strServer,strDBName,strActualPath)
Else
Set fso = CreateObject("Scripting.FileSystemObject")
fso.copyFile strFilePath,"C:\"
FileStatus=ReportFileStatus(strActualPath)
If Filestatus="True" Then
Reporter.ReportEvent 0,"Data Base File"," Is Copied"
Call RestoreDBFromFile(strServer,strDBName,strActualPath)
Else
Reporter.ReportEvent 1,"Data Base File"," Is Not Copied"
End If
End If
' Delete DB File From C Drive
DeleteAFile(strActualPath)
Sub DeleteAFile(filespec)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(filespec)
End Sub
Sub RestoreDBFromFile(ServerName , DBName , BackupToRestore )
'simple err checking
If ServerName = "" Or DBName = "" Or BackupToRestore = "" Then
Reporter.ReportEvent 1,"DB Connection ", "You MUST provide server name, database name, and the name of the bak file you want to restore"
Exit Sub
End If
'open connection to server
Set oServer =CreateObject("SQLDMO.SQLServer")
With oServer
.LoginSecure = True
.Connect ServerName
End With
'also need a restore object
Set oRestore = CreateObject("SQLDMO.Restore")
With oRestore
.Database = DBName
.Action = SQLDMORestore_Database
.ReplaceDatabase = True
.Files = BackupToRestore
.SQLRestore oServer
End With
Set oRestore = Nothing
oServer.DisConnect
Set oServer = Nothing
Reporter.ReportEvent 0,"Data Base","Data Base is Restored with Name : "&DBName
End Sub

how to get the column values and column header through QTP from Infragistics UltraGrid(If Applications are developed using Net advantage Controls)

rowcount=WpfWindow("Eclipsys Gateway My").SwfWindow("Custom View").SwfTable("grFilter").GetNAProperty("Rows.Count")
'Then to access each row:
For I = 0 TO rowcount-1
Set currentRow = WpfWindow("Eclipsys Gateway My").SwfWindow("Custom View").SwfTable("grFilter").GetNAProperty("Rows["+CSTR(I)+"]")
' To get a specific cell text for the current row
cellText =WpfWindow("Eclipsys Gateway My").SwfWindow("Custom View").SwfTable("grFilter").GetNAProperty("Rows["+CSTR(I)+"].Cells[3].Text")
msgbox cellText
Next

iColIndex = 2
strColKey = "value"
SET grid = WpfWindow("Eclipsys Gateway My").SwfWindow("Custom View").SwfTable("grFilter")
msgbox grid.GetNAProperty("DisplayLayout.Bands[0].Columns["+CSTR(iColIndex)+"].Header.Caption")
msgbox grid.GetNAProperty("DisplayLayout.Bands[0].Columns["+strColKey +"].Header.Caption")

How to find the Network UserName

Set wshNetwork =CreateObject( "WScript.Network" )
strUserName = wshNetwork.UserName
msgbox strUserName

Find out all the drives including Caption,size from one machine

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _ "SELECT * FROM Win32_DiskDrive",,48)
For Each objItem in colItems
msgbox "Caption: " & objItem.Caption
msgbox "DeviceID: " & objItem.DeviceID
msgbox "Partitions: " & objItem.Partitions
msgbox "Size: " & objItem.Size
Next

Add all Recovery scenarios to new test through code

Dim qtApp 'As QuickTest.Application ' Declare the Application object variable

Dim qtTestRecovery 'As QuickTest.Recovery ' Declare a Recovery object variable

Dim intIndex ' Declare an index variable
' Open QuickTest and prepare objects variables

Set qtApp = CreateObject("QuickTest.Application") ' Create the Application

objectqtApp.Launch ' Start QuickTest

qtApp.New ' Open a new test

qtApp.Visible = True ' Make the QuickTest application visible

Set qtTestRecovery = qtApp.Test.Settings.Recovery ' Return the Recovery object for the current test
If qtTestRecovery.Count > 0 Then ' If there are any default scenarios specified for the test qtTestRecovery.RemoveAll ' Remove them

End If
' Add recovery scenarios

qtTestRecovery.Add "C:\Recovery.qrs", "ErrMessage", 1 ' Add the "ErrMessage" scenario as the first scenario

qtTestRecovery.Add "C:\Recovery.qrs", "AppCrash", 2 ' Add the "AppCrash" scenario as the second scenario

qtTestRecovery.Add "C:\Recovery.qrs", "ObjDisabled", 3 ' Add the "ObjDisabled" scenario as the third scenario
' Enable all scenarios

For intIndex = 1 To qtTestRecovery.Count ' Iterate the scenarios

qtTestRecovery.Item(intIndex).Enabled = True ' Enable each Recovery Scenario (Note: the 'Item' property is default and can be omitted)

Next
' Enable the recovery mechanism (with default, on errors, setting)

qtTestRecovery.Enabled = True
'Ensure that the recovery mechanism is set to be activated only after errors

qtTestRecovery.SetActivationMode "OnError"

'OnError is the default, the other option is "OnEveryStep".
Set qtApp = Nothing ' Release the Application object

Set qtTestRecovery = Nothing ' Release the Recovery object

Converting HTML Text to Plain Text

HTML and XML are very common entities in the testing/automation world. At time we are required to convert the HTML/XML to a Plain text version. Example of such a conversion can be seen below
The converted text for about HTML would be “Click on the Login link”. One example of such a situation is Reading the description text of a Step

Select the option from Context menu

' right click and select Required option
intIdx=13 'points the which option to select in the right click menu
wpfWindow("Eclipsys Gateway My").SwfWindow("Prescription Writer").SwfTable("dgOMP").Click 20,20,micRightBtn
Set WshShell = CreateObject("WScript.Shell")
For intLoop = 1 To intIdx
WshShell.sendkeys "{DOWN}"
Next
WshShell.sendkeys "{ENTER}"
Set WshShell = nothing

Find out list of Data bases in SQL (SQL Query)

sp_databases

Kill the Process if the process is under System not in User Using QTP

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "cmd /k cd\ & cd c:\windows\system32 & taskkill /F /IM ProcessName.exe"
''''' like "services.exe"

Verify whether Database is exist or not if not Create DB in SQL

if not exists(select * from sys.databases where name = 'selftest')
create database selftest ''' Here selftest is DB Name

Connect the Data Base and Retrieve the Data from tables use QTP

'Variable Declaration

Option Explicit

Dim Dsn_conn,rs,PTime,NowDate

Dim myarray,DiffADate

Dim strServer,strUid,strQry

Dim objConnection

' Action parameters

strServer=parameter("Server") ' This is Server Name

strUid=parameter("Uid") ' User Id

Set objConnection=Createobject("ADODB.Connection")

Dsn_conn= "DRIVER=SQL Server;SERVER="&strServer&";UID="&strUid&";APP=QuickTest Professional;WSID="&strServer&";Trusted_Connection=Yes"

objConnection.Open(Dsn_conn)

If err.number <> 0 Then

Reporter.ReportEvent 1 ,"DBConnection","Unable to Connect to the database"&"Err Description = " & err.Description

Else

Reporter.ReportEvent 0 ,"DBConnection","Connection Succeeded"

End If

Set rs=CreateObject("ADODB.RecordSet")

strQry = "UPDATE ELinkQueues.dbo.ELKMasterArchive SET ProcessedTime = DATEADD(""Day"", -10, ProcessedTime) WHERE (ProcessedTime IS NOT NULL) AND (Status = 2 OR Status = 3)" ' this is Query

Set rs=objconnection.execute(strQry)

Set rs=objconnection.execute("Select * from ELinkQueues.dbo.ELKMasterArchive")

rs.MoveFirst

Do While Not rs.EOF

PTime=rs.fields.item("ProcessedTime")

Exit Do

rs.movenext

Loop

rs.Close

objConnection.Close

Change the Data in XML File

Set oFSO = CreateObject("Scripting.FileSystemObject")
strApptEnterPath = "C:\Documents and Settings\krao\Desktop\environment.xml"
If CheckFileExists(strApptEnterPath) Then
Set objFile = oFSO.GetFile(strApptEnterPath)
' Checks for file attributes. This is a check for file being readonly. As the latests is taken from VSTS it will be marked as readonly. This code will uncheck the Readonly property
If objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes - 1
End If
Else
ExitAction "Fail"
End If
set objReadFile = OpenFile(strApptEnterPath,1)
strContents = objReadFile.ReadAll
iTmpLoc = Instr(strContents,"ELK_DATA_FILES" & vbcrlf & vbtab & vbtab & "")
strTmpVal = left(strContents,iTmpLoc-1)
strFinal = strTmpVal & "ELK_DATA_FILES" & vbcrlf & vbtab & vbtab & ""
strContents = replace(strContents,strFinal,"")
iTmpLoc = Instr(strContents,"")
strTmpVal = left(strContents,iTmpLoc-1)
' this is the exact if condition in the logic section.
strIfCondString = "C" & right(strTmpVal,len(strTmpVal) - 1)
strFinal = strFinal & strIfCondString & ""
strContents = replace(strContents,strTmpVal & "","")
strFinal = strFinal & strContents
objReadFile.close
set objReadFile = OpenFile(strApptEnterPath,2)
objReadFile.write strFinal
objReadFile.close
Set objReadFile = Nothing
Set objFile = Nothing
Function CheckFileExists (FilePath)
CheckFileExists = oFSO.FileExists(FilePath)
End Function
Function OpenFile (FilePath,mode)
set OpenFile = oFSO.OpenTextFile(FilePath, mode, True)
End Function

Changing the Data in Excel sheets from all cloumns and rows

Option Explicit
Rem We use "Option Explicit" to help us check for coding mistakes
Rem the Excel Application
Dim objExcel
Rem the path to the excel file
Dim excelPath
Rem how many worksheets are in the current excel file
Dim worksheetCount
Dim counter
Rem the worksheet we are currently getting data from
Dim currentWorkSheet
Rem the number of columns in the current worksheet that have data in them
Dim usedColumnsCount
Rem the number of rows in the current worksheet that have data in them
Dim usedRowsCount
Dim row
Dim column
Rem the topmost row in the current worksheet that has data in it
Dim top
Rem the leftmost row in the current worksheet that has data in it
Dim left
Dim Cells
Rem the current row and column of the current worksheet we are reading
Dim curCol
Dim curRow
Rem the value of the current row and column of the current worksheet we are reading
Dim word
Rem find the value like "Testing\ATS" with in the Cell Data
Dim mypos
Rem split the Cell data
Dim myarray
Rem Find the Local Machine Name
Dim WshNetwork
Dim Computername
set WshNetwork= WScript.CreateObject("Wscript.Network")
Computername = WshNetwork.Computername
Rem where is the Excel file located?
excelPath = "C:\Documents and Settings\krao\Desktop\Inputs.xls"
'WScript.Echo "Reading Data from " & excelPath
Dim oFSO , objFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = oFSO.GetFile(excelPath)
' Checks for file attributes. This is a check for file being readonly. As the latests is taken from VSTS it will be marked as readonly. This code will uncheck the Readonly property
If objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes - 1
End If
Rem Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")
Rem don't display any messages about documents needing to be converted
Rem from old Excel file formats
objExcel.DisplayAlerts = 0
Rem open the excel document
objExcel.Workbooks.open excelPath ', True , true
Rem How many worksheets are in this Excel documents
workSheetCount = objExcel.Worksheets.Count
'WScript.Echo "We have " & workSheetCount & " worksheets"
Rem Loop through each worksheet
For counter = 1 to workSheetCount
'WScript.Echo "Reading data from worksheet " & counter & vbCRLF
Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
Rem how many columns are used in the current worksheet
usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
Rem how many rows are used in the current worksheet
usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
Rem What is the topmost row in the spreadsheet that has data in it
top = currentWorksheet.UsedRange.Row
Rem What is the leftmost column in the spreadsheet that has data in it
left = currentWorksheet.UsedRange.Column
Set Cells = currentWorksheet.Cells
Rem Loop through each row in the worksheet
For row = 1 to (usedRowsCount-1)
Rem Loop through each column in the worksheet
For column = 0 to usedColumnsCount-1
Rem only look at rows that are in the "used" range
curRow = row+top
Rem only look at columns that are in the "used" range
curCol = column+left
Rem get the value/word that is in the cell
word = Cells(curRow,curCol).Value
Rem find the value like "Testing\ATS" with in the Cell Data
mypos=inStrRev(word,"Testing\ATS")
If mypos>=1 Then
Rem split the Cell data
myarray=Split(word,"ATS",-1,1)
If myarray(0)="D:\Testing\" Then
Rem Change the Data "D:\Testing" to "C:\Testing"
myarray(0)="C:\Testing\"
Rem Add Total Cell Data
word=myarray(0)&"ATS"&myarray(1)
Rem Enter the Modified Data in Cell
Cells(curRow,curCol).Value=word
End If
End If
Rem Change the Cell Data(machine name) other then Local machine name
If Ucase(word)= "ALP-QASIM13-2K3" Then
Cells(curRow,curCol).Value=Computername
End If
Rem display the column on the screen
'WScript.Echo (word)
Next
Next
Rem We are done with the current worksheet, release the memory
Set currentWorkSheet = Nothing
Next
objExcel.workbooks(1).save
objExcel.Workbooks(1).Close
objExcel.Quit
Set currentWorkSheet = Nothing
Rem We are done with the Excel object, release it from memory
Set objExcel = Nothing

Get the folders from "C" Drive

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFldr = objFSO.GetFolder("C:\")
Set Fldrs = objFldr.SubFolders
For Each Fldr In Fldrs
WScript.Echo Fldr
Next

Change the mode of the file Read only to Write

strApptEnterPath = "C:\Documents and settings\krao\Desktop\environment.xml"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = oFSO.GetFile(strApptEnterPath)
If objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes - 1
End If

Write the QTP Results in color

check Image for Code(just click on Image for Visible)

Kill the Process Through QTP

Killprocess = "Process name" per ex : calc.exe
Set ProcessList = GetObject("winmgmts://.").InstancesOf("win32_process")
For Each Process In ProcessList
If Process.Name = KillProcess Then
Process.Terminate
End IfNext

File Rename through QTP

dim spath,fso,f,sname
if count(wscript.arguments)<>0 then
spath=wscript.arguments(0)
set fso=createobject("scripting.filesystemobject")
'this is in the rightclick menu, so it can spare further test for existence, otherwise, you should.
if fso.fileexists(spath) then
set f=fso.getfile(spath)
sname=f.name
f.name=sname & ".original"
set f=nothing
end if
set fso=nothing
end if

Get the Results from Command prompt through QTP

Dim wShell, exec, outStr
Set wShell = CreateObject( "WScript.Shell" )
Set exec = wShell.Exec( "%comspec% /C ping google.com" )
Do While exec.Status = 0 
 If Not exec.StdOut.AtEndOfStream Then 
     outStr = exec.StdOut.ReadAll 
     If exec.ExitCode = 1 then
          msgbox "Command failed" & "-" & outStr   
   End If   
 Exit Do 
End If 
If Not exec.StdErr.AtEndOfStream Then  
  outStr = "STDERR: " & exec.StdErr.ReadAll  
  msgbox "Command failed" & "-" & outStr
   Exit Do 
End If
 'Wait 1
Loop

***************************************************
Type-2
***************************************************
SystemUtil.Run "cmd.exe","","D:\WINDOWS\system32","open"
window("object class:=ConsoleWindowClass").Type "Dir"
window("object class:=ConsoleWindowClass").Type micReturn
window("object class:=ConsoleWindowClass").Maximize
wait(1)
txt= window("object class:=ConsoleWindowClass").GetvisibleText()
print txt

window("object class:=ConsoleWindowClass").Type "Exit"
window("object class:=ConsoleWindowClass").Type micReturn  


Source:http://www.advancedqtp.com/working-with-dos-command-line/

Stop the Services through QTP

strComputer = "."
strService = " 'W32Time' "
Set objWMIService = GetObject("winmgmts:"& _ "{impersonationLevel=impersonate}!\\"& strComputer & "\root\cimv2")Set colListOfServices = objWMIService.ExecQuery("Select * from _ Win32_Service Where Name ="& strService & " ")
For Each objService in colListOfServices
objService.StopService()
Next

Note : here strService is Services Name which you are going to start. you get this name from control panel\Administrative Tools\Services... and right click and select properties on the Service , here you can find Service Name.

Start the Services through QTP

strComputer = "."
strService = " 'W32Time' "
Set objWMIService = GetObject("winmgmts:"& _ "{impersonationLevel=impersonate}!\\"& strComputer & "\root\cimv2")Set colListOfServices = objWMIService.ExecQuery("Select * from _ Win32_Service Where Name ="& strService & " ")
For Each objService in colListOfServices
objService.StartService()
Next

Note : here strService is Services Name which you are going to start. you get this name from control panel\Administrative Tools\Services... and right click and select properties on the Service , here you can find Service Name.

Changing System Date and time through QTP

newTime="03:40:00"
newDate=Date+1
Dim oShell
set oShell=CreateObject("WScript.Shell")
oShell.run "cmd /k date" &CStr(" "&newDate)&"& exit"
oShell.run "cmd /k time" &CStr(" "&newTime)&"& exit"
set oShell=nothing
curDateTime=now
msgbox curDateTime

Uninstall a Software Using VBScript , QTP

This works for uninstalling most applications. In this example I will show how AutoCAD 2005 can be uninstalled using a VBScript. Open Regedit and look in HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall search for the application and find a the product code that is in GUID format looking like this: {5783F2D7-0301-0409-0002-0060B0CE6BBA} It might be something else for you.

The code below will uninstall AutoCAD 2005 as well as Express Tools. Copy the code below into Notepad and give the file the extension vbs.

on error resume next

Set WshShell = CreateObject(”WScript.Shell”)

‘ Uninstall Express Tools

WshShell.Run “msiexec /x {5783F2D7-0311-0409-0000-0060B0CE6BBA} /q”,1,true

‘ Uninstall AutoCAD 2005

WshShell.Run “msiexec /x {5783F2D7-0301-0409-0002-0060B0CE6BBA} /q”,1,true