VBS - Sort Array

Dim A(10)
A(0) = ZZZZZ
A(1) = Abbbb
A(2) = AAAAAA

Public IsSort

Function IsSorted (Ar,sort_type)
IsSort = True
For i=0 To UBound(Ar)-1
If StrComp(Ar(i), Ar(i+1),sort_type) = 1 Then
IsSort = False
Exit Function
End If
Next
End Function


Call IsSorted(A,1)
MsgBox IsSort

Wscript Usage - Map Network Drives

'VBS to connect and disconnect network drives.
'strPath and strDrive and the shared drive path and the drive letter to be mapped.
'Assumption is that the drive letter is valid and does not contain any drives mapped to it already.
'Commented line of code can be used to disconnet the mapped network drive.

'Date Created : 07/07/2007

Set objNetwork = CreateObject("Wscript.Network")
strPath = "\\test\test"
strDrive = "D:"
objNetwork.MapNetworkDrive strDrive ,strPath

'Use the code below to remove any network drive connections

'objNetwork.RemoveNetworkDrive strDrive

Set objNetwork = Nothing

ADO Usage in Excel

'Treat Excel like Database and retrieve data from it.


On Error Resume Next

'Const adOpenStatic = 3
'Const adLockOptimistic = 3
'Const adCmdText = &H0001

Set objConnection = CreateObject("ADODB.Connection")
'Set objRecordSet = CreateObject("ADODB.Recordset")

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Documents and Settings\A032231\Desktop\Book2.xls;" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"

'objRecordset.Open "Select * FROM [Sheet1$]", _
' objConnection, adOpenStatic, adLockOptimistic, adCmdText

'strSearchCriteria = "Name = 'atl-fs-01'"
'objRecordSet.Find strSearchCriteria

'objRecordset.Close
'objConnection.Close


sql="Select * FROM [Sheet1$]"

set rs=objConnection.execute(sql)

i=0
'Get the row count from the values retrieved from the database
iRowCount = 0
Do While Not rs.EOF
iRowCount = iRowCount + 1
rs.MoveNext
Loop
If iRowCount = 0 then
MsgBox "No rows found"
else
fldCnt= rs.fields.count
rs.MoveFirst
Do While Not rs.EOF
For j= 0 To fldCnt-1
GData(j) = trim(rs.Fields(j).Value)
MsgBox GData(j)
Next
'Navigating to the next row in the database result set.
rs.MoveNext
Loop

'Close the Database Connection

objConnection.close

End If

IE DOM Usage

'Use IE DOM to create a IE obejct and login

Function Login()

Set IE = CreateObject ("InternetExplorer.Application")
IE.Visible = True
IE.Navigate2 URL

End Function

*********************************************************************

'Wait till the browser is busy with page loading, used for synchornization
Function bBusy()
Do
' wait(1)
Loop while IE.Busy = TRUE
End Function

OTA Usage:Retrieve defect Data

'Retreive Defect properties

Dim td
Dim bfact
Dim bList
Dim Sev(10000)
Dim Id(10000)
Dim openDate(10000)
Dim closeDate(10000)

'Connect to QC
Set td=createobject("TDApiOle80.TDConnection.1")
td.InitConnectionEx "http://qcbin/start_a.htm"
td.ConnectProjectEx "DEFAULT", "", "",""

'Retrieve all defects and display the summary of the defects.

Set bfact = td.BugFactory
Set bList = bfact.NewList("")
i = 0
For Each Bug In bList
intId = Bug.Field("BG_BUG_ID")
If intId = "4" Then
Id(i) = Bug.Field("BG_BUG_ID")
Sev(i) = Bug.Field("BG_SEVERITY")
openDate(i) = Bug.Field("BG_DETECTION_DATE")
closeDate(i) = Bug.Field("BG_CLOSING_DATE")
i = i + 1
End If
Next

td.DisconnectProject
td.ReleaseConnection
Set bList = Nothing
Set bfact = Nothing
Set td = Nothing

ADO Usage Sample

'Function to connect and retrieve data from tables(from Oracle)

***************************************************************************
Call createDBCon()
Call execDB()
Call verifyDBdata()
Call closeDB()

***************************************************************************

strQuery ="Select * from "

Function createDBCon()
reporter.ReportEvent micDone,"Connecting to Database",""
Set dbCon = CreateObject("ADODB.Connection")
dbCon.Open("DSN=IORA0001;UID=TDAMGR;PWD=TDAMGR123#;DBQ=IORA0001;DBA=W;APA=T;EXC=F;FEN=T;QTO=F;FRC=10;FDL=10;LOB=T;RST=T;GDE=F;FRL=F;BAM=IfAllSuccessful;MTS=F;MDI=F;CSR=F;FWC=F;PFC=10;TLO=0;")
End Function

'**********************************************************
'Execute the query passed using the DB obj created previously
'**********************************************************

Function execDB()

iRowCount = 0
set rs=dbCon.execute(strQuery1)
Set rs = Nothing

End Function

Function closeDB()
reporter.ReportEvent micDone,"Closing Database Connection",""
dbCon.close
End Function

'**********************************************************
'verify the db data after the loader process with the intial values
'**********************************************************

Function verifyDBdata()
Dim index
Dim iRowCount
iRowCount =0
set rs=dbCon.execute(strQuery2)
fldCnt= rs.fields.count
Do While Not rs.EOF
For i= 0 To fldCnt-1
dbOutput(i) = trim(rs.Fields(i).Value)
iRowCount = iRowCount+1
Next
rs.MoveNext
Loop

End Function



'Refer to Useful Links section for more information

Useful Mercury KB Article : 1

Problem ID: 33128
Product: QTP Version Not RelevantQTP 6.5QTP 8.0
Ext(s): Web


Topics: Application Error, Dr. Watson, GPF, Hang, Freeze, CrashRecognition and Interaction with Web Objects (DOM, HTML, etc.)Interaction with the System Environment
OS: Windows Platform Not Relevant
Creation Date: 27 Jul 2004
Last Modified Date:19 Aug 2007
Problem Description: System resources problems and errors occur while testing Web applications
Occasionally, some users testing Web applications experience erratic problems related to system resources that can only be recreated in their own environment. This is normally experienced on really long test runs that consume a lot of system resources and eventually produce strange and erratic behavior that can include:
· Random errors or warnings,
· Crashing of IE, Quicktest, other apps or Windows,
· Corrupted data tables, or
· Corrupt data entered into app under test.
Solution: Optimize the system environment and minimize IE periodically during the test run
First, try to optimize and simplify your system environment as much as possible (i.e., ensure a lot of free space on the C:\ drive, reinstall your Service Pack, run Windows Update, try the script on another workstation, unload all unnecessary add-ins and applications, run all resources from local hard drive, etc).
If the problems continue, minimizing and restoring the browser window from within the script may help. It has been found that minimizing, then restoring the browser window tends to free resources used by IEXPLORE.EXE (and possibly QTPro.exe). It should be noted that to do this on replay, calling the .Minimize method will not free the resources, but using device replay to click a position relative to the window (where the minimize button is) will. This method can be used to help prevent exhausting system resources on replay of demanding tests.
Note:The increase of memory usage with IEXPLORE.EXE can be seen without QuickTest Professional. When QuickTest Professional is used to replay against a Web application, the memory usage can increase at a faster rate.
The custom function below can be helpful in many cases. Note that this is provided to try but is not guaranteed to work in all situations.
1. Copy the function definition to a .vbs library file. For more information on working with a Function Library, refer to Problem ID 26025 - How to create a VBScript library file and Problem ID 22314 - How to load a VBScript library file for use with a script.
' ** Function Definition **Function FreeIEResources (BrowserTitleIn) dim WinObj, absx, absy, width1, obj Set WinObj = Description.Create() WinObj("title").Value = BrowserTitleIn WinObj("index").Value = 0 absx = Browser(WinObj).GetROProperty("abs_x") absy = Browser(WinObj).GetROProperty("abs_y") width1 = Browser(WinObj).GetROProperty("width") Set obj = CreateObject("Mercury.DeviceReplay") 'obj.MouseMove absx+width1-50,absy+10 'wait 1 obj.MouseClick absx+width1-50,absy+10, 0 ' <--- this line may need to be modified wait 1 Set obj = Nothing Window(WinObj).Restore wait 1 Set WinObj = NothingEnd Function
Note:This function is not part of QuickTest Professional. It is not guaranteed to work and is not supported by Mercury Customer Support. You are responsible for any and all modifications that may be required.
If the browser does not minimize and restore when you execute the function, you may need to adjust the coordinates used to find the browser's minimize button. The line that will need to be modified is indicated above. You can use the MouseMove method to test the coordinates. Only the part of the first argument (absx+width1-50) should need to be adjusted.
2. Load the .vbs function library for use with the script.
3. Call the function from within your script.
Example:dim BrowserTitleBrowserTitle = "Yahoo!.*"FreeIEResources (BrowserTitle)' ORFreeIEResources ("Google.*")
Note:A regular expression can be used to for the Browser title. For more information on using regular expressions, refer to Problem ID 6069 - How to use regular expressions (or wildcards).
Place a call to the function in your script well before you feel you may need to free system resources. For example, if you are running several loops, it could be placed at the end of each loop.
An example test script is attached. When you run the test script, you will need to have the Task Manager open to the Processes tab.

Mercury Encrypter Object

Set enc=CreateObject("Mercury.Encrypter")

Msgbox enc.EnCrypt ("Automation")

Set enc=Nothing

OTA : Test Case Upload in QC

Public oWorkbook
Public oSheet
Public sWorkbook
Public intShtCnt
Public wrkbk
Public intArrCnt
Public wrkbk1
Public strTestCaseDescription
Public strDesSteps(10)
Public StrExpRes(10)
Public strStepCnt(10)
Public iRowCnt2
Public iRowCnt1
Public strExcelPath
Public strTestCaseName

Public strConfg(10)
Public td
Public tf
Public tstCase
Public dsf
Public ds

iRowCnt1 = 2
iRowCnt2 = 8

'*****************************************************************************************************
' Create the Excel Object required for reference
'*****************************************************************************************************'

public Function create()
Set app = createobject ("Excel.Application")
Set create = app
End Function

'*****************************************************************************************************
' Open the Excel File using the object created
'*****************************************************************************************************'

Public Function open()
Set wrkbk = create.Workbooks.Open(strExcelPath)
Set oSheet = wrkbk.WorkSheets
Set open = wrkbk
Set oSheet = Nothing
Set wrkbk = Nothing
End Function



'*****************************************************************************************************
'Kill all the open Excel Process
'*****************************************************************************************************'

Public Function Kill_Executable(Exe_Name)
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"&Exe_Name&"'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set colProcessList = Nothing
Set objWMIService = Nothing
End Function


'*****************************************************************************************************
'Terminate all the object created
'*****************************************************************************************************'

Public Function Class_Terminate()

Set app = Nothing
Set oSht = Nothing
Set oSheet = Nothing
Set wrkbk = Nothing
Call Kill_Executable("EXCEL.EXE")


End Function

'*****************************************************************************************************
'Read data from excel file and create an input array with all expected results
'*****************************************************************************************************'

Public Function readFromExcel()
strExcelPath = strConfg(5)
intArrCnt = 0
Dim strStepValue
Set oSht = open.Sheets(2)
strTestCaseName = (oSht.Cells(iRowCnt1,2))
Do while strTestCaseName <> ""
strTestCaseDescription = (oSht.Cells(3,2))
strTestCasePath = (oSht.Cells(4,2))
strStepValue = (oSht.Cells(iRowCnt2,1))
Do while strStepValue <> ""
strStepCnt(intArrCnt) = (oSht.Cells(iRowCnt2,1))
strDesSteps(intArrCnt) = (oSht.Cells(iRowCnt2,2))
StrExpRes(intArrCnt) = (oSht.Cells(iRowCnt2,3))
iRowCnt2 = iRowCnt2 + 1
intArrCnt = intArrCnt + 1
strStepValue = (oSht.Cells(iRowCnt2,1))
Loop
Set oSht = Nothing
Exit Do
Loop
End Function


'*****************************************************************************************************
'Read data from text file regarding the QC URL and Login Details and Excel Folder Path
'*****************************************************************************************************'

Function readTextFile()
Const ForReading = 1
Dim i
Dim strTextArr
i = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("c:\testTq.txt", ForReading)
Do Until objTextFile.AtEndOfStream
strTextVal = objTextFile.Readline
strTextArr = Split(strTextVal,"=")
strConfg(i) = trim(strTextArr(1))
i = i + 1
Loop
End Function


'*****************************************************************************************************
'Upload the array elemenrts obtained from the Excel into the Quality Center.
'*****************************************************************************************************'

Function uploadQC()

Set td=createobject("TDApiOle80.TDConnection.1")
td.InitConnectionEx strConfg(0)
td.ConnectProjectEx strConfg(1),strConfg(2),strConfg(3),strConfg(4)

Set tstMgr = td.TreeManager
Set tsttr = tstMgr.NodeByPath(strTestCasePath)

'Creste testFactory object
Set tsetFact = tsttr.TestFactory

'Create new test with the sheet name
Set tstCase = tsetFact.AddItem(strTestCaseName)
tsetFact.Field("TS_DESCRIPTION") = strTestCaseDescription
'Post the new test case
tstCase.Post

'Create design steps factory object
Set dsf = tstCase.DesignStepFactory
'Iterate for the number of steps in the excel sheet
For m = 1 to intArrCnt-1

'Add individual steps into design steps along with step number, step description and expected result
Set ds = dsf.AddItem(Null)

ds.Field("DS_STEP_NAME") = strStepCnt(m)
ds.Field("DS_DESCRIPTION") =strDesSteps(m)
ds.Field("DS_EXPECTED") = StrExpRes(m)
ds.Post

Next

End Function


'*****************************************************************************************************
'Function Calls to Upload manual test cases from excel into QC
'*****************************************************************************************************'

Call readTextFile()
Call Class_Terminate()
Call readFromExcel()
Call Class_Terminate()
Call uploadQC()