The online community for software testing & quality assurance professionals
 
 
Calendar   Today's Topics
Sponsors:
Lost Password?

Home
BetaSoft
Blogs
Jobs
Training
News
Links
Downloads



Testing Tools >> HP Functional Testing / Mercury QuickTest Pro / QTP

Pages: 1 | 2 | 3 | 4 | 5 | 6 | 7 | >> (show all)
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Donate a user defined function to this topic
      #347046 - 12/13/06 07:13 AM

I found similar topic for SilkTest tool and I though it is a good iead to do it for QTP too.

It will be very nice to see the invaluable findings at one place.
May I urge other experts on this forum to contibute user define function
and the problem you faced and the tips to overcome.

To start with I have a function as below.

Get Root Element attribute's value from XML file

Code:

Function GetRootElementAttributeValueFromXML(sFileNameWithPath,sAttribute)
' Why we need to ADD 2 because each attribute followed by (=) and (")
iLenOfValue=len(sAttribute) + 2
Set doc = XMLUtil.CreateXML()
doc.LoadFile sFileNameWithPath
Set root = doc.GetRootElement()
If instr(1,root,sAttribute) <= 0 then
Reporter.ReportEvent micFail,sAttribute,"Not Found in XML file."
exitrun(0)
else
sStartPos=instr(1,root,sAttribute) + iLenOfValue
sEndPos=instr(sStartPos,root,"""")
GetRootElementAttributeValueFromXML=mid(root,sStartPos,sEndPos - sStartPos)
end if
End Function

msgbox(GetRootElementAttributeValueFromXML("c:\temp\request.xml","MerchantId"))




--------------------
Thanks,
Prashant Patel

Edited by ppat7046 (12/13/06 07:17 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347050 - 12/13/06 07:21 AM

Code:

Function PressKeyboardEnterButton(sWindowTitle)
Set WshShell = CreateObject("WScript.Shell")
WshShell.AppActivate sWindowTitle
wait(1)
WshShell.SendKeys "{ENTER}"
wait(3)
End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347053 - 12/13/06 07:25 AM

This function returns an array.
Code:

Function GetEntireValueFromSpreadSheet(sFileNameWithPath,sSheetName)

Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
sMsg="File Not Found"
If fso.FileExists(sFileNameWithPath) = False then
Reporter.ReportEvent micFail,sMsg, sFileNameWithPath
ExitAction(0)
end if

Dim objExcel,objSheet,intRow,intcol
' Declare Array
Dim tmpArray()


Set objExcel = CreateObject("Excel.Application")

' Open the file
objExcel.Workbooks.open sFileNameWithPath

' Select the worksheet
Set objSheet = objExcel.ActiveWorkbook.Worksheets(sSheetName)

' Select the used range
set r=objSheet.UsedRange
'4 is for Last Row. Subtract -1 because FIRST row is a Heading
iTotalRow=CInt(Split(r.Address, "$")(4)) - 1


' Get the total column count
iTotalCol= objSheet.Range("A1").CurrentRegion.Columns.Count

' Resize the array
ReDim tmpArray(iTotalRow,iTotalCol)


' Need to subtract -1 because loop start with 0.
For intRow= 0 to iTotalRow - 1
' Need to subtract -1 because loop start with 0. For Column.
For intcol=0 to iTotalCol - 1
' Assign to an Array.
tmpArray(intRow,intcol) = trim(objSheet.Cells(intRow + 2,intcol + 1).value)
Next
Next

' Quit Excel
objExcel.DisplayAlerts = False
objExcel.Quit
Set objExcel = Nothing
Set objSheet = Nothing


GetEntireValueFromSpreadSheet=tmpArray

End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347057 - 12/13/06 07:31 AM

This function returns an array.
Code:

Function GetDataFromDatabase(sDatabaseName,sUID,sPWD,sSQL) 'Declare the array
dim DbArray()

TotalRow=GetRowsCountFromDatabase(sDatabaseName,sUID,sPWD,sSQL)
'Create the connection string:
strConn="DRIVER={Microsoft ODBC for Oracle};SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"

'Establish the connection:
Set oConn = CreateObject("ADODB.Connection")
'Server-side cursor
oConn.CursorLocation = 2
oConn.Open strConn

'Create a recordset to hold the results
Set rs = CreateObject("ADODB.Recordset")
'Options for CursorType are: 0=Forward Only, 1=KeySet, 2=Dynamic, 3=Static (read-only)
rs.CursorType = 3
Set rs.ActiveConnection = oConn
'Execute the query and put the results into the recordset
rs.Open sSQL

NumberOfColumn=rs.fields.count

' Verify record set is not null or empty
if rs.RecordCount <= 0 then
Reporter.ReportEvent micFail,"Data NOT FOUND for SQL:",sSQL
ExitAction(0)
end if

' Resize the array
ReDim DbArray(TotalRow,NumberOfColumn)

i=0
j=0
' Assign recordset to an Array
Do While Not rs.eof
For j = 0 to NumberOfColumn - 1
DbArray(i,j)=rs.fields(j).value
Next
rs.MoveNext
i=i+1
loop

'Close the Recordset
rs.close
' Clear the connection string
Set strConn=nothing
' Clear the connection to a database
Set oConn=nothing
GetDataFromDatabase=DbArray

End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
mwsrossoModerator
Veteran


Reged: 09/30/01
Posts: 4974
Loc: Doncaster, UK
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347068 - 12/13/06 08:05 AM

Excellent Idea Prashant, I will make this a Sticky Topic.

Mark Smith.


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: mwsrosso]
      #347072 - 12/13/06 08:11 AM

Thanks Mark.

--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347075 - 12/13/06 08:18 AM

This function verifies that supplied database, uid and pwd are valid or not.
Code:

Function VerifyDatabaseNameUidPwd(sDatabaseName,sUID,sPWD)

'Create the connection string:
strConn="DRIVER={Microsoft ODBC for Oracle};SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"
'Establish the connection:
Set oConn = CreateObject("ADODB.Connection")
'Server-side cursor
oConn.CursorLocation = 2
On Error Resume Next
err.clear
oConn.Open strConn

if err.number <> 0 then
if Instr(Err.Description,"TNS:could not resolve service name") > 0 then
Call CreateUserDefineResultFile("Fail=> " & Environment("TestName"))
Reporter.ReportEvent micFail,"Either database is down or Database Name is incorrect", sDatabaseName
end if
if Instr(Err.Description,"invalid") > 0 then
Call CreateUserDefineResultFile("Fail=> " & Environment("TestName"))
Reporter.ReportEvent micFail,"Invalid Database UserId/Password", sUID & "/" & sPWD
end if

Set strConn=nothing
Set oConn=nothing
ExitAction(0)
end if
Set strConn=nothing
Set oConn=nothing
End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347078 - 12/13/06 08:22 AM

Code:

Function VerifyRowsColumnsEqualOfTwoDiemensionalArrays(arr1,arr2)

' Verify number of ROWS are equal
If ubound(arr1,1) <> ubound(arr2,1) Then
Reporter.ReportEvent micFail,"Number of ROWS not equal",ubound(arr1,1) & "<>" & ubound(arr2,1)
ExitAction(0)
End If

' Verify number of COLUMNS are equal
If ubound(arr1,2) <> ubound(arr2,2) Then
Reporter.ReportEvent micFail,"Number of COLUMNS not equal:", ubound(arr1,2) & "<>" & ubound(arr2,2)
ExitAction(0)
End If

End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
robbiewinston
Super Member


Reged: 03/06/06
Posts: 1554
Loc: Bristol, UK
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347079 - 12/13/06 08:23 AM

This function compares two arrays and checks if they match but the order is not important

(e.g. Actual Results vs Expected Results)
Code:
 '**** Compare two arrays, the order of the data is not important ****


Function CompareArraysNotOrder (arrArray1, arrArray2)

Dim intArray1, intArray2

For intArray1 = 1 to UBound (arrArray1)
For intArray2 = 1 to UBound (arrArray2)
If arrArray1 (intArray1) = arrArray2 (intArray2) Then
arrArray1 (intArray1) = "MATCHED": arrArray2 (intArray2) = "MATCHED"
Exit For
End If
Next
Next

CompareArraysNotOrder = True
For intArray1 = 1 to UBound (arrArray1)
If arrArray1 (intArray1) <> "MATCHED" Then
CompareArraysNotOrder = False
Exit For
End If
Next

End Function



Edited by robbiewinston (12/13/06 08:33 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347080 - 12/13/06 08:25 AM

sEntireFilePath is a location where you want to save the file.
BrwTitle is Title of the Browser Window.
Code:

Function SaveFileViaInternetExplorer(sEntireFilePath,BrwTitle)

Brw_Title=BrwTitle

' This is descriptive programming
sTitle="title:=" & Brw_Title & ".*"

' Select 'File menu
Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

' Slect the the 'Save As' Submenu
Browser(sTitle).WinMenu("menuobjtype:=3").Select "Save As..."

' Enter the ENTIRE path of the file
Browser(sTitle).Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(sEntireFilePath)

' Select File Type
Set WshShell = CreateObject("WScript.Shell")
wait(2)

WshShell.SendKeys "{TAB}"
wait(2)
WshShell.SendKeys "{UP}"
WshShell.SendKeys "{UP}"
Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(micReturn)
wait(2)

' Select 'File menu
Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

' Slect the the 'Close' Submenu
Browser(sTitle).WinMenu("menuobjtype:=3").Select "Close"
wait(2)

End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347084 - 12/13/06 08:33 AM

How to call this function?
set vObject=Browser().Page().WebList()
sItem="India"
call VerifyItemExistsInWebList(vObject,sItem)

Code:

Function VerifyItemExistsInWebList(vObject,sItem)
bFound=False
iTotalItem=vObject.GetROProperty("Items Count")
For i = 1 to iTotalItem
if vObject.GetItem(i) = sItem then
bFound=True
Exit for
end if
next

If bFound=False Then
Reporter.ReportEvent micFail,"Item NOT found:",sItem
VerifyItemExistsInWebList="False"
End If
End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347108 - 12/13/06 09:42 AM

Two functions that may be useful, isDefined() and Sleep(), were uploaded to another article on this forum, use this link to access them:

http://www.sqaforums.com/showflat.php?Ca...true#Post347071

The vbScript code and comments about usage are described in the article.

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347149 - 12/13/06 01:07 PM Attachment (1338 downloads)

Attachment: notepadLib.txt

1. Save as notepadLib.vbs to execute under WSH.
2. This was tested to run under both WSH and inside a QTP test.

Useful as a learning tool--or a time waster? You be the judge!

-Enjoy, Terry Horwath

------------------------------------------------------------------------------

Contains examples of:

1. Creating and then using a vbScript class.

2. Parsing strings char by char and converting CRLF combos to CR.

3. Use of CreateObject("WScript.Shell") to start an application (Notepad)
via a command line invocation.

4. Dealing with differences in QTP versus WSH runtime environments.


Overview:

The attached class library containing a few methods to open, asynchronously
write to and then close the Notepad application. The notion here was to
experiment with maintaining a realtime "progress" log, that could
be used from a QTP test (or more realistically a vbScript lib included
by many tests).

Notepad remembers its last size and location--therefore you can resize
and place it as your needs dictate. For the purpose of evaluating this
code I recommend resizing down to about 7-8 lines and placing it in
the lower right hand corner of you monitor.


Cautions and Gotchas:

Unfortunately I found that because wshell.SendKeys() blindly writes to
the currently active application (which is the only way you can write
to Notpad...) there are more than a few unreliable timing issues;
hence the sleep/wait's placed in various spots. I would not use this
in production environments. Also, if more than one Notepad is running,
results are unpreditable. You may still find it useful though as a learning
tool.


Post Extras: Print Post   Remind Me!   Notify Moderator  
thiruthanithara
Member


Reged: 10/25/06
Posts: 160
Loc: Chennai, India
Re: Donate a user defined function to this topic [Re: thorwath]
      #347296 - 12/14/06 03:54 AM

Hi,

I am posting some code's which i got from this forum in some posts while surfing through this forum.

Being posting here would help somebody rather him to search through forum

---- This function is to get Webtable index -----------

Function GetQTPTableIndex(BrowserObj, TableObj)
On Error Resume Next
domIndex = TableObj.GetROProperty("source_index")
Set allTables = BrowserObj.object.document.getElementsByTagName("TABLE")
Dim i
i = 0
For Each table In allTables
If table.sourceIndex=domIndex Then
GetQTPTableIndex=i
Exit For
End If
i = i + 1
Next
Set allTables = Nothing ' Clear object from memory.
End Function

Set QAFBROWSER = Browser("QA Forums: Problem in")
Set QAFPAGE = Browser("QA Forums: Problem in").Page("QA Forums: Problem in")
msgbox GetQTPTableIndex(QAFBROWSER, QAFPAGE.WebTable("InnerText:=Author.*","index:=0"))




How to Display results in Excel?

Where ExcPath is the path where you want the Excel document, and QTPXMLPath is the path to the Results.xml file for QTP results. You may need to adjust this if you have nested actions ... but this should give you the base idea


Public Sub GetQTPRes(ExcPath, QTPXMLPath)

Dim xmlDoc
Dim xmlActNds
Dim xmlActNd
Dim xmlStpNds
Dim xmlStpNd
Dim excApp
Dim excWS
Dim excWB
Dim scrFSO
Dim strActNm
Dim strStep
Dim strStatus
Dim bolIsFailed
Dim bolIsWarning
Dim strTmpStatus
Dim intRw

Set scrFSO = CreateObject("Scripting.FileSystemObject")
If scrFSO.FileExists(ExcPath) Then
scrFSO.DeleteFile ExcPath
End If
Set scrFSO = Nothing
Set excApp = CreateObject("Excel.Application")
With excApp
.DisplayAlerts = False
.Visible = False
If .Workbooks.Count = 0 Then
Set excWB = .Workbooks.Add
Else
Set excWB = .Workbooks(1)
End If
End With
Set excWS = excWB.Sheets(1)
intRw = 1
excWS.Name = "QTPReport"
excWS.Cells(intRw, 1) = "Action Name"
excWS.Cells(intRw, 2) = "Status"
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.async = False
xmlDoc.Load QTPXMLPath
Set xmlActNds = xmlDoc.getElementsByTagName("Action")
For Each xmlActNd In xmlActNds
intRw = intRw + 1
strActNm = xmlActNd.selectSingleNode("AName").Text
Set xmlStpNds = xmlActNd.selectNodes("Step")
bolIsFailed = False
bolIsWarning = False
For Each xmlStpNd In xmlStpNds
strTmpStatus = xmlStpNd.selectSingleNode("NodeArgs").Attributes.getNamedItem("status").Text
Select Case strTmpStatus
Case "Failed"
bolIsFailed = True
Case "Warning"
bolIsWarning = True
End Select
Next
excWS.Cells(intRw, 1) = strActNm
If bolIsFailed = True Then
excWS.Cells(intRw, 2) = "Failed"
ElseIf bolIsWarning = True Then
excWS.Cells(intRw, 2) = "Warning"
Else
excWS.Cells(intRw, 2) = "Passed"
End If
Next
With excApp

Thanks
Thiru

--------------------
Thanks
Thiru


Post Extras: Print Post   Remind Me!   Notify Moderator  
thiruthanithara
Member


Reged: 10/25/06
Posts: 160
Loc: Chennai, India
Re: Donate a user defined function to this topic [Re: thiruthanithara]
      #347297 - 12/14/06 03:57 AM

Some more Codes
________________________________________
' Return Value: Boolean
' True = String split successfully
' False = Unable to split string at designated position
'
' Input Parameters: sInputString - string to be split
' iSplitPoint - number of characters to be splitted from the beginning of the sInputString
'
' Output Parameters: sFirstPortion - Substring of the original string
' prior to the split point
' sRemainingPortion - Remaining substing of the
' original string
'
' Note: Returns false if sInputString is empty or if iSplitPoint < 0.
'
'

Function SplitStringByIndex(ByVal sInputString, ByVal iSplitPoint, _
ByRef sFirstPortion, ByRef sRemainingPortion)

Dim bReturnValue, iInputStringLen
bReturnValue = False

iInputStringLen = Len(sInputString)

If iSplitPoint > 0 And iInputStringLen > 0 Then
If iSplitPoint > iInputStringLen Then
sFirstPortion = sInputString
sRemainingPortion = ""
ElseIf iSplitPoint = 1 Then
sFirstPortion = ""
sRemainingPortion = sInputString
Else
sFirstPortion = Left(sInputString, iSplitPoint)
sRemainingPortion = Right(sInputString, (iInputStringLen - iSplitPoint))
End If
bReturnValue = True
End If

SplitStringByIndex = bReturnValue
End Function 'SplitStringByIndex
'
'
Using:
If (SplitStringByIndex("1234", 2, sFirstPortion, sRemainingPortion)) Then
MsgBox sFirstPortion
MsgBox sRemainingPortion
Else
MsgBox "Unable to split string at designated position"
End If
'
'
Using in your case:
If (SplitStringByIndex("23345645", 2, sFirstPortion, sRemainingPortion)) Then
YourVariableForComparison = sFirstPortion & “-” & sRemainingPortion
Else
MsgBox "Unable to parse innitial string"
End If






'--------------------

'#######################################################################
'# Public Function CompareFiles
'# - perform a binary comparison of two files
'#######################################################################
Public Function CompareFiles(path, file1, file2)
Const ForReading = 1, ForWriting = 2, BinaryCompare = 0
Dim fso, MyFile1, MyFile2, comp, ln1, ln2
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile1 = fso.OpenTextFile(path & "\\" & file1, ForReading)
Set MyFile2 = fso.OpenTextFile(path & "\\" & file2, ForReading)
Do While ((MyFile1.AtEndOfStream <> True) OR (MyFile2.AtEndOfStream <> True))
ln1 = MyFile1.ReadLine
ln2 = MyFile2.ReadLine
comp = strcomp( ln1, ln2, BinaryCompare)
if (comp <> 0) then
MyFile1.Close
MyFile2.Close
CompareFiles = 1
Exit Function
end if
Loop

MyFile1.Close
MyFile2.Close

CompareFiles = 0
End Function






code:
________________________________________
'' Retrieve Substring from the middle of given String.
' @param sString [String] String source to get Substring from
' @param sSubstringBefore [String] Unique known Substring before Target Substring
' @param sSubstringAfter [String] Unique known Substring after Target Substring
' @return [String] Substring between given Substrings from String
' or zero length String if Substrings parameters are not found in the SourceString
' @example s = "asdf#asdfJannawerwer6666Julia*asdfasdfwerwer"
' SimpleParsing = GetSubstringInBetween(s, "Janna", "Julia")
' DoubleParsing = GetSubstringInBetween(GetSubstringInBetween(s, "#", "*"), "Janna", "Julia")
' @require Use unique known Substring to make parsing,
' If not - first avalable match will be taken and might make a big mess in the next logic
Function GetSubstringInBetween(sString, sSubstringBefore, sSubstringAfter)
GetSubstringInBetween = ""
iPositionBeforeTarget = InStr(sString, sSubstringBefore)
If iPositionBeforeTarget < 1 Then
Exit Function
Else
iPositionBeforeTarget = iPositionBeforeTarget + Len(sSubstringBefore)
End If

iPositionAfterTarget = InStr(sString, sSubstringAfter)
If iPositionAfterTarget < 1 Then
Exit Function
End If

iCutFromRight = iPositionAfterTarget - iPositionBeforeTarget
sFoundTarget = Trim(Mid(sString, iPositionBeforeTarget, iCutFromRight))

If NOT Len(sFoundTarget) = 0 Then
GetSubstringInBetween = sFoundTarget
End If
End Function 'GetSubstringInBetween


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

Friends,
I would like to contribute this code.

Why we need this code?
I executed 15 QTP scripts via Test Batch Runner.
Now I had to OPEN each test result file for 15 scripts to see pass or fail status.

Solution
Call below functions at the end of the each script.
Code:
________________________________________

sAppResultFilePath="C:\QTP\Test1\Res1\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

Call CreateUserDefineResultFile(sFileName,sFilePath,GetPassFailStatusFromResultsXML(sAppResultFilePath))

Function GetPassFailStatusFromResultsXML(sAppResultFilePath)
Set doc = XMLUtil.CreateXML()
doc.LoadFile sAppResultFilePath

Set oDoc = doc.GetRootElement.ChildElements.ItemByName("Doc")
Set oDocSummary= oDoc.ChildElements.ItemByName("Summary")

Set SummaryAttribs = oDocSummary.Attributes()
Set FailedCount = SummaryAttribs.ItemByName("failed")
Set PassedCount = SummaryAttribs.ItemByName("passed")

If FailedCount.Value > 0 Then
GetPassFailStatusFromResultsXML= "Fail: " & Environment("TestName")
else
GetPassFailStatusFromResultsXML= "Pass: " & Environment("TestName")
End If
End Function

Function CreateUserDefineResultFile(sFileName,sFilePath,sTextToWrite)

Dim objFSO, objFolder, objShell, objTextFile, objFile
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the sFilePath folder exists
If objFSO.FolderExists(sFilePath) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFolder = objFSO.CreateFolder(sFilePath)
End If

If objFSO.FileExists(sFilePath & sFileName) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFile = objFSO.CreateTextFile(sFilePath & sFileName)
End If

set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

Set objTextFile = objFSO.OpenTextFile _
(sFilePath & sFileName, ForAppending, True)

' Writes sTextToWrite every time you run this VBScript
objTextFile.WriteLine(sTextToWrite)
objTextFile.Close
End Function


Thanks
Thiru

--------------------
Thanks
Thiru


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: thiruthanithara]
      #347416 - 12/14/06 09:10 AM

A comment/request about usefulness...

I am having a devil of a time trying to read some of the long code listing in many of the above postings.

Code pasted inline in a posting looses all of its valuable indentation. Seems it would be better to paste the code into a blah.txt file (with indendation preserved) and attach it to the posting. Then maybe provide a brief description of what's contained in the attachment in the posting.

-Just a though


Post Extras: Print Post   Remind Me!   Notify Moderator  
krytae
Member


Reged: 04/02/02
Posts: 276
Loc: South Africa
Re: Donate a user defined function to this topic [Re: thorwath]
      #347549 - 12/14/06 11:34 PM Attachment (701 downloads)

Implementation of a binary search algorithm (finds item in an ordered list). Function based on searching though a list/combo box but should be clear enough for extension to any other use (array, table, datasheet, etc).

Info on algorithm: Wikipedia - Binary Search Algorithm


Post Extras: Print Post   Remind Me!   Notify Moderator  
SteveKay
Active Member


Reged: 01/28/05
Posts: 711
Loc: England
Re: Donate a user defined function to this topic [Re: krytae]
      #347575 - 12/15/06 03:10 AM Attachment (945 downloads)

A procedure for writing to a log file.

It creates a log file called YYYYMMDD.log and puts it in a "log" subdirectory off the directory the script is running in.

I use this quite a log when debugging instead of having little msgbox's appear all over.

--------------------
Everywhere's within walking distance if you have enough time.


Post Extras: Print Post   Remind Me!   Notify Moderator  
IanFraserModerator
Super Member


Reged: 07/11/04
Posts: 2112
Loc: Brisbane
Re: Donate a user defined function to this topic [Re: ppat7046]
      #347833 - 12/17/06 03:20 PM Attachment (1938 downloads)

This is just a demo of excel read and write code.

--------------------
You can buy my Art from: "Post Cards now available"
Ian Fraser Landscape Photography
World Wide Shipping.

http://mowogman.wordpress.com/

Edited by IanF (12/17/06 04:33 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
IanFraserModerator
Super Member


Reged: 07/11/04
Posts: 2112
Loc: Brisbane
Re: Donate a user defined function to this topic [Re: IanFraser]
      #348063 - 12/18/06 05:11 PM Attachment (1129 downloads)

Are you sick of those long lines of code that QTP creates for objects. This is a Navigation file that I have created for my project.

'Set the browser

strBrowser = "PersonSearch"
strPage = "PersonSearch"

Then use a nice short line for the object

' Enter Given Name
Call BrowserWebEdit ("Given",strGivenNameSch)

Much cleaner than this

Browser("PersonSearch").Page("PersonSearch").WebEdit("Given').Set strGivenNameSch

--------------------
You can buy my Art from: "Post Cards now available"
Ian Fraser Landscape Photography
World Wide Shipping.

http://mowogman.wordpress.com/


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #348572 - 12/20/06 07:54 AM Attachment (681 downloads)

re: attached ieWindow.vbs "progress window" class

Attached is a ZIP file containing a vbScript, ieWindow.vbs, and documentation (ieWindow.pdf) to support the single Class defined in the file, ieWindow.

The purpose of this class is to create a small IE window that can be asynchronously written by any vbScript program that has included this class. While this type of window may have many applications, it is used by its author to implement a progress window that shows what is being written into the a log file during test case execution on the QTP environment.

The file containing the class also instantiates one ieWindow object, ieWin, and provides code (at the bottom of the file) to validate many of the class’ public Properties and Methods. This class contains code to support execution in both the WSH and QTP runtime environments, and was tested in both of these environments.

In it's simplest implementation the class and its single object can be used as follows:
Code:

ieWin.Open ‘create IE object and open a window
ieWin.Write “string 1”
.
.
.
ieWin.Write “string X”
ieWin.Close ‘close the window and terminate IE object


While I would like to take full credit for this design, I must admit that I shamelessly ripped-off the core concept and code came from the following (public domain) “Hey Scripting Guy!” article from Microsoft, and then added my embellishments:

http://www.microsoft.com/technet/scriptcenter/resources/qanda/mar05/hey0316.mspx

You are strongly encouraged to bookmark this extremely helpful resource and visit it from time to time, as they post about 5 articles a week to promote vbScript use.

Refer to the attached source code and the documentation for more details.

-Terry Horwath

Edited by Terry Horwath (12/20/06 08:01 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Bala79
Junior Member


Reged: 04/20/06
Posts: 3
Re: Donate a user defined function to this topic [Re: IanFraser]
      #348756 - 12/21/06 03:01 AM

HI ,

use this function to align and word wrap any excel workbook

Function fAutofit()
Dim objexcel,i,strActWB,cntW,shname
Set objexcel = getobject(,"Excel.Application")
strActWB = objExcel.ActiveWorkbook.Name
Set strFile = objExcel.Workbooks(strActWB)
cntW = strFile.Worksheets.Count
For i = 1 To cntW
shname = strFile.Worksheets(i).Name
strFile.Worksheets(shname).UsedRange.Columns.AutoFit
if strcomp(shname,"HReport",1) = 0 Then
strFile.Worksheets("HReport").Activate
strFile.Worksheets(shname).Columns("A:E").Select
objExcel.Selection.ColumnWidth = 65
objExcel.Selection.WrapText = True
'objExcel.Selection.HorizontalAlignment = xlCenter
End if
Next

Regards
Balaji


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: ppat7046]
      #349130 - 12/24/06 04:09 AM

Get your machine's IP Address:

Code:
  
Sub GetIPAddress()
Dim objShell, objExecObject, strLine, strIP

Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("%comspec% /c ipconfig.exe")

Do Until objExecObject.StdOut.AtEndOfStream
strLine = objExecObject.StdOut.ReadLine()
strIP = Instr(strLine,"Address")
If strIP <> 0 Then
Wscript.Echo strLine
End If
Loop
End Sub



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:12 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: Boulderdash]
      #349131 - 12/24/06 04:09 AM

Create Desktop Shortcut
Code:

Sub CreateDesktopShortcut(strTargetPath, strLinkName, strDescription)
Dim objShell, strDesktopFolder, objShortCut

Set objShell = WScript.CreateObject("WScript.Shell")
strDesktopFolder = objShell.SpecialFolders("AllUsersDesktop")
Set objShortCut = objShell.CreateShortcut(strDesktopFolder & "\" & strLinkName)

objShortCut.TargetPath = strTargetPath
objShortCut.Description = strDescription
objShortCut.Save
End Sub



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:12 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: Boulderdash]
      #349132 - 12/24/06 04:10 AM

Get Windows System Variable value:

Code:

Function GetSystemVariable(strSysVar)

Dim objWshShell, objWshProcessEnv

Set objWshShell = CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("Process")

GetSystemVariable = objWshProcessEnv(strSysVar)

End Function



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:19 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: Boulderdash]
      #349133 - 12/24/06 04:11 AM

Check if Windows Service is running:

Code:

Function CheckIfServiceIsRunning(strServiceName)

Dim objShell, boolStatus
Set objShell= CreateObject("Shell.Application")

' Execute command
boolStatus = objShell.IsServiceRunning(strServiceName)

CheckIfServiceIsRunning = boolStatus
End Function



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:18 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: Boulderdash]
      #349134 - 12/24/06 04:11 AM

Exectute any application/coommand via Windows Command Line (CMD)

Code:

Sub ExecuteDosCommand(strCommand)

Dim objShell
Set objShell = CreateObject("WSCript.shell")

' Execute command
objShell.run strCommand
Set objShell = Nothing

End Sub



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:16 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Boulderdash
Newbie


Reged: 12/11/04
Posts: 23
Re: Donate a user defined function to this topic [Re: Boulderdash]
      #349135 - 12/24/06 04:11 AM

Delete Key from Windows Registery.

Code:

Sub DeleteKeyFromRegistry(RegKey)
Dim objSh

Set objSh = CreateObject("WScript.Shell")
objSh.RegDelete (RegKey)
End Sub



--------------------
Boulderdash / Asaf
My blog: http://www.asaf.co.il

Edited by Boulderdash (12/24/06 04:16 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: thorwath]
      #349366 - 12/26/06 11:52 AM Attachment (567 downloads)

Subject: fileIO.vbs File I/O Class Library

Attached is a ZIP file containing a vbScript, fileIO.vbs, and supporting documentation (fileIO.pdf).

This class provides Properties and Methods for performing various operations with files and directories in the windows OS. While all of these actions can be performed using the FileSystemObject and TextStream objects available in vbScript, this class reduces the complexity of performing these actions and adds more robust error reporting.

The file containing the class also instantiates one fileIO object, fio, and provides code (at the bottom of the file) to validate many of the class’s public Properties and Methods.

Refer to the attached source code and the documentation for more details.

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #349758 - 12/28/06 07:33 PM Attachment (493 downloads)

Subject: validate email address function

Attached is a ZIP file containing a vbScript, validateEmailAddress.vbs, which contains a single function, validateEmailAddress(), and code to validate this function at the bottom of the file.

Aside from its value to validate email address syntax, it also shows how to parse chars from a string, and how to test a char for an ASCII range.

The function performs a half dozen or so tests on the passed email address string. I left my inline debug code in the function, commented out.

Note that the function currently assumes an email address can't legally start with an numeric char (0 thru 9), but includes commented out code to accept this condition. Should you feel this algorithm is deficient, please enhance it and post yours back to this thread with comments as to why you made changes.

Hopefully others will find this useful.

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: IanFraser]
      #351292 - 01/08/07 12:23 PM

Call RunStoredProcedure
Code:


Function RunStoredProcedure(StoredProcedureName)
sDatabaseName="ABC"
sUID="xyz"
sPWD="ABC_xyz"

' Create the database object
Set cm = CreateObject("ADODB.Command")
' Activate the connection.
cm.ActiveConnection = "DRIVER={Microsoft ODBC for Oracle}; " &_
"SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"


' Set the command type to Stored Procedures
cm.CommandType = 4 ' Stored Procedures
cm.CommandText = StoredProcedureName

' Define Parameters for the stored procedure
cm.Parameters.Refresh
' Pass input value. Assuming Stored Procedure requires 2 parameters
cm.Parameters(0).Value = "Prashant"
cm.Parameters(1).Value = "Patel"

' Execute the stored procedure
cm.Execute()
Set cm = Nothing

End Function




--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #351296 - 01/08/07 12:44 PM Attachment (1272 downloads)

attachment: browser_Funcs.txt Save this file as browser_Funcs.vbs on your system and
then include with test scripts as a shared library. Note if you just view this file it will
not show the CRLFs--but these will be present when the file is saved to disk.

Overview:

Attached are 13 customized Browser functions which use an associated
Window object to perform a variety of actions not available using just
the Browser object:

- BrowserIsVisible()
- BrowserIsMinimized()
- BrowserMove()
- BrowserResize()
- BrowserRestore()
- BrowserMinimize()
- BrowserSetActive()
- BrowserCount()
- BrowserClose()
- BrowserCloseAll()
- BrowserToHandle()
- BrowserOpenNew()
- BrowserSync()

There are several more functions that could be implemented, but the above are
the ones I think I will need. You could slim these functions down if you
want to forego the error checking and logging.

A special thanks (as usual) to Tarun, who recently showed me the
technique for converting a QTP Browser object to the more general purpose
QTP Window object, which has a richer set of Properties and Methods.

-Hope this helps, Terry Horwath

--------
5/8/08 updated the attached lib to correct a syntax error.


Edited by thorwath (05/07/08 05:16 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Wasim Haque
Member


Reged: 10/17/05
Posts: 398
Loc: Universe
Re: Donate a user defined function to this topic [Re: IanFraser]
      #352161 - 01/11/07 08:11 AM

Hey Guys,

Most of the people want QTP window to be minimized during the execution time, here is the function for that.

'-----------------------------------------------------------
'--FUNCTION TO MINIMIZE QTP WINDOW --
'-----------------------------------------------------------
Sub MinimizeQTPWindow()
Set qtApp = getObject("","QuickTest.Application")
qtApp.WindowState = "Minimized"
Set qtApp = Nothing
End Sub
'-----------------------------------------------------------

Thanks,
Wasim


Post Extras: Print Post   Remind Me!   Notify Moderator  
mwsrossoModerator
Veteran


Reged: 09/30/01
Posts: 4974
Loc: Doncaster, UK
Re: Donate a user defined function to this topic [Re: Wasim Haque]
      #353014 - 01/16/07 11:10 AM

Display a temporary message:

This will display for 2 seconds

Set objShell = CreateObject("Wscript.Shell")
objShell.Popup "Your Message Here", 2, "Your Title Here"
set objShell = Nothing

Mark Smith.


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #353265 - 01/17/07 09:02 AM Attachment (468 downloads)

attachment: screenSize.txt Save this file into a new QTP testcase to execute.

Overview:

Attached are a few related functions that will return the size of your Primary and Secondary monitor screen sizes, in pixels:

- getScreenWidth() 'Primary monitor
- getScreenHeight()

- getScreenWidth2() 'Secodary monitor
- getScreenHeight2()

These functions gracefully handle (or are at least suppose to!) the following Secondary monitor situations:

1. The system only has one monitor
2. The system has two monitors, but the secondary is disabled (happens often with dual monitor laptops, when the laptop is closed and connected to the Primary monitor).

In all situations if either monitor is not enabled (I am not sure if this ever occurs for the Primary monitor) the height and width for that monitor is returned as 0.

There is test code at the bottom of the attached file to validated these functions.

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
Tarun LalwaniModerator
Veteran


Reged: 07/21/05
Posts: 15329
Loc: Milwaukee, Wisconsin
Re: Donate a user defined function to this topic [Re: mwsrosso]
      #353266 - 01/17/07 09:02 AM

On behalf of JeremyDFry

I haven't seen any code posted on this forum dealing with this (but I haven't looked too hard either), so I figured I would share ... this is an example of connecting to Excel via ADO.

Code:
 

'Example of use ++++++++++++++++++++++++++++++++++++++++++++++++++++
'1. Create Excel workbook "C:\Test.xls"
'2. Create Worksheet with name "MyTestSheet"
'3. At row one column A, type in "TestColumnOne"
'4. At row one column B, type in "TestColumnTwo"
'5. Fill in some data for the two columns
'6. Close Excel
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Rules/Guidelines for Excel sheet
'
'1. Don't use spaces in column headings
'2. Don't use special characters (except underscore)
'3. Don't use numeric characters
'4. Keep column names unique
'5. There is a limit on sheet name length, but I don't remember
' what it is
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Requires msexcl40.dll and QTP to utilize environment info
'Allows for letting Excel drive the test on a PC that doesn't have
'Excel installed
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Public Const

Public Const adUseClient = 3
Public Const adOpenKeyset = 1
Public Const adLockOptimistic = 3
Public Const adCmdText = 1
Public Const adOpenForwardOnly = 0
Public Const adLockReadOnly = 1
Public Const adOpenDynamic = 2

Dim adoRS
Dim strSQL

strSQL = "SELECT [TestColumnOne], [TestColumnTwo] FROM [MyTestSheet$]"

Set adoRS = ExecExcQry("C:\Test.xls",strSQL)

Do While Not adoRS.EOF
'Process Some Code Here
SetAllEnvVarsFromRS adoRS
MsgBox "Col One Val : " & Environment("TestColumnOne") & "|||Col Two Val : " & Environment("TestColumnTwo")
adoRS.MoveNext
Loop

Public Function GetExcConnStr(ExcWBFilePath)

GetExcConnStr = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & _
ExcWBFilePath & ";ReadOnly=False"

End Function

Public Function ExecExcQry(ExcelWBFilPth, ExcelSQL)

Dim adoExcConn 'As ADODB.Connection
Dim adoExcRS 'As ADODB.Recordset

Dim strExcConn 'As String

strExcConn = GetExcConnStr(ExcelWBFilPth)

Set adoExcConn = CreateObject("ADODB.Connection")
Set adoExcRS = CreateObject("ADODB.Recordset")

With adoExcConn
.ConnectionString = strExcConn
.CursorLocation = adUseClient
.Open
End With

adoExcRS.Open ExcelSQL, adoExcConn, adOpenKeyset, adLockOptimistic

Set ExecExcQry = adoExcRS

End Function
Public Sub SetEnvVarToRSFldVal(EnvName, RSFldName, RSObject)

If IsNull(RSObject.Fields(RSFldName).Value) Then
Environment.Value(EnvName) = ""
Else
Environment.Value(EnvName) = RSObject.Fields(RSFldName).Value
End If

End Sub
Public Sub SetAllEnvVarsFromRS(RecordSetObject)

Dim adoField

For Each adoField In RecordSetObject.Fields
SetEnvVarToRSFldVal adoField.Name, adoField.Name, RecordSetObject
Next
Set adoField = Nothing

End Sub





--------------------
Regards,
Tarun
** First ever technical novel - And I thought I knew QTP! **
** Download QTP Unplugged 2nd Edition eBook for FREE **

KnowledgeInbox RSS


Post Extras: Print Post   Remind Me!   Notify Moderator  
LawrenceTing
Member


Reged: 06/10/04
Posts: 73
Re: Donate a user defined function to this topic [Re: thiruthanithara]
      #353829 - 01/19/07 12:30 AM

Quote:

Some more Codes
________________________________________

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

Friends,
I would like to contribute this code.

Why we need this code?
I executed 15 QTP scripts via Test Batch Runner.
Now I had to OPEN each test result file for 15 scripts to see pass or fail status.

Solution
Call below functions at the end of the each script.
Code:
________________________________________

sAppResultFilePath="C:\QTP\Test1\Res1\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

Call CreateUserDefineResultFile(sFileName,sFilePath,GetPassFailStatusFromResultsXML(sAppResultFilePath))

Function GetPassFailStatusFromResultsXML(sAppResultFilePath)
Set doc = XMLUtil.CreateXML()
doc.LoadFile sAppResultFilePath

Set oDoc = doc.GetRootElement.ChildElements.ItemByName("Doc")
Set oDocSummary= oDoc.ChildElements.ItemByName("Summary")

Set SummaryAttribs = oDocSummary.Attributes()
Set FailedCount = SummaryAttribs.ItemByName("failed")
Set PassedCount = SummaryAttribs.ItemByName("passed")

If FailedCount.Value > 0 Then
GetPassFailStatusFromResultsXML= "Fail: " & Environment("TestName")
else
GetPassFailStatusFromResultsXML= "Pass: " & Environment("TestName")
End If
End Function

Function CreateUserDefineResultFile(sFileName,sFilePath,sTextToWrite)

Dim objFSO, objFolder, objShell, objTextFile, objFile
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the sFilePath folder exists
If objFSO.FolderExists(sFilePath) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFolder = objFSO.CreateFolder(sFilePath)
End If

If objFSO.FileExists(sFilePath & sFileName) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFile = objFSO.CreateTextFile(sFilePath & sFileName)
End If

set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

Set objTextFile = objFSO.OpenTextFile _
(sFilePath & sFileName, ForAppending, True)

' Writes sTextToWrite every time you run this VBScript
objTextFile.WriteLine(sTextToWrite)
objTextFile.Close
End Function

-----------------------------------

I place the piece of code to the end of my script, but it always prompts the following message "Failed to load the XML file. Check if the file path, URL, or XML file is valid." after playback, if I use the code to read the another existed xml file, it is successful. I doubt the gap of time is existed between the time of generated result.xml and read it, I add another piece of code to judge whether the result.xml is existed before loadfile, it shows the xml file is ready, I don't know why failed to load the xml file? please help.

Post Extras: Print Post   Remind Me!   Notify Moderator  
Turbografx
Super Member


Reged: 10/21/05
Posts: 1756
Loc: London, U.K
Re: Donate a user defined function to this topic [Re: thorwath]
      #353862 - 01/19/07 03:10 AM

Format

Many posts on the forum ask how to format dates/times etc. This would be easy to do using the VB/VBA function FORMAT. The usual approach is to manipulate the VBScript FormatDateTime function.

You can however make use the EXCEL worksheet functions to get around this :

Code:
 
Public Function FormatDate(Mydate,MyFormat)
set oExcel = createobject("excel.application")
FormatDate = oexcel.text(MyDate,MyFormat)
Set OExcel = Nothing
End Function





Post Extras: Print Post   Remind Me!   Notify Moderator  
maxj
Active Member


Reged: 01/14/04
Posts: 825
Loc: UK
Re: Donate a user defined function to this topic [Re: LawrenceTing]
      #353864 - 01/19/07 03:25 AM

Quote:


I place the piece of code to the end of my script, but it always prompts the following message "Failed to load the XML file. Check if the file path, URL, or XML file is valid." after playback, if I use the code to read the another existed xml file, it is successful. I doubt the gap of time is existed between the time of generated result.xml and read it, I add another piece of code to judge whether the result.xml is existed before loadfile, it shows the xml file is ready, I don't know why failed to load the xml file? please help.




The reason why it doesn't work because you have set your filepath to read from the Res1 folder. QTP generates a new 'Res' folder every time you execute the test from scratch. Or is this the way you have set it up to continuously use the 'Res1' folder?

--------------------
I like what i know and I know what i like


Post Extras: Print Post   Remind Me!   Notify Moderator  
AlexSigal
Member


Reged: 09/24/02
Posts: 52
GetComputerProperties [Re: maxj]
      #354276 - 01/22/07 07:10 AM

Public function GetComputerProperties ()
Dim objNet, strInfo
On Error Resume Next

'In case we fail to create object then display our custom error

Set objNet = CreateObject("WScript.NetWork")

strInfo = "User Name is " & objNet.UserName & vbCRLF & _
"Computer Name is " & objNet.ComputerName & vbCRLF & _
"Domain Name is " & objNet.UserDomain
'MsgBox strInfo

Set objNet = Nothing 'Destroy the Object to free the Memory
GetComputerProperties=strinfo
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
AlexSigal
Member


Reged: 09/24/02
Posts: 52
Re: Get Disk Data [Re: AlexSigal]
      #354277 - 01/22/07 07:11 AM

Public function GetDiskData()
' Get the disk data
extern.Declare micLong, "GetDiskFreeSpace", "kernel32.dll", "GetDiskFreeSpaceA", micString+micByref, micLong+micByref, micLong+micByref,micLong+micByref,micLong+micByref
Dim Sectors, Bytes, FreeC , TotalC ,Total , Freeb
Sectors = 255
Bytes = 255
FreeC = 255
TotalC = 255
SpaceAvailable = extern.GetDiskFreeSpace("c:\",Sectors, Bytes, FreeC, TotalC)
Total = TotalC * Sectors * Bytes
Freeb = FreeC * Sectors * Bytes
msgBox Sectors
msgBox Bytes
msgBox FreeC
msgBox TotalC
msgbox Total
msgBox Freeb
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
manuhr
Newbie


Reged: 01/18/07
Posts: 5
Re: Donate a user defined function to this topic [Re: thiruthanithara]
      #354472 - 01/23/07 04:05 AM

Hi Thiru ,

I was using the code u have given to see the test result .

sAppResultFilePath="C:\QTP\Test1\Res1\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

doc.LoadFile sAppResultFilePath

Upon calling the function QTP alerts me that it cannot access the file as this file is beening used by another process.
Plz clarify me ....

Thanx ,
Mahendra


Post Extras: Print Post   Remind Me!   Notify Moderator  
LawrenceTing
Member


Reged: 06/10/04
Posts: 73
Re: Donate a user defined function to this topic [Re: maxj]
      #354662 - 01/23/07 07:29 PM

Quote:


The reason why it doesn't work because you have set your filepath to read from the Res1 folder. QTP generates a new 'Res' folder every time you execute the test from scratch. Or is this the way you have set it up to continuously use the 'Res1' folder?




Yes, I always use the 'Res1' folder for every time, I don't know why it still says the xml file can't be found.


Post Extras: Print Post   Remind Me!   Notify Moderator  
LawrenceTing
Member


Reged: 06/10/04
Posts: 73
Re: Donate a user defined function to this topic [Re: manuhr]
      #354663 - 01/23/07 07:30 PM

Quote:

Hi Thiru ,

I was using the code u have given to see the test result .

sAppResultFilePath="C:\QTP\Test1\Res1\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

doc.LoadFile sAppResultFilePath

Upon calling the function QTP alerts me that it cannot access the file as this file is beening used by another process.
Plz clarify me ....

Thanx ,
Mahendra




Same problem with me.


Post Extras: Print Post   Remind Me!   Notify Moderator  
krytae
Member


Reged: 04/02/02
Posts: 276
Loc: South Africa
Re: Donate a user defined function to this topic [Re: LawrenceTing]
      #354675 - 01/23/07 09:50 PM

If you're trying to access the results file of the test that is being executed in QTP you will get the "access denied" error as it is locked by QTP as it is in the process of writing to it.

Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #354801 - 01/24/07 08:56 AM

Subject: BrowserCount()

The following thread shows two techniques for counting the current number of open browsers. The first one, using WMI has performance advantages over the 2nd. See the thread for the code examples and more details:

http://www.sqaforums.com/showthreaded.php?Cat=0&Number=354800

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: LawrenceTing]
      #355407 - 01/28/07 11:24 AM

Thiruthanithara,

I really appreciate that you have copied my function here.
QTP: Get Pass Fail Status From Results.xml file #345155 - 12/05/06 08:29 AM

I am sorry that I have not clarified in more detail how to use this function. Please follow the steps in order.

STEPS:
1)Lets say I have 3 Test scripts: Test1, Test2, and Test3 and I keep them under C:\QTP folder.
2)I will Delete all Results folder from C:\QTP. Why I need to do this because when each script gets executed it will create Result folder call Res. (Use Test Deletion Utility)
3)Execute 3 above scripts via Test Batch Runner
4) Run the below Function by passing following parameter

sAppResultFilePath="C:\QTP\Test1\Res\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

Call CreateUserDefineResultFile(sFileName,sFilePath,GetPassFailStatusFromResultsXML(sAppResultFilePath))

NOTE:
You can implement the logic to call this function in “for loop” for each Test.
I have Excel Spreadsheet, which has all Test scripts name that I want to run so I read value from excel sheet then on fly I create value for “sAppResultFilePath”.

Quote:

Quote:

Some more Codes
________________________________________

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

Friends,
I would like to contribute this code.

Why we need this code?
I executed 15 QTP scripts via Test Batch Runner.
Now I had to OPEN each test result file for 15 scripts to see pass or fail status.

Solution
Call below functions at the end of the each script.
Code:
________________________________________

sAppResultFilePath="C:\QTP\Test1\Res1\Report\Results.xml"
sFileName="Test-Result.txt"
sFilePath="C:\Temp\"

Call CreateUserDefineResultFile(sFileName,sFilePath,GetPassFailStatusFromResultsXML(sAppResultFilePath))

Function GetPassFailStatusFromResultsXML(sAppResultFilePath)
Set doc = XMLUtil.CreateXML()
doc.LoadFile sAppResultFilePath

Set oDoc = doc.GetRootElement.ChildElements.ItemByName("Doc")
Set oDocSummary= oDoc.ChildElements.ItemByName("Summary")

Set SummaryAttribs = oDocSummary.Attributes()
Set FailedCount = SummaryAttribs.ItemByName("failed")
Set PassedCount = SummaryAttribs.ItemByName("passed")

If FailedCount.Value > 0 Then
GetPassFailStatusFromResultsXML= "Fail: " & Environment("TestName")
else
GetPassFailStatusFromResultsXML= "Pass: " & Environment("TestName")
End If
End Function

Function CreateUserDefineResultFile(sFileName,sFilePath,sTextToWrite)

Dim objFSO, objFolder, objShell, objTextFile, objFile
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the sFilePath folder exists
If objFSO.FolderExists(sFilePath) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFolder = objFSO.CreateFolder(sFilePath)
End If

If objFSO.FileExists(sFilePath & sFileName) Then
Set objFolder = objFSO.GetFolder(sFilePath)
Else
Set objFile = objFSO.CreateTextFile(sFilePath & sFileName)
End If

set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

Set objTextFile = objFSO.OpenTextFile _
(sFilePath & sFileName, ForAppending, True)

' Writes sTextToWrite every time you run this VBScript
objTextFile.WriteLine(sTextToWrite)
objTextFile.Close
End Function






--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
Christian Grzelka
Active Member


Reged: 02/02/05
Posts: 740
Loc: Bordeaux, France
Re: Donate a user defined function to this topic [Re: ppat7046]
      #355471 - 01/29/07 02:05 AM Attachment (2305 downloads)

Here is a class, with only one public function to get a file from QC :
attached to the current test in the current test set
Or attached to the current test set
Or attached to the current test (in Test Plan)
Or attached to any test subject (in Test Plan)
Or attached to any test (In Test Plan)
Or attached to any test set folder (in Test Lab)
Or attached to any test set (in Test lab)

You can also get a file from a regular file system (the function checks that the file exists).

If the attached file exists, it is downloaded and the function returns its name on the local file system.

If something goes wrong, the function logs a micFail event.


Post Extras: Print Post   Remind Me!   Notify Moderator  
IanFraserModerator
Super Member


Reged: 07/11/04
Posts: 2112
Loc: Brisbane
Framework Demo MkII [Re: ppat7046]
      #356492 - 02/01/07 05:15 PM Attachment (344 downloads)

QTP Script BookFlightDemoII.

This script will now only run in QTP 9.1 you should be able to backward engineer the script. You need to convert it to full DP objects and create a new script in your version QTP and include all the files below.

--------------------
You can buy my Art from: "Post Cards now available"
Ian Fraser Landscape Photography
World Wide Shipping.

http://mowogman.wordpress.com/


Post Extras: Print Post   Remind Me!   Notify Moderator  
rscholz660
Super Member


Reged: 12/05/06
Posts: 1556
Loc: Germany, Dresden
Get ItemIndex in List View via Name of an SubItem [Re: IanFraser]
      #356657 - 02/02/07 07:32 AM

'==========================================================
Function GetListViewItemIndex_by_SubItem (f_ObjectName, f_ItemColumn, f_SubItemName)
'==========================================================

With f_ObjectName
For i = 0 to .GetROProperty("items count") -1
.Select i
If InStr(1,.GetSubItem (i,f_ItemColumn), f_SubItemName) Then
GetListViewItemIndex_by_SubItem = i
Exit Function
End If
Next
End with

GetListViewItemIndex_by_SubItem = -1

End Function
'==========================================================

RegisterUserFunc "TListView", "GetListViewItemIndex_by_SubItem", "GetListViewItemIndex_by_SubItem"
RegisterUserFunc "WinListView", "GetListViewItemIndex_by_SubItem", "GetListViewItemIndex_by_SubItem"


'The last will register this function to the ListObjects you need...



The function returns the (first found) Index of the MainItem containing the searched SubItem. If the SubItem not found the Function returns the value "-1"

--------------------
http://qcmt.pc-polis.de

de omnibus dubitandum

For all Questions: Please be sure to take a look at the QTP Manual before posting any Questions, thanks for doing this

Edited by rscholz660 (02/02/07 07:39 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
rscholz660
Super Member


Reged: 12/05/06
Posts: 1556
Loc: Germany, Dresden
another simple way to get the screen-res [Re: thorwath]
      #356868 - 02/04/07 11:49 PM

'========================
Public Function get_res()
'========================
Set progman = Description.Create
progman("Object Class").Value = "Progman"
progman("Object Class").regularexpression = False
progman("Text").Value = "Program Manager"
progman("Text").regularexpression = False
get_res = Window(progman).GetROProperty ("width") & "*" & Window(progman).GetROProperty ("height")
End Function

--------------------
http://qcmt.pc-polis.de

de omnibus dubitandum

For all Questions: Please be sure to take a look at the QTP Manual before posting any Questions, thanks for doing this


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #358058 - 02/08/07 02:02 PM Attachment (509 downloads)

attachment: userInput.zip

Overview:

The attached zip file contains userInput.txt, that has an class that contains a couple of user input functions--useful if you want a QTP script that asks the user at runtime for values to use during (or more likely at the start of) test execution.

Tests that interact like this have limited value, but once in while when you need to write one, these functions (or some version of these functions that you craft) may come in handy.

userInput.txt was copied from, and validated in, a QTP 8.2 test. It currently provides code at the end of the file that validates the object and its functions. Hack and hew as you see fit.

There is also a one page document that provides terse help.

-Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
capcap
Member


Reged: 10/16/06
Posts: 66
Re: Donate a user defined function to this topic [Re: IanFraser]
      #359345 - 02/14/07 06:33 AM

Check if the string is of this pattern
'Example : Check(strHTML,[0-9].*)
'*******************************************************************************************************************

Function Check(strHTML,pat)

strHTML = trim(strHTML)

Dim objRegExp, retVal
Set objRegExp = New Regexp

objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = pat

'Replace all HTML tag matches with the empty string
retVal = objRegExp.Test(strHTML) ' Execute search.
If retVal Then
RegExpTest = True
Else
RegExpTest = False
End If

Check = retVal 'Return the value of strOutput

Set objRegExp = Nothing
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
capcap
Member


Reged: 10/16/06
Posts: 66
Re: Donate a user defined function to this topic [Re: capcap]
      #359347 - 02/14/07 06:35 AM

Finds all the checkboxes in the parent object and clicks on them all.
'Example : ClickAllCheckBoxs(Browser("BNAME"),"on")
'*******************************************************************************************************************
Sub ClickAllCheckBoxs(object,to_do)

Rem: Creates the checkbox description object
set CheckDesc = Description.Create()
CheckDesc("micclass").Value = "WebCheckBox"

Rem: More values can be added here such as
CheckDesc("disabled").Value = 0

Rem:What to do with the checkbox
if (to_do = "on") then
to_do ="on"
Else
to_do = "off"
End if

Set list = object.ChildObjects(CheckDesc)
Rem: Run on all enabled checkbox's and click on them
For i=0 to list.count -1
list(i).set to_do
Next
End Sub


Post Extras: Print Post   Remind Me!   Notify Moderator  
Beginner1234
Advanced Member


Reged: 01/30/07
Posts: 459
Re: Donate a user defined function to this topic [Re: capcap]
      #361146 - 02/21/07 03:36 PM Attachment (447 downloads)

Here is a small function (attached) to enter the value in the object if the value is entered in DataTable.

This function works for only "WebEdit" and "WebList" objects.

For Example, if user want to populate data like "FirstName","LastName" etc in the application. And if the user has already parameterized these variables using DataTable then the user can call this function.

This function check if a value is enter in DataTable or not. If not, then it wont do anything. If yes, then it will enter that value in the specified object and will report that too.

For Example, you have a TextField FirstName in your application. And in LocalSheet of that action, you have a column FName. Then you can call this function like this.

'******************************************************
sName=DataTable("FName",dtLocalSheet)
set sFirst = Browser("B").Page("P").WebEdit("FirstName")

call PopulateDataFromTable(sName,sFirst,"First Name")
'********************************************************

'this comes handy where we have to enter Data if and only if it is provided in the Datatable, otherwise leave the default values in the fields.

Edited by Beginner1234 (02/21/07 03:38 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
IanFraserModerator
Super Member


Reged: 07/11/04
Posts: 2112
Loc: Brisbane
An Example of Common TE Objects [Re: ppat7046]
      #364545 - 03/07/07 03:30 PM Attachment (403 downloads)

The attached txt file is an example of common code snipits for TE sessions. Its not a full list of what I use on TE projects. But its enough to help you in the right direction. Save it as a .vbs file and include in the Resource panel of QTP.

--------------------
You can buy my Art from: "Post Cards now available"
Ian Fraser Landscape Photography
World Wide Shipping.

http://mowogman.wordpress.com/


Post Extras: Print Post   Remind Me!   Notify Moderator  
JeremyDFry
Member


Reged: 05/12/04
Posts: 302
Loc: Lakeland, FL
Re: An Example of Common TE Objects [Re: IanFraser]
      #366058 - 03/14/07 11:05 AM

here is a snipit for clicking on a java menu ... utilizes building dynamic qtp DP code and the Execute statement.

Code:


Public Sub ClickJavaMenuItem(MenuPath)

Dim strPathArr
Dim strJavaCode

Dim strItem

strPathArr = Split(MenuPath,"|")
strJavaCode = "JavaWindow(" & Chr(34) & "class description:=window" & Chr(34) & _
"," & Chr(34) & "path:=TRexFrame;" & Chr(34) & ")"
For Each strItem In strPathArr
strJavaCode = strJavaCode & ".JavaMenu(" & Chr(34) & _
"class description:=menu_item" & Chr(34) & "," & Chr(34) & _
"label:=" & strItem & Chr(34) & ")"
Next
strJavaCode = strJavaCode & ".Select"
Execute strJavaCode

End Sub




--------------------
JFry


Post Extras: Print Post   Remind Me!   Notify Moderator  
IanFraserModerator
Super Member


Reged: 07/11/04
Posts: 2112
Loc: Brisbane
Excel Read Write Demo. [Re: ppat7046]
      #367250 - 03/20/07 02:42 PM Attachment (344 downloads)

The attached file has a folder with 2 files in it unzip the file to C:\

Client.xls has two sheets "Client_Creation" and "Read_Sheet" Note this is a shared Excel file.

XLTest.txt rename this file to XLTest.vbs

When you run XLTest.vbs it will read the data and column headings from the "Read_Sheet" and write them to "Client_Creation" I have this in a Do While so that it will write 3 rows of data. If the "Client_Creation" sheet does not exist it will be created.

I would like to see a demo of ADO doing the same thing to compare performance. So if any of you ADO Wiz's out there want to play then drop a demo back in this thread.

--------------------
You can buy my Art from: "Post Cards now available"
Ian Fraser Landscape Photography
World Wide Shipping.

http://mowogman.wordpress.com/


Post Extras: Print Post   Remind Me!   Notify Moderator  
abrakh
Junior Member


Reged: 10/17/05
Posts: 352
Re: Excel Read Write Demo. [Re: IanFraser]
      #368354 - 03/26/07 09:36 AM

People who are loosing indentation while copying the code snippetes from here to QTP can use a workaround to copy the code to MS word and then copy from MSword to QTP .. this will hopefully preserve indentation.

Post Extras: Print Post   Remind Me!   Notify Moderator  
JustHuman
Advanced Member


Reged: 04/06/05
Posts: 520
Loc: Maryland
Re: Donate a user defined function to this topic [Re: IanFraser]
      #370489 - 04/03/07 06:10 AM

Would be nice if more time was spent adding comments to help those that can not read the code.

--------------------
Alfredo R. Rivera
IT Principal SDLC Automation Subject Matter Expert
(CCRC/CQ/CQTM/RMT/RFT/RPT/REQPRO)
(LR/QTP/CQ/SS/WR)
Certified Mercury Interactive Instructor
Certified Tester, Foundation Level (CTFL)
www.fredotech.com
www.testingframework.com
www.automationtesting.org
http://www.linkedin.com/in/fredotech


Post Extras: Print Post   Remind Me!   Notify Moderator  
Jonty
Super Member


Reged: 01/17/07
Posts: 1267
Loc: India
Re: Donate a user defined function to this topic [Re: IanFraser]
      #370736 - 04/04/07 02:08 AM

' Date Created : 06/06/2006

'Function to Query the database using the ODBC drivers and populate the results into an Excel sheet created for that table with all formatting.

Dim mydb, objXL

Set mydb = CreateObject("ADODB.Connection")

Set objXL = CreateObject("Excel.Application")

objXL.Visible = TRUE
objXL.WorkBooks.Add
objXL.Columns(1).ColumnWidth = 25
objXL.Columns(2).ColumnWidth = 25
objXL.Columns(3).ColumnWidth = 25

'Specify the column names

objXL.Cells(1, 1).Value = "Col1"
objXL.Cells(1, 2).Value = "Col2"
objXL.Cells(1, 3).Value = "Col3"

'Format Cells
objXL.Range("A1:C1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Interior.ColorIndex = 1
objXL.Selection.Interior.Pattern = 1
objXL.Selection.Font.ColorIndex = 2

objXL.Application.Visible = True
'Database Connect to specified in the environment variable DSN
'Connection String to be used.
mydb.Open(Environment.value("DSN"))
'Database Query to be executed.
sql = Environment.value("QUERY")
set rs=mydb.execute(sql)
r = 1
ar = split(sql," ",-1,1)
If ar(1) <> "*" Then
r = r + 1
i = 1
While lcase(ar(i)) <> "from"
objXL.Cells(r, i).Value = ar(i)
i = i + 1
Wend
End If
While not rs.EOF
r = r + 1
For i = 0 to rs.fields.count - 1
objXL.ActiveSheet.Cells(r, i+1).Value = rs.fields(i).value
Next
rs.movenext
Wend
'objXL.ActiveWorkbook.SaveAs("C:\File1.xls")
'objXL.Application.quit
'Set objXL = Nothing
mydb.close

--------------------
Cheers
Jonty..
-- Here to Learn and share ---


Post Extras: Print Post   Remind Me!   Notify Moderator  
Erik_Johansen
Member


Reged: 10/13/06
Posts: 194
Loc: Norway
Re: Donate a user defined function to this topic [Re: Jonty]
      #373053 - 04/13/07 04:08 AM

Function converts any number to a "Valutanumber"
Examples:
1000 becomes 1.000
1000000 becomes 1.000.000 and so on


'****************************************
Function formatToValuta(numberStr)

strLength = Len(numberStr)

Do While (strLength > 3)
formatToValuta = "." & right(numberStr, 3) & formatToValuta
strLength = strLength - 3
numberStr = left(numberStr, strLength)
Loop

formatToValuta = numberStr & formatToValuta

End Function

--------------------
- How many testers do you need to switch a light bulb? None, we just report it's dark -


Post Extras: Print Post   Remind Me!   Notify Moderator  
MalleswariQA
Member


Reged: 07/20/04
Posts: 192
Loc: UK
Re: Donate a user defined function to this topic [Re: Erik_Johansen]
      #373611 - 04/16/07 10:15 PM

Function to validate the Sort Order

Usage : CheckSortByOrder(arrCheck,"Ascending")

Code:
  

Function CheckSortByOrder(arrList,Order)

Dim itemIndex,itemsCnt,Flag,chkVal1,chkVal2,Item1,Item2,intBound

For itemIndex = Lbound(arrList) To Ubound(arrList)-1
'get item1 to check with
Item1=arrList( itemIndex)
'get item2 to compare with item1
Item2=arrList(itemIndex+1)
For intBound=1 to len(arrList( itemIndex))
chkVal1=Left(Item1,intBound)
'get the value to compare the sort
chkVal2=Left(Item2,intBound)
'check the sort
If Not (StrComp(chkVal1,chkVal2) = 0) Then
Select Case Order

Case "Ascending"

If Right(chkVal1,1) < Right(chkVal2,1) Then
blnFlag="True"
Exit For
Else
blnFlag="False"
CheckSortByOrder="UnSorted"
Exit Function
End If

Case "Decending"

If Right(chkVal1,1) > Right(chkVal2,1) Then
blnFlag="True"
Exit For
Else
blnFlag="False"
CheckSortByOrder="UnSorted"
Exit Function
End If

End Select

End If
Next
Next
If blnFlag= "True" Then
CheckSortByOrder="Sorted"
End If
End Function




--------------------
Malleswari.


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: MalleswariQA]
      #373739 - 04/17/07 05:22 AM

Working with a C-like array of data structures (using Dictionary objects) as opposed to using a multidimensional array:

http://www.sqaforums.com/showflat.php?Cat=0&Number=373732&Main=348942#Post373732


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: thorwath]
      #374294 - 04/19/07 06:14 AM Attachment (279 downloads)

Random Array Functions

Attached is a vbScript file (you need to rename it to randArray.vbs to execute under WSH) that contains two functions I just wrote that allows me to randomize how I process arrays and Dictionary's in my test scripts.

Using these I no longer need to always process arrays from 0 to Ubound(), nor do I need to iterate keys in the same order each time that are returned from Dictionary.Keys().

Below is an overview of these functions. The file provides a bit more detail, along with code I used under WSH to test these functions (note: use the windows WSH "cscript randArray.vbs" command, in a DOS window to execute this file and you will get a much more useful output than using wScript or double clicking).

-Terry Horwath
Code:

'******************************************************************************
'
' randArray(iMin, iMax)
'
' This function returns an array containing randomly order values between iMin
' and iMax. For example if called with iMin=0 and iMax=2 an array with one of
' the following value scrambles will be returned: (0,1,2) (0,2,1) (2,1,0), etc.
'
' Array values are unique and all values in the range of iMin and iMax are
' used. This function is very useful if you want to process an array of
' in a random sequence, rather than processing for 0 to ubound().
'
'
'******************************************************************************
'
'******************************************************************************
'
' scrambleArray(arIn)
'
' This function creates and returns a new array containing elements
' randomly reordered from the passed arIn array.
'
' This function is very useful if you want to process a Dictionary object
' in a random order, using the array of keys returned by the vbScript
' Dictionary.Keys() method--in that situation call this function as follows:
'
' myKeyArray = scrambleArray(myDictionary.Keys())
'
' The above line of code ensures that the myKeyArray is ordered
' differently and randomly each time that line of code is executed.
'
'******************************************************************************



Post Extras: Print Post   Remind Me!   Notify Moderator  
StephQA
Newbie


Reged: 12/18/06
Posts: 20
Re: Donate a user defined function to this topic [Re: thorwath]
      #377188 - 05/01/07 08:01 AM

This function - searches for a US format based phone number using regular expression

patrn is 999-999-9999
haystack is the text from the browser page.
needle - a specific phone number that you need to find.

'strPageText is got from the Browser.Page.Innertext
'( strPageText = objPageObject.Body.innertext )
'strPhoneNumber= "800-111-2222"
********************************************************
'Calling portion of code
'-----------------------
strResults = ""
strResults = RegExpTest("[0-9]{3}-[0-9]{3}-[0-9]{4}", strPageText, strPhoneNumber)


'Actual Function
'-----------------
Function RegExpTest(patrn, haystack, needle)
Dim regEx, Match, Matches ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(haystack) ' Execute search.
RetCount = 0
For Each Match in Matches ' Iterate Matches collection.
If Match.Value <> needle Then
' RetCount = RetCount + 1
RetStr = RetStr&", "&Match.Value
End If
' RetStr = RetStr & "Match found at position "
' RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
' RetStr = RetStr & Match.Value & "'." & vbCRLF
Next
RegExpTest = RetStr
' RegExpTest = RetCount
End Function

*************************************************************
'' If strResults is empty, it means no other number other than the one searched was found. If is not empty, it will return the other phone numbers found on the page.

This function is very useful when you have to verify page contents for existance of a unique phone number.

If you need further help on how to use this function, please let me know.


Post Extras: Print Post   Remind Me!   Notify Moderator  
Niranjan Dash
Member


Reged: 04/30/04
Posts: 39
Loc: Bangalore
Re: Donate a user defined function to this topic [Re: IanFraser]
      #377739 - 05/03/07 02:57 AM

Hi All,
Here is function for finding out the IP Address of your local machine.

Call this function this way:
Dim sIpAddress = Get_IP_Address

'***** Function to find out the Local Host IP Address
'#######################################################################
Function Get_IP_Address()
Dim objShell, objExecObject
Dim sHostName, sLine
Dim iHostPos

'Get Local Host Name and get IP from the same
sHostName = Environment("LocalHostName")

Set objShell = CreateObject("WSCript.shell")
Set objExecObject = objShell.Exec("nslookup "&sHostName)

'Continue searching for Address until the End of Stream
Do Until objExecObject.StdOut.AtEndOfStream
sLine = objExecObject.StdOut.ReadLine()
iHostPos = Instr(sLine,"Address")

'If Address is found then retrieve the same
If iHostPos <> 0 Then
saAddress = Split(sLine, ":", -1)
sHostIP = Trim(saAddress(1))
End If
Loop
'Return the Host IP Address to the function.
Get_IP_Address = sHostIP
End Function

Hope, it helps you all in working with your programme.

Thanks,
Niranjan

Edited by thorwath (12/07/07 06:09 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Donate a user defined function to this topic [Re: ppat7046]
      #377824 - 05/03/07 06:15 AM

Subject: On Error Resume and QTP logging

In some cases trapping exceptions using the vbScript On Error Resume block is not enough to tell QTP to “butt out”, because--while QTP will not raise an exception--it often continues to log error messages associated with any exceptions encountered.

Use the following code to both disable QTP exception processing AND Results File logging:
Code:

Dim reporterMode : reporterMode=Reporter.Filter
Dim errNum
'
Reporter.Filter=rfDisableAll 'turn off QTP Results File logging
On Error Resume Next 'trap any exception
Err.Clear
'
'statement(s) to validate here...
'
errNum =Err.Number
On Error Goto 0 'return exception processing to QTP
Reporter.Filter=reporterMode 'restore QTP Results File loggin
'
If NOT errNum=0 Then 'exception occurred
'
'custom exception processing here...
'
End If



-fyi, Terry Horwath


Post Extras: Print Post   Remind Me!   Notify Moderator  
Beginner1234
Advanced Member


Reged: 01/30/07
Posts: 459
Re: Donate a user defined function to this topic [Re: thorwath]
      #378977 - 05/08/07 10:05 AM Attachment (386 downloads)

Here is the function to change any date format to dd/mm/yyyy.

User can call this function by

Call ChangeDateFormat("05_05_2007")
Call ChangeDateFormat("05-05-2007")
Call ChangeDateFormat("05/05/2007")
Call ChangeDateFormat("05:05:2007")
Call ChangeDateFormat("05 05 2007")
Call ChangeDateFormat("05-Feb-2007")
Call ChangeDateFormat("10_May_2007")
Call ChangeDateFormat("25:December:2007")

and any date. This function will return you date in dd/mm/yyyy format. The only catch is that year should always be as yyyy. User can also enhance it to change the desired format to anything just by desired specifying the delimter.

Edited by Beginner1234 (05/08/07 10:09 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
TmReddy
Advanced Member


Reged: 02/01/07
Posts: 458
Loc: Pittsburgh, USA
Re: Donate a user defined function to this topic [Re: Beginner1234]
      #383351 - 05/23/07 04:49 PM

This function will download file and save it local machine..

Function SaveWebBinary(strUrl, strFile)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const ForWriting = 2
Dim web, varByteArray, strData, strBuffer, lngCounter, ado
Err.Clear
Set web = Nothing
Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
web.Open "GET", strURL, False
web.Send
If Err.Number <> 0 Then
SaveWebBinary = False
Set web = Nothing
Exit Function
End If
If web.Status <> "200" Then
SaveWebBinary = False
Set web = Nothing
Exit Function
End If
varByteArray = web.ResponseBody
Set web = Nothing

'Save the file
On Error Resume Next
Set ado = Nothing
Set ado = CreateObject("ADODB.Stream")
If ado Is Nothing Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(strFile, ForWriting, True)
strData = ""
strBuffer = ""
For lngCounter = 0 to UBound(varByteArray)
ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
Next
ts.Close
Else
ado.Type = adTypeBinary
ado.Open
ado.Write varByteArray
ado.SaveToFile strFile, adSaveCreateOverWrite
ado.Close
End If
SaveWebBinary = True
Set ado = Nothing
Set ts = Nothing
Set fs = Nothing
End Function



SaveWebBinary "http://www.knowledgeinbox.com/files/DP_in_QTP.doc", "C:\DP_in_QTP.doc"
SaveWebBinary "http://www.knowledgeinbox.com/files/AutomatingIEVB.ppt", "C:\AutomatingIEVB.ppt"
SaveWebBinary "http://www.sqaforums.com/download.php?Number=356494/356494-QTPFrameworkDemo.zip", "C:\356494-QTPFrameworkDemo.zip"

-Reddy


Post Extras: Print Post   Remind Me!   Notify Moderator  
V_M
Newbie


Reged: 11/09/06
Posts: 3
Re: Donate a user defined function to this topic [Re: TmReddy]
      #388001 - 06/11/07 12:47 AM Attachment (493 downloads)

Attached is a utility that generates QTP functions out of given function templates. This helps in speeding up the script development process.
The utility works on double clicking the Generator.vbs . It reads templets from FuntionTemplate.txt and produces output in Output.vbs.
For more details refer the attached document.

(Being a newbee in QTP I would appreciate if other members can review the code/design and let me know how to improve it or how to achieve this desired functionality in much better way. TIA.)

Edited by V_M (06/11/07 02:15 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
nicpon
Member


Reged: 01/16/06
Posts: 31
Re: Donate a user defined function to this topic [Re: V_M]
      #388109 - 06/11/07 07:07 AM

Another date manipulation function.
Code:

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'#Function Description: Converts an input date from one format and mask to a
'# new format and mask. Currently, this function only
'# supports input dates with a 4-digit year.
'# Created By: Michal Szapiel - Sogeti Automation
'# Date Created: 08/30/2006
'# Required Parameters: in date_val - the input date to convert.
'# in format_in - the format for specifying the order of
'#the month, day, and year in the input date.
'#in sMask_in - the character separating the month, day, and year
'#in the input date.
'#in format_out - the format for specifying the order and number
'#of digits to display for month, day, and year in
'#the output date.
'# in sMask_out - the character separating the month, day, and year
'#in the output date.
'#
'#Example: Date_ConvertFormat("04/05/2004", "MDY", "/", "YYYYMD", "-")
'#Example return value: "2004-4-5"
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function Date_ConvertFormat(date_val, format_in, sMask_in, format_out, sMask_out)

Dim newDate, months, days, years, temp_date, temp_value

'# Parse the input date value into its three elements.
temp_value = split(date_val, sMask_in, -1, 1)

'# Set the month, day, and year from the input date value.
Select Case format_in
Case "MDY"
months = temp_value(0)
days = temp_value(1)
years = temp_value(2)

Case "DMY"
days = temp_value(0)
months = temp_value(1)
years = temp_value(2)

Case "YMD"
years = temp_value(0)
months = temp_value(1)
days = temp_value(2)
End Select

'# Format the input date value with the specified output format and mask.
Select Case format_out
Case "MMDDYYYY"
if Len(months) = 1 Then
months = "0" & months
End if
if Len(days) = 1 Then
days = "0" & days
End If
If Len(years) = 2 Then
years = "20" & years
End If
newDate = months & sMask_out & days & sMask_out & years

Case "MMDDYY"
if Len(months) = 1 Then
months = "0" & months
End if
if Len(days) = 1 Then
days = "0" & days
End if
if Len(years) = 4 Then
years = Right(years, 2)
End if
newDate = months & sMask_out & days & sMask_out & years

case "MDYYYY"
if (Left(months, 1) = "0") Then
months = Right(months, 1)
End if
if (Left(days, 1) = "0") Then
days = Right(days, 1)
End If
If Len(years) = 2 Then
years = "20" & years
End If
newDate = months & sMask_out & days & sMask_out & years

case "MDYY"
if (Left(months, 1) = "0") Then
months = Right(months, 1)
End if
if (Left(days, 1) = "0") Then
days = Right(days, 1)
End if
if (Len(years) = 4) Then
years = Right(years, 2)
End if
newDate = monthS & sMask_out & days & sMask_out & years

case "YYYYMMDD"
If Len(years) = 2 Then
years = "20" & years
End If
if (Len(months) = 1) Then
months = "0" & months
End if
if (Len(days) = 1) Then
days = "0" & days
End If
newDate = years & sMask_out & months & sMask_out & days

case "YYMMDD":
if (Len(months) = 1) Then
months = "0" & months
End if
if (Len(days) = 1) Then
days = "0" & days
End if
if (Len(years) = 4) Then
years = Right(years, 2)
End if
newDate = years & sMask_out & months & sMask_out & days

case "YYYYMD":
If Len(years) = 2 Then
years = "20" & years
End If
if (Left(months, 1) = "0") Then
months = Right(months, 1)
End if
if (Left(days, 1) = "0") Then
days = Right(days, 1)
End if
newDate = years & sMask_out & months & sMask_out & days

case "YYMD":
if (Left(months, 1) = "0") Then
months = Right(months, 1)
End if
if (Left(days, 1) = "0") Then
days = Right(days, 1)
End if
if (Len(years) = 4) Then
years = Right(years, 2)
End if
newDate = years & sMask_out & months & sMask_out & days
End Select

Date_ConvertFormat = newDate

End Function



Post Extras: Print Post   Remind Me!   Notify Moderator  
manish_gehlot
Junior Member


Reged: 03/31/05
Posts: 3
Loc: India
Re: Donate a user defined function to this topic [Re: nicpon]
      #390952 - 06/20/07 05:54 AM

Thanks V__M, the utility to create function really helped us.

--------------------
Regards,
Manish


Post Extras: Print Post   Remind Me!   Notify Moderator  
JakeBrake
Moderator


Reged: 12/19/00
Posts: 15290
Loc: St. Louis - Year 2025
Re: Donate a user defined function to this topic [Re: manish_gehlot]
      #392076 - 06/24/07 07:17 AM

If anyone is looking for code to manipulate spreadsheets, this may be useful:
http://www.sqaforums.com/showflat.php?Cat=0&Number=379195&page=0&vc=1#Post379195


Post Extras: Print Post   Remind Me!   Notify Moderator  
Jits
Advanced Member


Reged: 01/31/07
Posts: 492
Loc: Pune, India
Re: Donate a user defined function to this topic [Re: IanFraser]
      #392625 - 06/26/07 04:21 AM

This example sets time to 21 May 2004, 15:13:00

You can use the different time and date you wish...

On Error Resume Next

strComputer = "."
dtmNewDateTime = "20040520151300.000000-480"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate, " _
& "(Systemtime)}!\\" & strComputer & "\root\cimv2")
Set colOSes = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")

For Each objOS In colOSes
intSet = objOS.SetDateTime(dtmNewDateTime)
If intSet = 0 Then
Wscript.Echo "Successfully set new date and time."
Else
Wscript.Echo "Unable to set mew date and time."
End If
Next

Set colOSes = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objOS In colOSes
Wscript.Echo "New date and time: " & WMIDateToString(objOS.LocalDateTime)
Next

'******************************************************************************

Function WMIDateToString(dtmDate)
WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate, 13, 2))
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
GrahamA
Member


Reged: 07/12/07
Posts: 46
Loc: Dublin, Ireland
Re: Donate a user defined function to this topic [Re: Jits]
      #396972 - 07/12/07 03:27 AM Attachment (483 downloads)

Here is a set of functions I use, most of them are for manipulating web objects (WebEdit, WebList....)

All these functions return a value which I use to drive recovery scenarios etc.


Post Extras: Print Post   Remind Me!   Notify Moderator  
Viswasai
Newbie


Reged: 07/26/07
Posts: 6
Re: Donate a user defined function to this topic [Re: IanFraser]
      #405084 - 08/08/07 04:37 AM

hi
thqs for ur help


Post Extras: Print Post   Remind Me!   Notify Moderator  
JeremyDFry
Member


Reged: 05/12/04
Posts: 302
Loc: Lakeland, FL
Re: Donate a user defined function to this topic [Re: Jonty]
      #405182 - 08/08/07 07:56 AM

Quote:


While not rs.EOF
r = r + 1
For i = 0 to rs.fields.count - 1
objXL.ActiveSheet.Cells(r, i+1).Value = rs.fields(i).value
Next
rs.movenext
Wend





There is a better and much faster way to do this ...

Code:

Set excRange = objXL.ActiveSheet.Cells(2, 1)
lngRes = excRange.CopyFromRecordset(rs)



--------------------
JFry


Post Extras: Print Post   Remind Me!   Notify Moderator  
mwsrossoModerator
Veteran


Reged: 09/30/01
Posts: 4974
Loc: Doncaster, UK
Re: Donate a user defined function to this topic [Re: Niranjan Dash]
      #405211 - 08/08/07 09:04 AM

Quote:

Hi All,
Here is function for finding out the IP Address of your local machine.

Call this function this way:
Dim sIpAddress = Get_IP_Address

'***** Function to find out the Local Host IP Address
'##########################################################################
Function Get_IP_Address()
Dim objShell, objExecObject
Dim sHostName, sLine
Dim iHostPos

'Get Local Host Name and get IP from the same
sHostName = Environment("LocalHostName")

Set objShell = CreateObject("WSCript.shell")
Set objExecObject = objShell.Exec("nslookup "&sHostName)

'Continue searching for Address until the End of Stream
Do Until objExecObject.StdOut.AtEndOfStream
sLine = objExecObject.StdOut.ReadLine()
iHostPos = Instr(sLine,"Address")

'If Address is found then retrieve the same
If iHostPos <> 0 Then
saAddress = Split(sLine, ":", -1)
sHostIP = Trim(saAddress(1))
End If
Loop
'Return the Host IP Address to the function.
Get_IP_Address = sHostIP
End Function

Hope, it helps you all in working with your programme.

Thanks,
Niranjan




Here's an alternative way of doing it:

'===============================================================================
Set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
ipAddr=IPConfig.IPAddress(i)
Next
End If
Next
Set IPConfigSet=Nothing
MsgBox ipAddr
'===============================================================================

Mark Smith.

Edited by thorwath (12/07/07 06:11 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
stalis
Junior Member


Reged: 08/02/06
Posts: 58
Loc: Sweden
Re: Donate a user defined function to this topic [Re: IanFraser]
      #413245 - 09/05/07 04:30 AM

For custom report output. usage as the real thing (Reporter.ReportEvent)

Function doCustomReport( status, stepname, message )
Set dicMetaDescription = CreateObject("Scripting.Dictionary")
dicMetaDescription("Status") = status
dicMetaDescription("PlainTextNodeName") = stepname
dicMetaDescription("StepHtmlInfo") = message
dicMetaDescription("DllIconIndex") = 206
dicMetaDescription("DllIconSelIndex") = 206
dicMetaDescription("DllPAth") = "C:\Program Files\Mercury Interactive\QuickTest Professional\bin\ContextManager.dll"
Reporter.LogEvent "User", dicMetaDescription, Reporter.GetContext
End Function

doCustomReport micPass, "Test html", "<DIV align=left><H1>HTML layout testing</H1><b>This</b> can be handy to have.</DIV>"


Post Extras: Print Post   Remind Me!   Notify Moderator  
Ur Friend
Junior Member


Reged: 06/29/06
Posts: 61
Loc: Chennai
Re: Donate a user defined function to this topic [Re: stalis]
      #427349 - 10/25/07 02:05 AM

I have captured some functions from here and there and gathered together for ease of use...

These functions are used To Download and Upload files to and from Quality Centre or Test Director


'Example 1. To Download file from a Folder Attachment in QC
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

FilePath = GetAttachmentFromFolder("Subject\StayConnected\Release 1.0\Stay_Automation\Modules\MP_Module\Data_Tables", "abc.vbs", "C:\QC_Files\")
msgbox "Your file is located at folder: " & FilePath


'Examples 2: To Download file from the current Test Attachment
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
FilePath = GetAttachment("abc.vbs", "C:\QC_Files\")
MsgBox "Your file is here:" & FilePath


'Examples 3: To Download file from a different Test Attachment
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
FilePath = GetAttachmentFromTest("Driver_Script", "abc.vbs", "C:\QC_Files\")
MsgBox "Your file is here:" & FilePath


'Examples 4: To Save File to Folder Attachment in QC
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

AttachFileToTDFolder "Data_Tables","C:\QC\abc.vbs", "Test Description"
Msgbox "The File has been successfully saved to the specified Folder"


'Examples 5: To Save File to Current Test Attachment in QC
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
SaveAttachment "C:\QC\abc.vbs", "Test Description"
Msgbox "The File has been successfully saved to the Current Test"


'Examples 6: To Save File to Different Test Attachment in QC
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

SaveAttachmentToTest "Driver_Script", "C:\QC\abc.vbs", "Test Description in Japanese"
Msgbox "The File has been successfully saved to the specified Test"


'Examples 7: To get the local path of the file which is attached to the current test in the Quality centre
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Environment.Value("RelativePath") =GetTestAttachmentPath("Driver_Script.xls")
RelativePath = Environment.Value("RelativePath")
DataTable.ImportSheetRelativePath,"Driver_Script", "Driver_Script"


'Examples 8: To get the local path of the file which is attached to a folder in QC
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Environment.Value("RelativePath") = GetFolderAttachmentPath("Driver_Script.xls","Subject\StayConnected\Release 1.0\Stay_Automation\Driver\Data_Tables")
RelativePath = Environment.Value("RelativePath")
DataTable.ImportSheet RelativePath,"Driver_Script", "Driver_Script"



'***********************************************************************************************************************
' Function Name : AttachFileToTDFolder
' Function Details : Saves an Attachment to the Specified Folder
' Function Input Value : TDFolderName,LocalFile, FileDescrip
' Input details :
' TDFolderName - The correponding Folder name in QC where the file has to be attached.
' LocalFile - The Name of the file which has to be attached to the Quality Centre
' FileDescrip - Description of the file (Description field on Quality Centre)

'***********************************************************************************************************************

Function AttachFileToTDFolder(TDFolderName,LocalFile, FileDescrip)

On Error Resume Next
Set Qc = QCUtil.TDconnection
Set tm = Qc.TreeManager
Set root = tm.TreeRoot("Subject")
Set childNode = root.FindChildNode("StayConnected")
Set childNode1 = childNode.FindChildNode("Release 1.0")
Set childNode2 = childNode1.FindChildNode("Stay_Automation")
Set childNode3 = childNode2.FindChildNode("Modules")
Set childNode4 = childNode3.FindChildNode("MP_Module")
Set childNode5 = childNode4.FindChildNode(TDFolderName)
Set foldAttachments = childNode5.Attachments

Set foldAttachment = foldAttachments.AddItem(Null)
foldAttachment.FileName =LocalFile
foldAttachment.Description = FileDescrip
foldAttachment.Type = 1
foldAttachment.Post

End Function


'***********************************************************************************************************************
' Function Name : GetAttachmentFromFolder
' Function Details : To download an attachment from the specified folder in Quality Centre
' Function Input Value : FolderName, FileName, OutPath
' Input details :
' FolderName - The correponding Folder name in QC where the file is attached.
' FileName - The Name of the file which has to be downloaded to the local system
' OutPath - The local path in the system where the file has to be downloaded.

'***********************************************************************************************************************
Public Function GetAttachmentFromFolder(FolderName, FileName, OutPath)
Set TDConnection = QCUtil.TDConnection
Set treeManager = TDConnection.TreeManager
Set node = treeManager.nodebypath(FolderName)

GetAttachmentFromFolder = GetAttachmentFromTestObject(node, FileName, OutPath)
End Function

'***********************************************************************************************************************
' Function Name : GetAttachment
' Function Details : To download an attachment from the current test.
' Function Input Value : FileName, OutPath
' Input details :
' FileName - The Name of the file which has to be downloaded to the local system
' OutPath - The local path in the system where the file has to be downloaded.

'***********************************************************************************************************************
Public Function GetAttachment(FileName, OutPath)
Set CurrentTest = TDUtil.CurrentTest
GetAttachment = GetAttachmentFromTestObject(CurrentTest, FileName, OutPath)
End Function

'***********************************************************************************************************************
' Function Name : GetAttachmentFromTest
' Function Details : To download an attachment from another test in the Quality Centre
' Function Input Value : TestName, FileName, OutPath
' Input details :
' TestName - The Name of the test in Quality Centre where the file is attached.
' FileName - The Name of the file which has to be downloaded to the local system
' OutPath - The local path in the system where the file has to be downloaded.

'***********************************************************************************************************************
Public Function GetAttachmentFromTest(TestName, FileName, OutPath)
Set TDConnection = TDUtil.TDConnection

Set TestList = TDConnection.TestFactory.NewList("SELECT * FROM TEST WHERE TS_NAME = '" & TestName & "'")
GetAttachmentFromTest = GetAttachmentFromTestObject(TestList(1), FileName, OutPath)
End Function


'***********************************************************************************************************************
' Function Name : GetAttachmentServerPath
' Function Details : To Get the Server path in the Quality Centre
' Function Input Value : TestObject, FileName, LongFileName
' Input details :
' TestObject - The QC object
' FileName - The Name of the file which has to be downloaded to the local system
' LongFileName - The Long file Name that QC generates for an attached file.

'***********************************************************************************************************************
Public Function GetAttachmentServerPath (TestObject, FileName, LongFileName)

Set AttachmentFactory = TestObject.Attachments
Set AttachmentList = AttachmentFactory.NewList("SELECT * FROM CROS_REF")

For Each Attachment in AttachmentList
If StrComp(Attachment.Name(1), FileName, 1) = False Then
LongFileName = Attachment.Name
Pos = Instr(1, Attachment.ServerFileName, Attachment.Name, 1)
GetAttachmentServerPath = Left(Attachment.ServerFileName, Pos - 1)
Exit Function
End If
Next
GetAttachmentServerPath = ""

End Function

'***********************************************************************************************************************
' Function Name : GetAttachmentFromTestObject
' Function Details : To Get the attachment from the test object
' Function Input Value : TestObject, FileName, OutPath
' Input details :
' TestObject - The QC object
' FileName - The Name of the file which has to be downloaded to the local system
' OutPath - The local path in the system where the file has to be downloaded.

'***********************************************************************************************************************

Public Function GetAttachmentFromTestObject (TestObject, FileName, OutPath)

MyPath = GetAttachmentServerPath(TestObject, FileName, LongFileName)
If StrComp(MyPath, "") = 0 Then
GetAttachment = ""
Exit Function
End If

If Right(OutPath, 1) <> "\" Then
OutPath = OutPath & "\"
End If

' Load the attachment using the extended storage object
Set TDConnection = QCUtil.TDConnection
Set ExtendedStorage = TDConnection.ExtendedStorage
ExtendedStorage.ServerPath = MyPath
ExtendedStorage.ClientPath = OutPath
ExtendedStorage.Load LongFileName, True
GetAttachmentFromTestObject = OutPath & LongFileName
ExtendedStorage.SaveAs OutPath
End Function


'***********************************************************************************************************************
' Function Name : SaveAttachment
' Function Details : To Upload an attachment to the current test in Quality Centre
' Function Input Value : LocalFilePath, FileDescription
' Input details :
' LocalFilePath - Path indicating the location of the attachment on the local filesystem
' FileDescrip - Description of the file (Description field on Quality Centre)

'***********************************************************************************************************************

Public Function SaveAttachment(LocalFilePath, FileDescription)

SaveAttachmentToTestObj QCUtil.CurrentTest, LocalFilePath, FileDescription

End Function


'***********************************************************************************************************************
' Function Name : SaveAttachmentToTest
' Function Details : To Upload an attachment to the indicated Test in Quality Centre
' Function Input Value : TestName, LocalFilePath, FileDescription
' Input details
' TestName - The Name of the test in Quality Centre where the file has to be attached.
' LocalFilePath - Path indicating the location of the attachment on the local filesystem
' FileDescrip - Description of the file (Description field on Quality Centre)

'***********************************************************************************************************************
Public Function SaveAttachmentToTest(TestName, LocalFilePath, FileDescription)

Set TestList = TDUtil.TDConnection.TestFactory.NewList("SELECT * FROM TEST WHERE TS_NAME = '" & TestName & "'")
If TestList.Count = 0 Then
Exit Function
End If
SaveAttachmentToTestObj TestList(1), LocalFilePath, FileDescription

End Function


'***********************************************************************************************************************
' Function Name : SaveAttachmentToTestObj
' Function Details : To save the attachment to the test object
' Function Input Value : TestObj, LocalFilePath, FileDescription
' Input details
' TestObj - QC Test Object
' LocalFilePath - Path indicating the location of the attachment on the local filesystem
' FileDescrip - Description of the file (Description field on Quality Centre)

'***********************************************************************************************************************

Public Sub SaveAttachmentToTestObj(TestObj, LocalFilePath, FileDescription)
Set Attachments = TestObj.Attachments
Set Attachment = Attachments.AddItem(Null)
Attachment.FileName = LocalFilePath
Attachment.Description = FileDescription
Attachment.Type = 1'TDATT_FILE
Attachment.Post ' Commit changes
End Sub



'***********************************************************************************************************************
' Function Name : GetTestAttachmentPath
' Function Details : To Get the path of the attachments which are attached to the current test in the Quality Centre
' Function Input Value : TDAttachmentName
' Input details
' TDAttachmentName - The Name of the attachment which is attached to the current test.
'***********************************************************************************************************************

Public Function GetTestAttachmentPath(TDAttachmentName)

Dim objAttachmentFactory
Dim objAttachment
Dim objAttachmentList
Dim objAttachmentFilter
Dim objExtendedStorage
Dim strPath 'As String
Set objAttachmentFactory = QCUtil.CurrentTest.Attachments
Set objAttachmentFilter = objAttachmentFactory.Filter
objAttachmentFilter.Filter("CR_REFERENCE") = "'TEST_" & QCUtil.CurrentTest.Id & "_" & TDAttachmentName & "'"
Set objAttachmentList = objAttachmentFilter.NewList

If objAttachmentList.Count = 1 Then
Set objAttachment = objAttachmentList.Item(1)
objAttachment.Load True, ""
strPath = objAttachment.FileName
ElseIf objAttachmentList.Count > 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'", "Found more than one attachment '" & TDAttachmentName & "' in test '" &QCUtil.CurrentTest.Name & "'."
strPath = ""
ElseIf objAttachmentList.Count < 1 Then
Reporter.ReportEvent micFail, "Failure in library function 'GetTestAttachmentPath'","Found 0 attachments '" & TDAttachmentName & "' in test '" & QCUtil.CurrentTest.Name & "'."
strPath = ""
End If

GetTestAttachmentPath = strPath
Set objAttachmentFactory = Nothing
Set objAttachment = Nothing
Set objAttachmentList = Nothing
Set objAttachmentFilter = Nothing

End Function



'***********************************************************************************************************************
' Function Name : GetFolderAttachmentPath
' Function Details : To Get the path of the attachments which is attached to a folder in Quality Centre
' Function Input Value : TDAttachmentName, TDFolderPath
' Input details
' TDAttachmentName - The Name of the attachment which is attached to the folder in QC
' TDFolderPath - The path of the folder in QC where the attachment is present
'***********************************************************************************************************************

Public Function GetFolderAttachmentPath(TDAttachmentName, TDFolderPath)
Dim objAttachmentFactory
Dim objAttachment
Dim objAttachmentList
Dim objAttachmentFilter
Dim objTreeManager
Dim objSysTreeNode
Dim objExtendedStorage
Dim intNdId
Dim strPath
Set objTreeManager = QCUtil.TDConnection.TreeManager
Set objSysTreeNode = objTreeManager.NodeByPath(TDFolderPath)
Set objAttachmentFactory = objSysTreeNode.Attachments
Set objAttachmentFilter = objAttachmentFactory.Filter
intNdId = objSysTreeNode.NodeID
objAttachmentFilter.Filter("CR_REFERENCE") = "'ALL_LISTS_" & intNdId & "_" & TDAttachmentName & "'"
Set objAttachmentList = objAttachmentFilter.NewList
If objAttachmentList.Count > 0 Then
Set objAttachment = objAttachmentList.Item(1)
objAttachment.Load True, ""
strPath = objAttachment.FileName
Else
Reporter.ReportEvent micFail,"Failure in library function 'GetFolderAttachmentPath'", "Failed to find attachment '" & TDAttachmentName & "' in folder '" & TDFolderPath & "'."
End If
GetFolderAttachmentPath = strPath
Set objAttachmentFactory = Nothing
Set objAttachment = Nothing
Set objAttachmentList = Nothing
Set objAttachmentFilter = Nothing
Set objTreeManager = Nothing
Set objSysTreeNode = Nothing
End Function

--------------------
Thanks & Regards
Ur Friend
----------------------------------
"Quality is not an act, it is a habit."


Post Extras: Print Post   Remind Me!   Notify Moderator  
Ur Friend
Junior Member


Reged: 06/29/06
Posts: 61
Loc: Chennai
Re: Donate a user defined function to this topic [Re: Ur Friend]
      #427352 - 10/25/07 02:29 AM

Working With XML's IN QTP

'^^^^^^^^^^ To Get total count of specified Node in XMl File^^^^^^^^^^

Set XMLTest = XMLUtil.CreateXML()
XMLTest.LoadFile "D:\Data\XMLTesting.xml"
Set XMLRoot = XMLTest.GetRootElement()
Set XMLChildren = XMLRoot.ChildElements()
Set XMLChild = XMLChildren.ItemByName("atmEnabled")
Counts = XMLRoot.GetNumDescendantElemByName("atmEnabled")
Msgbox Counts

'^^^^^^^^^^ To Compare Two XML Files^^^^^^^^^^

Set doc1 = XMLUtil.CreateXML()
doc1.LoadFile "D:\Data\XMLTesting.xml"
Reporter.ReportEvent micDone, "XML-1","" &doc1& " Verified Successfully"
Set doc2 = XMLUtil.CreateXML()
doc2.LoadFile "D:\Data\XMLTesting1.xml"
Reporter.ReportEvent micDone, "XML-2","" &doc2& " Verified Successfully"
Set resultDoc = XMLUtil.CreateXML()
res = doc1.Compare(doc2, resultDoc)
values = resultDoc.ToString
If res = 1 Then
Msgbox "Documents match :-)"
Reporter.ReportEvent micPass, "XML- Result","" &values& " Verified Successfully"
Else
Msgbox "Documents do not match :-("
End If

'^^^^^^^^^^ To Get Value between Root Element^^^^^^^^^^

Set doc = XMLUtil.CreateXML()
doc.LoadFile "D:\Data\Attrib5.xml"
Set root = doc.GetRootElement()
res = root.CheckValue("true")
Msgbox res


'^^^^^^^^^^ To Get Value between Child Elements^^^^^^^^^^

Set doc = XMLUtil.CreateXML()
doc.LoadFile "D:\Data\Attrib4.xml"
Set root = doc.GetRootElement()
Set Child = root.ChildElements()
ChildCount = Child.Count()

arr = Array ("AUT","ACB","true")

For counts = 1 to ChildCount
If ChildCount <> 0 Then
Set Child1 = Child.Item(counts)
ChildName = Child1.ElementName()
ChildValue = Child1.Value()

If ChildValue = arr(counts-1) Then
Msgbox "Pass"
Else
Msgbox "Fail"
End If
End If
Next

--------------------
Thanks & Regards
Ur Friend
----------------------------------
"Quality is not an act, it is a habit."


Post Extras: Print Post   Remind Me!   Notify Moderator  
LKoning
Newbie


Reged: 04/23/07
Posts: 15
Loc: Beren op Zoom, Netherlands
Re: Donate a user defined function to this topic [Re: ppat7046]
      #435302 - 11/22/07 06:00 AM Attachment (300 downloads)

I have this code that is able to convert an Excel-sheet to a text file.

Comments are dutch. Should be understandable though.
Problem is: this function is slow. There is an option of using SaveAs method in Excel-object. But that creates quotes around cells that contain comma's and quotes. I don't want that.

The code could be done in one function, just what you want.

Any ideas?


Post Extras: Print Post   Remind Me!   Notify Moderator  
lockdown
Member


Reged: 02/07/07
Posts: 393
Loc: London
Iterate through All Items in an XML Document [Re: LKoning]
      #435333 - 11/22/07 08:16 AM

This code makes use of the the xmlutil to iterate through all of items in xml and output their values to the reporter.

Set XMLObj = XMLUtil.CreateXML()
XMLObj.LoadFile("D:\Work\Contact SOA\89366160.xml")

'Access root element
Set xmlRoot = XMLObj.GetRootElement() 'Returns XMLElement Object

IterateAllchildren xmlRoot

Sub IterateAllchildren(oXMLElement)
'Get the child elements collection
Set xmlCollection = oXMLElement.ChildElements()'Returns XMLElementsColl Object
'Get the number of items in the collection
itemCount = xmlCollection.Count
If itemCount >0 Then
'Output all of the children first
For n = 1 to itemCount
Set xmlItem = xmlCollection.Item(n) ' returns XMLElement Object
'Check if there are attributes for this item
Set xmlAttrributesCol = xmlItem.Attributes 'returns XMLAttributesColl Object
If xmlAttrributesCol.count > 0 Then
sAttributes = "The following attributes were found:" &chr(13)
For ac = 1 To xmlAttrributesCol.Count
Set oAttrItem = xmlAttrributesCol.Item(ac)
sAttributes = sAttributes & "Name [" & oAttrItem.Name() & "], Value [" & oAttrItem.Value() & "]" & chr(13)
Next
else
sAttributes = "No attributes found."
End If
reporter.ReportEvent micDone,xmlItem.ElementName, xmlItem.ElementName & " = [" & xmlItem.Value & "]" & chr(13) & sAttributes
'Now drill down into the children
IterateAllchildren xmlItem, arrDelim
Set xmlItem = nothing
Next
End If
End Sub

--------------------
Automation Blog


Post Extras: Print Post   Remind Me!   Notify Moderator  
auslei
Junior Member


Reged: 12/09/04
Posts: 165
Loc: Australia
Excel Writer - Write formated text to excel sheet [Re: IanFraser]
      #437163 - 11/28/07 10:08 PM Attachment (303 downloads)

I have created an Excel Write class, which can write formated text to the excel spreadsheets, although primitive, it can be used to do logging, I find it is much better than text based logging because of the autofilter functionality. The only thing to note is the excel support only 65535 rows of data, a new sheet will need to be created when the number of row reaches the limit.

The description of the class:

' Class Excel Writer:
' Function: To output formated text to a excel worksheet
' Methods:
' CreateHeader: Create column headers in worksheet, format column sizes
' WriteLine: Write a formatted line to the current row of the current sheet
' SaveAndClose: Save and close the workbook
' AddFilter: Apply auto filter on the current sheet
' SetName: Set the name of the current work sheet
' Add Sheet: Add a new sheet to the workbook

The following is an example:
Public Sub Example()
Set obj = GetExcelWriter

obj.SetName "abc"
obj.CreateHeader "aa,bb,cc", "10,10,20", RGB(100,100,100)
obj.WriteLine "aaa,bbb,ccc", 18, False, RGB(255,0,0)
obj.AddSheet "blah"
obj.AddFilter
obj.CreateHeader "dd,ee,ff", "10,15,40", RGB(255,0,255)
obj.WriteLine "ddd,eee,fff", 8, True, RGB(255,255,0)
obj.AddFilter
obj.SaveAndClose "c:\test.xls"
End Sub

' Workaround for QTP class issue
Public Function GetExcelWriter
Set GetExcelWriter = new ExcelWriter
End Function

Edited by auslei (11/28/07 10:19 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
thorwathModerator
Veteran


Reged: 07/22/99
Posts: 3840
Loc: Grand Rapids, MI
Re: Excel Writer - Write formated text to excel sh [Re: auslei]
      #439753 - 12/07/07 06:05 AM

Subject: case-insensitive and regEx Test Object List Selection

The QTP .Select method for WebList and many other similar Test Objects is case sensitive. This is not news to many of you, but this proves to be problematic from time to time.

Below is thread that has code that implements a case-insensitive list selector, as well as link to another thread that shows how to implement a regEx list selector:

http://www.sqaforums.com/showflat.php?Cat=0&Number=439749

-Terry


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: Ur Friend]
      #475980 - 04/16/08 12:59 PM

Here another useful function.

Code:

Function GetRowsCountFromDatabase(sDatabaseName,sUID,sPWD,sSQL)

'Create the connection string:
strConn="DRIVER={Microsoft ODBC for Oracle};SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"
'Establish the connection:
Set oConn = CreateObject("ADODB.Connection")
'Server-side cursor
oConn.CursorLocation = 2
oConn.Open strConn

'Create a recordset to hold the results
Set rs = CreateObject("ADODB.Recordset")

'Options for CursorType are: 0=Forward Only, 1=KeySet, 2=Dynamic, 3=Static (read-only)
rs.CursorType = 3
Set rs.ActiveConnection = oConn

'Execute the query and put the results into the recordset
rs.Open sSQL

' Verify Record set is not NULL
if ISNULL(rs.Fields(0)) then
ExitAction(0)
else
GetRowsCountFromDatabase=rs.RecordCount
end if
rs.close
Set strConn=nothing
Set oConn=nothing
End Function



--------------------
Thanks,
Prashant Patel


Post Extras: Print Post   Remind Me!   Notify Moderator  
RatanKumarAngadi
Member


Reged: 11/01/07
Posts: 238
Loc: Bangalore, Karnataka
Descrptive code for automating datepicker [Re: IanFraser]
      #476072 - 04/16/08 10:01 PM

These Descriptive functions automates the datepicker developed in javascript, but only problem is, it cannot select the year if the specified year to select is not in current list of years.So let me know anybody makes it.
____________________________________________________________

Function OpenCalendar(Context)
'############### Detects the calander and opens it
Set CalendarImage=Description.Create()
CalendarImage("html tag").Value="IMG"
CalendarImag("name").Value="Image"
CalendarImage("filename").Value="calendar.gif"
Set CalImage=Context.ChildObjects(CalendarImage)
CalImage(0).Click
'############### End Detects the calander and opens it
End Function

Function SelectYear(Context,yea)
'############## Detects the year image and clicks on it
Set YearImage=Description.Create()
YearImage("html tag").Value="IMG"
YearImage("html id").Value="ChangeYear"
Set YearImage=Context.ChildObjects(YearImage)
YearImage(0).Click
'############## End Detects the year image and clicks on it

'#############Selects specified year
Set YTab=Description.Create()
YTab("html tag").Value="TABLE"
YTab("name").Value="WebTable"
YTab("rows").Value=9
Set YearTab=Context.ChildObjects(YTab)
'############# Checks existance of year in present list
'Set a=YearTab
' Call isExist(a,yea,Context)
'############# End checks existance of year in present list

For i=2 to YearTab(0).RowCount()-1
y=YearTab(0).getCellData(i,1)
If CInt(y)=CInt(yea) Then
YearTab(0).Object.Rows(i-1).Cells(0).Click Exit For
End If
Next
'#############End Selects specified year

End Function


Function SelectMonth(Context,mon)
'############ Detects month image and clicks on it
Set MonthImage=Description.Create()
MonthImage("html tag").Value="IMG"
MonthImage("name").Value="Image"
MonthImage("html id").Value="changeMonth"
MonthImage("file name").Value="iconbullet.jpg"
Set MonthImage=Context.ChildObjects(MonthImage)
MonthImage(0).Click
'############ End Detects month image and clicks on it
'########### Select Month
Set MTab=Description.Create()
MTab("html tag").Value="TABLE"
MTab("name").Value="WebTable"
MTab("rows").Value=12
Set MonthTab=Context.ChildObjects(MTab)
For i=1 to MonthTab(0).RowCount()
m=MonthTab(0).getCellData(i,1)
m=Trim(Ucase(Cstr(m)))
mon=Trim(Ucase(Cstr(mon)))
If m=mon Then
''' Select the index
MonthTab(0).Object.Rows(i-1).Cells(0).Click
Exit For
End If
Next
'########## End Select Month
End Function

Function SelectDate(Context,dt)
'############ Detect the date link
Set DLTab=Description.Create()
DLTab("html tag").Value="A"
DLTab("name").Value=dt
DLTab("outertext").Value=dt
Set DateLink=Context.ChildObjects(DLTab)
'########### End Datect the date link
'########## Click on the date to select
DateLink(0).Click
'######### End Click on the date to select
End Function
________________________________________________________

''Here the examples of calling these functions
''Change context according to your pages.
''It selects January 10 2006 as the parameters i sent below
Set Context=Browser("a").Page("b").Frame("c")
yea=2006
mon="january"
dt="10"
Call OpenCalendar(Context)
Call SelectMonth(Context,mon)
Call SelectYear(Context,yea)
Call SelectDate(Context,dt)
____________________________________________________________

Regards,
Thanks.

--------------------
Cheerrss

Edited by ShowMaker (04/16/08 10:09 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
freefree
Member


Reged: 01/06/02
Posts: 125
Loc: Leeds, UK
Re: Donate a user defined function to this topic [Re: ppat7046]
      #476142 - 04/17/08 03:59 AM

Following function sets the Build Number for current run in Quality Center to the value of Build Number from Test Set.
While Build Number is a custom field in Test Run and Test Set for that project in QC.

****************************************
Public Function SetBuildNumber
If QCUtil.IsConnected Then
Set var_CurrentTestSetTest = QCUtil.CurrentTestSetTest
Set var_CurrentRun = QCUtil.CurrentRun
var_CurrentRun.Field ("Build Number") = var_CurrentTestSetTest.Field ("Build Number")
var_CurrentRun.Post
var_CurrentRun.Refresh
End If
End Function

--------------------
Dont wait for a miracle, be a miracle..
http://e-pyramid.blogspot.com/


Post Extras: Print Post   Remind Me!   Notify Moderator  
SteveK
Junior Member


Reged: 10/15/03
Posts: 361
Loc: Norfolk, VA
Re: Donate a user defined function to this topic [Re: IanFraser]
      #477441 - 04/22/08 07:36 AM Attachment (212 downloads)

Here's a Quicksort function, it's much more efficient than bubble sorting. Adapted from 4GuysFromRolla for QTP.

--------------------
A good rule of thumb is to never measure with your thumb.


Post Extras: Print Post   Remind Me!   Notify Moderator  
Ur Friend
Junior Member


Reged: 06/29/06
Posts: 61
Loc: Chennai
Re: Donate a user defined function to this topic [Re: SteveK]
      #479203 - 04/28/08 08:27 PM Attachment (283 downloads)

This is a Batch Script which can run a set of QTP scripts which are listed in an excel sheet. Find attached the excel sheet which contains the Scripts which needs to run in the mentioned order.

Dim strFolderPath
Dim RelativePath

Set fso = CreateObject("Scripting.FileSystemObject")
'strFolderPath = fso.GetAbsolutePathName("")
RelativePath=fso.GetAbsolutePathName("")
'RelativePath = fso.GetParentFolderName(strFolderPath&"\Scripts")
Call Batch_Run

Function F_Collecting_Data (strWorkBook, strSheetName, charColName1,charColName2,arrRowValue)

Set ExcelObj=CreateObject("Excel.Application")
Set ObjWorkBook = ExcelObj.workbooks.Open(RelativePath & "\" & strWorkBook & ".xls")
Set ObjWorkSheet = ObjWorkBook.WorkSheets("" & strSheetName & "")
intRowCount = ExcelObj.ActiveSheet.UsedRange.Rows.Count

ReDim arrRowValue(intRowCount,2)
For intRowIterator = 2 to intRowCount
arrRowValue(intRowIterator -1,1) = ObjWorkSheet.Range(charColName1 & intRowIterator & "").Value
'Msgbox arrRowValue(intRowIterator -1,1)
arrRowValue(intRowIterator -1,2) = ObjWorkSheet.Range(charColName2 & intRowIterator & "").Value
'Msgbox arrRowValue(intRowIterator -1,2)
Next
ExcelObj.quit

End Function



Function F_Execute_Script (arrScriptName)
Dim qtpApp,qtpResultsOpt
Set qtpApp = CreateObject("QuickTest.Application")
Set qtpResultsOpt = CreateObject("QuickTest.RunResultsOptions")

qtpApp.Launch
qtpApp.Visible = True
qtpApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtpApp.Options.Run.RunMode = "Fast"
qtpApp.Options.Run.ViewResults = False

For intIterator = 1 to UBOUND(arrScriptName,1)-1

If strcomp(arrScriptName (intIterator,2),"True") = 0 then

WScript.Echo ""
WScript.Echo "Invoking QTP...for """&intIterator&""" Test"
WScript.Echo ""

ActualRelPath = Left ( RelativePath, (Len(RelativePath) - Len("Batch Execution") ) )
'Msgbox ActualRelPath & "\TestScripts_Folder\" & arrScriptName(intIterator,1)
TestPath = ActualRelPath & "TestScripts_Folder\" & arrScriptName(intIterator,1)
ResultPath = ActualRelPath & "Results\" & arrScriptName(intIterator,1)

WScript.Echo "Loading Script """&TestPath&""""
WScript.Echo ""

qtpApp.Open TestPath, True
qtpApp.Test.Settings.Run.OnError = "NextStep" ' Instruct QuickTest to perform next step when error occurs

WScript.Echo "Seting the Result Folder as """&ResultPath&""""
WScript.Echo ""

qtpResultsOpt.ResultsLocation = ResultPath
qtpApp.Test.Run qtpResultsOpt
While qtpApp.Test.IsRunning
'Wait For Test To Finish
Wend

WScript.Echo "Overall Result for the script "& arrScriptName(intIterator,1)&" is "& qtpApp.Test.LastRunResults.Status
WScript.Echo ""

WScript.Echo "QTP script execution completed..."
WScript.Echo ""

qtpApp.Test.Close

End If
Next

qtpApp.Quit

WScript.Echo "Done with all the scripts...Exiting QTP........."

Set qtpResultsOpt = Nothing
Set qtpApp = Nothing
WScript.Echo "* * * * * * * * * * * * * E n d * * * * * * * * * * * * *"
End Function


Function Batch_Run
F_Collecting_Data "Batch Runner","Module","A","B", arrModuleName ' Batch Runner - Name of the Excel File , Module - Name of the sheet in excel , which contains the script name and the execution status under two columns
For intIterator = 1 to UBOUND(arrModuleName,1)-1
If strcomp(UCase(arrModuleName (intIterator,2)),"TRUE") = 0 then
'MsgBox "Hi"
'F_Collecting_Data "Batch", arrModuleName (intIterator,1),"A","B",arrScriptName
F_Execute_Script arrModuleName
End If
Next
End Function

--------------------
Thanks & Regards
Ur Friend
----------------------------------
"Quality is not an act, it is a habit."


Post Extras: Print Post   Remind Me!   Notify Moderator  
V_i_s_h_U
Junior Member


Reged: 03/08/06
Posts: 194
Loc: Pune
Re: Donate a user defined function to this topic [Re: Ur Friend]
      #479711 - 04/30/08 04:26 AM

Thanks for function Ur_Friend.
Some doubts.
Where should I keep Batch Runner.xls sheet ?
It would be great if you explain where to store these files, some parameters - their purpose and how the function is handling execution flow.
Thanks in advance.

--------------------
Thanks & Regards,
Vi$hal
--------------------------------------------------
There is a way for ME.If not...I will make it !!!
--------------------------------------------------


Post Extras: Print Post   Remind Me!   Notify Moderator  
ppat7046
Active Member


Reged: 02/01/01
Posts: 785
Loc: USA
Re: Donate a user defined function to this topic [Re: SteveK]
      #479837 - 04/30/08 09:01 AM

I tried this function but its not returning the correct sorting.

Here what I did.
Code:

vec=array("z","x","a",1)
loBound=0
hiBound=2
msgbox join(QuickSort(vec , loBound, hiBound))



The Actual Result:
a x z 1

The Expected Result:
1 a x z

--------------------
Thanks,
Prashant Patel

Edited by ppat7046 (04/30/08 09:01 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
MrVersion
Member


Reged: 04/14/08
Posts: 190
Re: Donate a user defined function to this topic [Re: ppat7046]
      #484603 - 05/20/08 07:51 AM

SimpTerm Functions
Could be much better, but they work. Might be of use to someone.

'##################################################################################################
Public Function SimpTermExit()
'Close SimpTerm.
SimpTerm="regexpwndclass:=SimpTerm"
Window(SimpTerm).Close
End Function
'##################################################################################################

'##################################################################################################
Public Function SimpTermLogin(host, user, pwd)
'Set up local vairables
SimpExe="C:\sptnet32.exe"
SimpTerm="regexpwndclass:=SimpTerm"
'Launch SimpTerm and login
SystemUtil.Run SimpExe, "-d -w " & host & " -l " & user
Window(SimpTerm).Type user
Window(SimpTerm).Type micReturn
Window(SimpTerm).Type pwd
Window(SimpTerm).Type micReturn
End Function
'##################################################################################################

'##################################################################################################
Public Function SimpTermType(cmd)
'Types on the command line
SimpTerm="regexpwndclass:=SimpTerm"
Window(SimpTerm).Type cmd
Window(SimpTerm).Type micReturn
End Function
'##################################################################################################


Post Extras: Print Post   Remind Me!   Notify Moderator  
SteveK
Junior Member


Reged: 10/15/03
Posts: 361
Loc: Norfolk, VA
Re: Donate a user defined function to this topic [Re: ppat7046]
      #485015 - 05/21/08 09:41 AM

Quote:

I tried this function but its not returning the correct sorting.

Here what I did.
Code:
vec=array("z","x","a",1)
loBound=0
hiBound=2
msgbox join(QuickSort(vec , loBound, hiBound))

The Actual Result:
a x z 1
The Expected Result:
1 a x z




That is because your ubound is not the ubound of your array, effectively leaving out the last item in the array ("1").

Set your ubound to 3 and you will see your expected results.

--------------------
A good rule of thumb is to never measure with your thumb.


Post Extras: Print Post   Remind Me!   Notify Moderator  
snparikh
Active Member


Reged: 02/05/08
Posts: 878
Loc: Los Angeles, CA, USA
Re: Donate a user defined function to this topic [Re: SteveK]
      #490481 - 06/10/08 04:38 PM Attachment (300 downloads)

Subj: Maximize, minimize & restore browser (tested on QTP 9.5/IE7)

Attached file has following 3 functions:
  1. maximizeBrowser(maxBrowser)
  2. minimizeBrowser(minBrowser)
  3. restoreBrowser(resBrowser)


The approach:
Get browser.object.HWND and use it to access browser as window object for above mentioned functions.

--------------------
-Suchit


Post Extras: Print Post   Remind Me!   Notify Moderator  
snparikh
Active Member


Reged: 02/05/08
Posts: 878
Loc: Los Angeles, CA, USA
Re: Donate a user defined function to this topic [Re: snparikh]
      #494731 - 06/25/08 04:07 PM Attachment (218 downloads)

Subj: Enable/Disable/Prompt_for Active Scripting

It enables or disables or prompts_for Active Scripting (Javascript).
File attached.


Tested on IE 7. You will need to restart the browser for it to take effect.

Keywords: Enable, disable, javascript, active scripting

--------------------
-Suchit

Edited by snparikh (06/25/08 04:16 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
lockdown
Member


Reged: 02/07/07
Posts: 393
Loc: London
Re: Donate a user defined function to this topic [Re: snparikh]
      #510609 - 08/21/08 08:58 AM

We usually like to capture every step along the way, but this comes at a performance cost. This function will let you switch between capturing screens always and capturing the screen for on errors and warnings. You can call this at any point during the test



'*********************************************************
' Type: Function
' Purpose: To enable/disable screen capturing. If disabled, things such as accessing javatables will run much
' faster
' Assumptions:
' Created By: David H on 21/8/2008
' Amended By:
' Inputs: blnEnable - True or False. If true, full screen capturing will be enabled
' Returns: nothing
Function EnableFullScreenCapture(blnEnable)
Dim oApp, oRunOptions

Set oApp = CreateObject("QuickTest.Application")
Set oRunOptions = oApp.Options

If blnEnable Then
reporter.ReportEvent micDone,"ImageCaptureForTestResults: Always","ImageCaptureForTestResults screen capture has been set to Always"
oRunOptions.Run.ImageCaptureForTestResults = "Always"
else
reporter.ReportEvent micDone,"ImageCaptureForTestResults: OnWarning","ImageCaptureForTestResults screen capture has been set to On Warning"
oRunOptions.Run.ImageCaptureForTestResults = "OnWarning"
End If

Set oRunOptions = nothing
Set oApp = nothing
End Function

--------------------
Automation Blog


Post Extras: Print Post   Remind Me!   Notify Moderator  
qaexe
Member


Reged: 03/20/08
Posts: 115
Re: Donate a user defined function to this topic [Re: IanFraser]
      #510650 - 08/21/08 10:18 AM

'**************************************************************************************************************
This function verifies text displayed in PDF document opened in browser during runtime. This checks if “txt1” is displayed in PDF and returns result based on verification.
'**************************************************************************************************************

Public Function funcVerifyPDFText (pdfBrowserObject,txt1)
Dim AcroApp, AcroAvDoc
Dim nDoc, bReset, nCount
Set AcroApp = CreateObject(“AcroExch.App”)
If AcroApp.GetNumAVDocs > 0 Then
For nDoc = 0 To AcroApp.GetNumAVDocs - 1
Set AcroAvDoc = AcroApp.GetAVDoc( nDoc )
Next
bReset = True: nCount = 0
If (AcroAVDoc.FindText(txt1 , True, True, bReset )) Then
reporter.ReportEvent micPass, ""& txt1 &"", "The title """& txt1 &""" is
displayed on PDF report"
Else
reporter.ReportEvent micFail,""& txt1 &"", "The title """& txt1 &""" is not
displayed on PDF report"
End If
Else
reporter.ReportEvent micFail, “No open PDF documents found.”
End If
PDFbrowserObj.Close
End Function
********************************************************
QTP Code:
'Set Browser Object to variable "pdfBrowserObject"
Set pdfBrowserObject = Browser("").Page("")
'Set txt1 variable with value to be verified in PDF document
txt1 = "Your Search Text Goes Here"
'Call to function to verify specified text value in PDF during runtime
funcVerifyPDFText pdfBrowserObject,txt1

Resource Document: http://www.advancedqtp.com/wp-content/uploads/ScriptingQTP/CH16%20-%20Accessing%20PDF.pdf

--------------------
Thanks
Yamini


Post Extras: Print Post   Remind Me!   Notify Moderator  
Blue_Motorcycle
Member


Reged: 07/13/07
Posts: 69
Loc: Ohio
Re: Donate a user defined function to this topic [Re: IanFraser]
      #519540 - 09/24/08 06:34 AM

We use this function to generate a first, middle, and last name instead of having to populate a datasheet with made up names. Each name begins with a capital-first letter followed by lower-case alpha string of vLength.

'***********************************************************
'@ Description: This Function will create a random name
'having an upper-case first letter followed by a random number of lowercase letters:
'The Example below demostrates how to concatinate the names in to a randomly generated whole name.
Public Function RandomName(vLength)
'Chose a first upper-case letter for the name
vCharU = randomnumber(65,90)
fLetter = fLetter & Chr(vCharU)
'This line will override the length specified in the function call creating a name of varying length between 2 & 10 letters.
'vLength = randomnumber(1,9)
'Now we assemble the lower-case portion of the name.
For X = 1 to vLength
Randomize
vCharL = randomnumber(97,122)
nLetters = nLetters & Chr(vCharL)

Next
RandomName = (fLetter & nLetters)
End Function

'***********************************************************

'Example
'fName =RandomName(4)
'mName = RandomName(3)
'lName = RandomName(6)
'MsgBox(fName&" "&mName&" "&lName)

--------------------
"This may hurt a little, but it's something you'll get used to."

Edited by Blue_Motorcycle (09/24/08 06:36 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
chikki
Super Member


Reged: 12/12/05
Posts: 1283
Loc: USA
verify email received in outlook. [Re: rscholz660]
      #520990 - 10/01/08 12:22 AM Attachment (362 downloads)

To verify the email received in the outlook and compare with the baseline text file.

I have attached 1 files.

1.clsoutllook.txt contains the functions/sub procedure

and pasted the other file

Code:


Set fso = CreateObject("WScript.Shell")

While fso.AppActivate("Microsoft Outlook") = FALSE
wscript.sleep 1000
Wend

fso.SendKeys "a", True
fso.SendKeys "{TAB}",True
fso.SendKeys "{TAB}",True
fso.SendKeys "{ENTER}",True

'fso.SendKeys "y", True

wscript.sleep 7000

While fso.AppActivate ("Microsoft Outlook") = FALSE
wscript.sleep 1000
Wend

fso.SendKeys "y", True




--------------------
------------
Chikki
when things gets harder ,the harder gets going

Edited by chikki (10/01/08 12:24 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Basanth_Kumar
Member


Reged: 12/03/07
Posts: 55
Re: Donate a user defined function to this topic [Re: MalleswariQA]
      #524808 - 10/16/08 05:17 AM

Hello Malleshwari,
Thanks a million for this userdefined function. It works like a charm. I was just wondering how would we perform the reporting in this case ?? For eg : If i say i wanted to check wether the supplied table list is Ascending then, If found ascending it should be able to report saying "passed" but if the list is descending it should say "Failed". I tried modifying the function several ways but the issue is, when the case passes it still prints the failure report. Can you please help me with this ??

--------------------
Basanth
Give a Fish to a Man and you feed him for a day.Teach a Man to fish and you feed him for Life

http://www.learnqtp.com/forums/


Post Extras: Print Post   Remind Me!   Notify Moderator  
rscholz660
Super Member


Reged: 12/05/06
Posts: 1556
Loc: Germany, Dresden
verify that mouse pointer is displaying as hand [Re: Basanth_Kumar]
      #525073 - 10/17/08 01:02 AM

extern.Declare micLong,"GetForegroundWindow","user32.dll","GetForegroundWindow"
extern.Declare micLong,"AttachThreadInput","user32.dll","AttachThreadInput", micLong, micLong,micLong
extern.Declare micLong,"GetWindowThreadProcessId","user32.dll","GetWindowThreadProcessId", micLong, micLong
extern.Declare micLong,"GetCurrentThreadId","kernel32.dll","GetCurrentThreadId"
extern.Declare micLong,"GetCursor","user32.dll","GetCursor"

function get_cursor_state()
hwnd = extern.GetForegroundWindow()
pid = extern.GetWindowThreadProcessId(hWnd, NULL)
thread_id=extern.GetCurrentThreadId()
extern.AttachThreadInput pid,thread_id,True
get_cursor_state=extern.GetCursor()
extern.AttachThreadInput pid,thread_id,False
end function

Print get_cursor_state()

some notes:
for "hand" you will get back "65581"
the function will only work for applications which are using standard windows api calls for mouse pointer...

--------------------
http://qcmt.pc-polis.de

de omnibus dubitandum

For all Questions: Please be sure to take a look at the QTP Manual before posting any Questions, thanks for doing this


Post Extras: Print Post   Remind Me!   Notify Moderator  
Ur Friend
Junior Member


Reged: 06/29/06
Posts: 61
Loc: Chennai
Re: Parameterize an XML Document [Re: rscholz660]
      #526440 - 10/23/08 12:31 AM Attachment (172 downloads)

Parameterize an XML Document:

This example will find the required node and attributes in an XML and replace it with actual values.

Note : Attached Sample.doc
Code:
 
Public requiredChildElement, requiredAttr


Set XMLObj = XMLUtil.CreateXML()
XMLObj.LoadFile("C:\RecycleBin\Template\Sample.xml")
Set rootElement = XMLObj.GetRootElement()

childElementName = "key"
childAttributeName = "quantity"
childElementValue = "300000"
childAttributeValue = "highQuality"

'~~~~~~~~~~~~ finding the child element and attributes and replacing it with a different value ~~~~~~~~~~~~~
For intLoop = 1 To 2
Call FindChildElement ( rootElement , childElementName, childAttributeName)
requiredChildElement.SetValue(""&childElementValue&"")
requiredChildElement.RemoveAttribute "name"
requiredChildElement.AddAttribute "newName",childAttributeValue
childElementName = "source"
childAttributeName = "Location"
childElementValue = "Melbourne"
childAttributeValue = "newLocation"
Next

'saving the file into differenf location

XMLObj.SaveFile "C:\RecycleBin\Modified\modifiedSample.xml"



'~~~~~~~~~~~~ To find the object of the required childelement with the appropriate attribute '~~~~~~~~~~~~

Function FindChildElement ( rootElement , childElementName, childAttributeName)
Set ChildElementsCollection = rootElement.ChildElements
For i = 1 To ChildElementsCollection.Count
Set childElementObject = rootElement.ChildElements.Item(i)
'Print childElementObject.ElementName
'Print childElementObject.Value
For j = 1 To childElementObject.Attributes.Count
Set AttrObject = childElementObject.Attributes.Item(j)
'Print AttrObject.Name
'Print AttrObject.Value
If ( childElementObject.ElementName = childElementName and AttrObject.Value = childAttributeName ) Then
Set requiredChildElement = childElementObject
Set requiredAttr = AttrObject
Exit Function
End If
Next
Call FindChildElement ( childElementObject , childElementName, childAttributeName)
Next
End Function




--------------------
Thanks & Regards
Ur Friend
----------------------------------
"Quality is not an act, it is a habit."


Post Extras: Print Post   Remind Me!   Notify Moderator  
qamanohar
Newbie


Reged: 09/15/08
Posts: 7
Re: Donate a user defined function to this topic [Re: ppat7046]
      #529396 - 11/05/08 05:07 AM

This thread is very helpfull for everyone.

I am working on automating one of my application.
As soon as I complete the reusable/Library functions I will post it under this thread.

Thanks to All


Post Extras: Print Post   Remind Me!   Notify Moderator  
Bill42x
Advanced Member


Reged: 10/24/08
Posts: 428
Loc: Cambs, UK
Re: Donate a user defined function to this topic [Re: qamanohar]
      #549595 - 02/11/09 01:20 AM

You can get mine at:

http://www.intellipro.co.uk/downloads.htm

--------------------
For QTP code, checkout my website:

http://www.intellipro.co.uk


Post Extras: Print Post   Remind Me!   Notify Moderator  
PBMax
Member


Reged: 02/05/09
Posts: 29
Re: Donate a user defined function to this topic [Re: qamanohar]
      #549692 - 02/11/09 06:19 AM

This is not a function but it is useful otherwise. This script will get all subnodes for a given node and will download all QTP scripts from Quality Center. It will duplicate the directory structure of Quality Center when copying them locally.

Code:
  
Option Explicit

'==========================================================================
'
' Quality Center QTP Test Case Exporter
'
' NAME: DownloadQTPFromQC.vbs
'
' AUTHOR: Percy Bell
' DATE : 2/5/2009
'
'
' PURPOSE:
' To export all QTP Test Cases from QC for a give Test Plan Root Node.
'
'==========================================================================

'Quality Center Server settings
Dim strUserName, strPassword, strServer
sUserName = "<USERNAME>" '<-- Change me.
sPassword = "<PASSWORD>" '<-- Change me.
strServer = "http://<SERVERNAME>/qcbin/" '<-- Change me.

'Quality Center Project settings
Dim strDomain, strProject, strRootNode
sDomain = "<DOMAIN>" '<-- Change me.
sProject = "<PROJECT>" '<-- Change me.
strRootNode = "Subject\" '<-- Change me.

'Return the TDConnection object.
Dim QCConnection
Set QCConnection = CreateObject("TDApiOle80.TDConnection")

'Login to Quality Center
QCConnection.InitConnectionEx strServer
QCConnection.Login strUserName, strPassword

If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If

'Connect to Project
QCConnection.Connect strDomain, strProject

'Get array of user created TestClass objects
Dim arrObjQTPTests
arrObjQTPTests = GetQTPTestsFromQC(strRootNode)

'Close Quality Center Connection
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection

Set QCConnection = Nothing

'Create QTP object to control QTP
Dim qtApp
Set qtApp = CreateObject("QuickTest.Application")

'If connection not already established then establish connection(QTP already running)
If Not qtApp.TDConnection.IsConnected Then
qtApp.TDConnection.Connect strServer, strDomain, strProject, strUserName, strPassword, False
End If

qtApp.Launch ' Start QuickTest
qtApp.Visible = False ' Make the QuickTest application invisible

'Get each QTP test's name and path to load and save.
Dim objQTPTest
For Each objQTPTest In arrObjQTPTests
If qtApp.TDConnection.IsConnected Then ' If connection is successful
Dim strQCTestPath, strLocalTestPath, strLocalTestFolder
strQCTestPath = "[QualityCenter] " & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestPath = "C:\" & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestFolder = "C:\" & objQTPTest.Path

WScript.Echo "Open test from QC: " & strQCTestPath
qtApp.Open strQCTestPath, True ' Open test in read only mode

WScript.Echo "Create local folder: " & strLocalTestFolder
CreateFolderPath(strLocalTestFolder) ' Create folder including parent folders.

WScript.Echo "Save Test as: " & strLocalTestPath & vbcrlf
qtApp.Test.SaveAs strLocalTestPath ' Save test to local path.

Else
MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
Next

qtApp.TDConnection.Disconnect ' Disconnect from Quality Center
qtApp.Quit ' Exit QuickTest

Set qtApp = Nothing



'-----------------------------
' Function Library
'-----------------------------



'*
'Gets the name and path of QTP tests for the give node in QC's Test Plan Module.
'
'@param: strRootNode Root Node in a Test Lab tree.
'
'@return: Object Array Array of TestClass objects for the given QC Node and subnodes.
'*
Public Function GetQTPTestsFromQC(ByVal strRootNode)
'Gets subnodes of the given root node.
Dim arrStrNodesList
arrStrNodesList = GetNodesList(strRootNode)

Dim arrObjQTPTest(), intNewUpper
intNewUpper = 0

'Get all QTP test for each of the given nodes in the node list.
Dim strNode
For Each strNode In arrStrNodesList
Dim objTreeManager, objSubjectNode, objTestFactory, objTDFilter
Set objTreeManager = QCConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(strNode)
Set objTestFactory = objSubjectNode.TestFactory
Set objTDFilter = objTestFactory.Filter
objTDFilter("TS_TYPE") = "= 'QUICKTEST_TEST'"

Dim objTestList
Set objTestList = objTestFactory.NewList(objTDFilter.Text)

'Get the name and path for each of the QTP tests in the test list.
Dim objTest
For Each objTest In objTestList
ReDim Preserve arrObjQTPTest(intNewUpper)
Set arrObjQTPTest(intNewUpper) = New TestClass

'Create a TestClass to make setting and getting the path and name easier.
arrObjQTPTest(intNewUpper).Path = objSubjectNode.Path
arrObjQTPTest(intNewUpper).Name = objTest.Name

intNewUpper = intNewUpper + 1
Next
Next

'Cleanup objects
Set objTest = Nothing
Set objTestList = Nothing
Set objTDFilter = Nothing
Set objTestFactory = Nothing
Set objSubjectNode = Nothing
Set objTreeManager = Nothing

GetQTPTestsFromQC = arrObjQTPTest
End Function



'*
'Returns an array for all children of a given Node of a tree.
'
'@param: RootNode strNode in a Test Lab tree.
'
'@return: String Array Array of subnodes paths for the given QC root node.
'*
Public Function GetNodesList(ByVal RootNode)
'Specify Array to contain all nodes of subject tree.
Dim arrStrNodesList()
ReDim Preserve arrStrNodesList(0)
arrStrNodesList(0) = RootNode

Dim objTreeManager, objSubjectNode
Set objTreeManager = QCConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(RootNode)

'Run on all children nodes
Dim i, intNewUpper
For i = 1 To objSubjectNode.Count
'If current node has a child then get path on child nodes too.
If objSubjectNode.Child(i).Count >= 1 Then
Dim arrStrTempNodeList
arrStrTempNodeList = GetNodesList(objSubjectNode.Child(i).Path)

Dim strNode
For Each strNode In arrStrTempNodeList
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)

'Add strNode path to array
arrStrNodesList(intNewUpper) = strNode
Next
Else
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)

'Add strNode path to array
arrStrNodesList(intNewUpper) = objSubjectNode.Child(i).Path
End If
Next

' Cleanup objects
Set objSubjectNode = Nothing
Set objTreeManager = Nothing

GetNodesList = arrStrNodesList
End Function



'*
'Creates a file system folder including parent folders
'
'@param: strFolderPath The fully qualified directory of folders to create.
'
'@return: boolean True is returned if the folders were sucessfully created; False if not.
'*
Function CreateFolderPath(ByVal strFolderPath)
Dim blnRetVal
blnRetVal = False

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Input checking
If strFolderPath <> "" Then
'If the folder doesn't exist then recursively create parent folder
If objFSO.FolderExists(strFolderPath) = False Then
If CreateFolderPath(objFSO.GetParentFolderName(strFolderPath)) = True Then
On Error Resume Next
objFSO.CreateFolder(strFolderPath)
If Err.Number <> 0 Then
Wscript.Echo "Error in creating folder: " & Err.Number
Wscript.Echo "Error (Hex): " & Hex(Err.Number)
Wscript.Echo "Source: " & Err.Source
Wscript.Echo "Description: " & Err.Description
Wscript.Echo "Folder to create: " & strFolderPath

blnRetVal = False
Else
blnRetVal = True
End If
Err.Clear
On Error Goto 0
End If
Else
'Folder exists.
blnRetVal = True
End If
Else
'Either root folder or no path sent.
blnRetVal = False
End If

Set objFSO = Nothing

CreateFolderPath = blnRetVal
End Function



'*
'Provides a nice container for QTP tests Names and Paths.
'*
Class TestClass
Private strName
Private strPath

'Set and Get for Name
Property Get Name
Name = strName
End Property

Property Let Name(sName)
strName = sName
End Property

'Set and Get for Path
Property Get Path
Path = strPath
End Property

Property Let Path(sPath)
strPath = sPath
End Property
End Class




Post Extras: Print Post   Remind Me!   Notify Moderator  
ttguy
Member


Reged: 01/28/09
Posts: 267
Loc: Canberra
Re: verify that mouse pointer is displaying as hand [Re: rscholz660]
      #552187 - 02/22/09 08:50 PM

rscholz660
Quote:

some notes: for "hand" you will get back "65581"




I had a hell of time finding out what cursors would return what values and in the end wrote a script that set the cursor and then called get_cursor_state to see what value it would return.

This what I discovered. Windows have a bunch of Constants for different cursors. They have the IDC_ and OCR_ prefixes. (See http://msdn.microsoft.com/en-us/library/aa453410.aspx).
I created the following constants to represent the return values from calls to get_cursor_state() when the cursor has been set to one of the windows standard cursors.
Eg if the cursor was IDC_CROSS= Crosshair then get_cursor_state will return IDC_CROSS_RET (ie 65559)


Public Const IDC_ARROW_RET = 65553
Public Const IDC_IBEAM_RET = 65555
Public Const IDC_WAIT_RET = 65557
Public Const IDC_CROSS_RET = 65559
Public Const IDC_UPARROW_RET = 65561
Public Const IDC_ICON_RET = 65583
Public Const IDC_SIZENWSE_RET = 65563
Public Const IDC_SIZENESW_RET = 65565
Public Const IDC_SIZEWE_RET = 65567
Public Const IDC_SIZENS_RET = 65569
Public Const IDC_SIZEALL_RET = 65571
Public Const IDC_NO_RET = 65573
Public Const IDC_APPSTARTING_RET = 65575
Public Const OCR_NORMAL_RET = 65553
Public Const OCR_IBEAM_RET = 65555
Public Const OCR_WAIT_RET = 65557
Public Const OCR_CROSS_RET = 65559
Public Const OCR_UP_RET = 65561
Public Const OCR_ICON_RET = 65583
Public Const OCR_SIZENWSE_RET = 65563
Public Const OCR_SIZENESW_RET = 65565
Public Const OCR_SIZEWE_RET = 65567
Public Const OCR_SIZENS_RET = 65569
Public Const OCR_SIZEALL_RET = 65571
Public Const OCR_NO_RET = 65573


Post Extras: Print Post   Remind Me!   Notify Moderator  
Tarun LalwaniModerator
Veteran


Reged: 07/21/05
Posts: 15329
Loc: Milwaukee, Wisconsin
Re: verify that mouse pointer is displaying as han [Re: ttguy]
      #552190 - 02/22/09 09:12 PM

These constants are handle to the cursor and vary on different systems and could be different for different sessions also. There is a workaround though

http://knowledgeinbox.com/articles/qtp/how-to/how-to-get-current-cursor-type-busywaitnormal/

--------------------
Regards,
Tarun
** First ever technical novel - And I thought I knew QTP! **
** Download QTP Unplugged 2nd Edition eBook for FREE **

KnowledgeInbox RSS


Post Extras: Print Post   Remind Me!   Notify Moderator  
linkdotbiz
Member


Reged: 07/23/07
Posts: 290
Loc: Amman, Jordan
Pad Credit Card number [Re: Tarun Lalwani]
      #552644 - 02/24/09 02:13 PM

This function returns the last 4 digits of a credit card number with the rest of the digits replaced by x

Input: Any CC number "4587 4596 4857 4854"
Output: only last 4 digits of CC number displayed "xxxx xxxx xxxx 4854"

Dim cardNumber, cardNumberPadded

cardNumber = "4587 4596 4857 4854"

cardNumberPadded = getPaddedNumber(cardNumber)


Function getPaddedNumber(ccNo)
Dim ccNoLength
Dim last4Digits
Dim temp
ccNoLength = len(ccNo)
last4Digits = right(ccNo,4)
temp = left(ccNo,ccNolength - 4)

'Replace all digits in Temp with X
For i = 0 to len(temp)
If IsNumeric(Mid(temp,i+ 1,1)) Then
temp = Replace(temp, Mid(temp,i+ 1,1),"x",1,1)
End If
Next
temp = temp & last4Digits
getPaddedNumber = temp
End Function

Edited by linkdotbiz (02/24/09 02:19 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
shivjsw
Newbie


Reged: 04/22/09
Posts: 6
Re: Donate a user defined function to this topic [Re: IanFraser]
      #564478 - 04/22/09 08:07 AM

Shiva

Post Extras: Print Post   Remind Me!   Notify Moderator  
NoUse4aName
Super Member


Reged: 06/13/08
Posts: 1720
Re: Pad Credit Card number [Re: linkdotbiz]
      #564514 - 04/22/09 09:28 AM

Quote:

This function returns the last 4 digits of a credit card number with the rest of the digits replaced by x





Aren't you overcomplicating that? Why not just use this?

ccNo = "4587 4596 4857 4854"
temp="xxxx xxxx xxxx "&right(ccNo,4)

Edited by NoUse4aName (04/22/09 09:58 AM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
Adai
Member


Reged: 07/23/03
Posts: 77
Loc: Boston
Re: Donate a user defined function to this topic [Re: qamanohar]
      #565108 - 04/24/09 01:57 PM

' ==============================================
'Terminate a Process in Windows OS
'say notepad
' ==============================================

Function terminateProcess(v_process)

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '"&v_process&"'")
For Each objProcess in colProcessList
objProcess.Terminate()
msgbox "Terminated one process of "&v_process
Next

End Function

'usage
terminateProcess "notepad.exe"

--------------------
Adai


Post Extras: Print Post   Remind Me!   Notify Moderator  
Invinsible
Newbie


Reged: 07/18/08
Posts: 9
Re: Donate a user defined function to this topic [Re: Adai]
      #565846 - 04/29/09 01:13 AM

We found 2 problems with the above terminateProcess function
1). It will not gracefully terminate the process [unless you want to pskill the process ;-)]
2). It will not able to terminate 64 bits executable

'@Description As a replacement to terminate process [Replace Sub Terminate(component)] as Terminate(component) failed to terminate 64 bits executable
'@processName The process name, for example program_32.exe, program_64.exe, javaw.exe"
'@commandLineSpec The substring of the command line to start up the process
Sub TerminateProcess(ByVal processName, ByVal commandLineSpec)
Dim objWMIService, objProcess, colProcess
Dim strComputer
Dim terminated

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process where name = '" & processName & "'")
For Each objProcess in colProcess
If instr(1, lcase(objProcess.CommandLine), lcase(commandLineSpec)) > 0 Then
terminated = SystemUtil.CloseProcessById(objProcess.ProcessId)
If terminated Then
Reporter.ReportEvent micDone, "Terminate process with ProcessName[" & processName & "], ProcessId[" & objProcess.ProcessId & "], commandLineSpec[" & commandLineSpec & "]", "Terminated successfully"
Else
Reporter.ReportEvent micWarning, "Terminate process with Process name[" & processName & "], ProcessId[" & objProcess.ProcessId & "], commandLineSpec[" & commandLineSpec & "]", "Terminated fail"
End If
End If
Next

Set objWMIService = Nothing
Set colProcess = Nothing
End Sub


Post Extras: Print Post   Remind Me!   Notify Moderator  
ttguy
Member


Reged: 01/28/09
Posts: 267
Loc: Canberra
GenerateTestParameterInfoString function [Re: Invinsible]
      #589844 - 09/09/09 12:11 AM

GenerateTestParameterInfoString function.
Call this to get data on the parameters on the QTP Test.
You can access the values of the parameters passed to the test at run time without having to pass them through action parameters.
It iterates through all the tests parameters giving you info on them.

Code:
 
Public function GenerateTestParameterInfoString

Dim qtApp
Dim pDefColl 'As QuickTest.ParameterDefinitions ' Declare a Parameter Definitions collection
Dim pDef ' As QuickTest.ParameterDefinition ' Declare a ParameterDefinition object

Dim cnt, Indx
Dim sString

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


' Retrieve the parameters collection defined for the test.
set pDefColl = qtApp.Test.ParameterDefinitions ' qtApp.Test is an object of type name "Test"
' pDefColl is an object of type "ParameterDefinitions"
cnt = pDefColl.Count
Indx = 1

' Display the names and values of each of the parameters in the collection.
While Indx <= cnt
Set pDef = pDefColl.Item(Indx)' get a ParameterDefinition object

sString = sString & "Param name: " & pDef.Name & "; Type: " & pDef.Type & "; InOut: " & pDef.InOut & "; Description: " _
& pDef.Description & "Default value: " & pDef.DefaultValue & "; Current value: " & TestArgs(pDef.Name) & vbNewLine

Indx = Indx + 1
Wend

GenerateTestParameterInfoString=sString

Set pDefColl = nothing
Set pDef = nothing
end function



Post Extras: Print Post   Remind Me!   Notify Moderator  
vampire123
Member


Reged: 09/27/06
Posts: 171
Loc: Washington DC
Re: GenerateTestParameterInfoString function [Re: ttguy]
      #589958 - 09/09/09 07:14 AM

'This function deletes a row from data table at run time
'DtSheet : Pass the sheet name
'Row: Pass the row number
''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function DeleteRow(DtSheet,Row)
Dim i,tmp
For i=Row+1 to DtSheet.GetRowCount
For j=1 to DtSheet.GetParameterCount
DtSheet.SetCurrentRow i
tmp=DtSheet.GetParameter(j).value
DtSheet.SetCurrentRow i-1
DtSheet.GetParameter(j).value=tmp
Next
Next
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
JosephTN
Junior Member


Reged: 04/28/04
Posts: 29
Re: Donate a user defined function to this topic [Re: ppat7046]
      #589999 - 09/09/09 09:10 AM Attachment (784 downloads)

Function ReadFileFromQC (FileName, FilePath)
'Function retrieves a file from Quality Center
and downloads it to the local machine for use in the test

'Example
sqlQuery = ReadFileFromQC ("Query.sql", "Project\Query")


Post Extras: Print Post   Remind Me!   Notify Moderator  
wentleft
Newbie


Reged: 01/11/10
Posts: 2
Re: Donate a user defined function to this topic [Re: Blue_Motorcycle]
      #609927 - 01/18/10 12:40 PM

Hi im trying 2 use this function but i cant get it 2 work
can u please point me in right direction
tnx


Post Extras: Print Post   Remind Me!   Notify Moderator  
wentleft
Newbie


Reged: 01/11/10
Posts: 2
Re: Donate a user defined function to this topic [Re: Blue_Motorcycle]
      #609940 - 01/18/10 05:23 PM

i removed from script 'function - end function'
problem solved
tnx


Post Extras: Print Post   Remind Me!   Notify Moderator  
ttguy
Member


Reged: 01/28/09
Posts: 267
Loc: Canberra
GetScreenResolution [Re: wentleft]
      #615031 - 02/23/10 06:59 PM

' GetScreenResolution - returns the current horizontal
'and vertical screen resolution (screen size) in pHorizontal , pVertical

' based on code from
'http://www.visualbasicscript.com/tm.aspx?m=33901

Code:
 
Public function GetScreenResolution (pHorizontal , pVertical )

Dim objWMIService, colItems, objItem, intHorizontal , intVertical , rowcount
Set objWMIService = GetObject("Winmgmts:\\.\root\cimv2") ' using Windows Managment Instrumentation
' WMI http://msdn.microsoft.com/en-us/library/aa394591(VS.85).aspx

Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0)
rowcount = 0
For Each objItem in colItems
pHorizontal = objItem.ScreenWidth
pVertical = objItem.ScreenHeight
rowcount = rowcount + 1
Next
If rowcount <> 1 Then
reporter.ReportEvent micFail, "GetScreenResolution - Bad number of rows from Win32_DesktopMonitor","rowcount = " & rowcount
End If

End Function



Post Extras: Print Post   Remind Me!   Notify Moderator  
Nageshp24
Member


Reged: 07/24/09
Posts: 162
Re: GetSystem Environment Variable [Re: ttguy]
      #615232 - 02/24/10 09:49 PM

HI,

'*********************************************************************************
' Name: Util_GetSysEnVal ()
' Purpose: Gets the value from the specified System Environment variable.
' Input variables: None
'History: Created by Nagesh
'*********************************************************************************
Public Function Util_GetSysEnVal(sEnvVar)
Err.Clear

' Variable Declaration
Dim WshShell 'Windows Shell Object
Dim SysEnv 'System Environment propety of the Windows shell object.

Set WshShell = CreateObject("WScript.Shell")
Set SysEnv = WshShell.Environment("SYSTEM")

'Get the value for the provided system variable
Util_GetSysEnVal = SysEnv(sEnvVar)

'Release objects
Set WshShell = Nothing

'Error handling
If Err.Number <> 0 Then
Util_GetSysEnVal = Err.Number
End If
End Function

Edited by Nageshp24 (02/24/10 09:51 PM)


Post Extras: Print Post   Remind Me!   Notify Moderator  
cbueche
Member


Reged: 02/28/04
Posts: 120
Loc: Germany
INIT_FUCTIONBUILDER_ARRAY [Re: Nageshp24]
      #616550 - 03/05/10 08:00 AM Attachment (98 downloads)

'######################################
' start Sub INIT_FUCTIONBUILDER_ARRAY
' If you like to use excel header as
' Functions
'######################################
Private Sub INIT_FUCTIONBUILDER_ARRAY
ParamTotal = DataTable.GetSheet("Global").GetParameterCount
CountParamTotal=0
ReDim Arr_FunctionBuilder(ParamTotal-1)
Arr_FunctionBuilder_TXT=""
For i=0 to ParamTotal-1
Arr_FunctionBuilder(i) = DataTable.GetSheet("Global").GetParameter(i+1).Name
Arr_FunctionBuilder_TXT= Arr_FunctionBuilder_TXT & ">" & Arr_FunctionBuilder(i) & "<" & "=" & chr(34) & DataTable(Arr_FunctionBuilder(i), dtGlobalSheet) & chr(34) & "_|_" & vbLf
Next
Reporter.ReportEvent micInfo, "Functions used as header from table= " , Arr_FunctionBuilder_TXT
End Sub
'######################################
' END Sub INIT_FUCTIONBUILDER_ARRAY
'######################################

For EACH function_use in Arr_FunctionBuilder
rc=eval( function_use)
next

"Function_use" can be any public function from a Library that order wise the For loop iterates through the Excel headers from Left to right


I needed this to realize the Framework.

http://www.sqaforums.com/showflat.php?Cat=0&Number=607766&an=0&page=2#Post607766

--------------------
Catch the train on rail of fasten, proven and easy solutions.

I have succesfully arranged a workflow Independent Framework for QTP like the EMOS Framework for WR


Post Extras: Print Post   Remind Me!   Notify Moderator  
gkp
Member


Reged: 05/06/07
Posts: 58
Re: Donate a user defined function to this topic [Re: IanFraser]
      #634555 - 07/13/10 09:49 PM

I had a requirement of changing the file extension from .csv to .in
Following is the function that changes the extension

Function ChangeFileExtension

'Option Explicit

Dim objFSO, objFolder, objFile, strNewName, strOldName
Dim strPath, strName

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Documents and Settings\kgande\Desktop\Files\Automation")
For Each objFile In objFolder.Files
' Check if file name ends with ".csv".
If lcase(objFSO.GetExtensionName(objFile.Name)) = "csv" then
' Rename the file.
strOldName = objFile.Path
strPath = objFile.ParentFolder
strName = objFile.Name
' Change name by changing extension to ".in"
strName = Left(strName, Len(strName) - 4) & ".in"
strNewName = strPath & "\" & strName
' Rename the file.
objFSO.MoveFile strOldName, strNewName
End If
Next
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
Pine12
Newbie


Reged: 09/11/08
Posts: 8
Re: Donate a user defined function to this topic [Re: ppat7046]
      #634597 - 07/14/10 05:10 AM

Function to zip all the contents in a folder
-----------------------------------------------------------
Function ZipFolder( myFolder, myZipFile )
Dim intSkipped, intSrcItems
Dim objApp, objFolder, objFSO, objItem, objTxt
Dim strSkipped
Const ForWriting = 2
intSkipped = 0
' Make sure the path ends with a backslash
If Right( myFolder, 1 ) <> "\" Then
myFolder = myFolder & "\"
End If
' Use custom error handling
On Error Resume Next
' Create an empty ZIP file
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
objTxt.Close
Set objTxt = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
' Create a Shell object
Set objApp = CreateObject( "Shell.Application" )
' Copy the files to the compressed folder
For Each objItem in objApp.NameSpace( myFolder ).Items
If objItem.IsFolder Then
' Check if the subfolder is empty, and if
' so, skip it to prevent an error message
Set objFolder = objFSO.GetFolder( objItem.Path )
If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
intSkipped = intSkipped + 1
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Next

Set objFolder = Nothing
Set objFSO = Nothing

' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Set objApp = Nothing
Err.Clear
On Error Goto 0
Exit Function
End If

' Keep script waiting until compression is done
intSrcItems = objApp.NameSpace( myFolder ).Items.Count
Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
WScript.Sleep 200
Loop
Set objApp = Nothing

' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If

' Restore default error handling
On Error Goto 0

' Return message if empty subfolders were skipped
If intSkipped = 0 Then
strSkipped = ""
Else
strSkipped = "skipped empty subfolders"
End If

' Return code 0 (no error occurred)
ZipFolder = Array( 0, intSkipped, strSkipped )
End Function


Post Extras: Print Post   Remind Me!   Notify Moderator  
AnandTambey
Advanced Member


Reged: 11/11/07
Posts: 647
Loc: India
Re: Donate a user defined function to this topic [Re: IanFraser]
      #647487 - 11/02/10 06:04 AM

If you use QTP 10: Code Sample Plus is good repository of user defined functions on various topics by HP, a very good resource for beginners and as well as advanced usages.

The examples,tips,good help(QTPCodeSamplesPlus.chm) and the function libraries can be found in the <QuickTest installation folder>\CodeSamplesPlus folder.

General Purpose Scripts
Normalizing Strings
Debugging using File Operations
Using Message Boxes That Close Automatically
Generating Random Strings
Using the Dictionary Object
Using Data Table Formulas
Getting the Most Out of QuickTest Test Objects
Enumerating Application Objects
Using the QuickTest Professional Object Model Hierarchy
Highlighting Objects
Getting Standard Text
Registering User-Defined Functions as Test Object Methods
Right-Clicking Objects Using Device Replay
Sending Keyboard Input to an Application
Sample Scripts for the Web Environment
Useful Web Table Functions
Common DOM Methods & Properties
Sample Scripts for the Standard Windows Environment
Highlighting Objects from the Same Class
Adding Defects to Quality Center
Using Microsoft Objects
Using Microsoft Excel Objects
Using Microsoft Word Spell Check
Using Microsoft Outlook to Send Email
Using the File System Object (FSO)
Using Database Functions

--------------------
Kind regards,
Anand Tambey

RSS Feed : Break To Make it Better
A Lazy person could be the best automation professional, if he is not lazy in implementing his ideas to reduce his work. ~Anand Tambey


Post Extras: Print Post   Remind Me!   Notify Moderator  
ttguy
Member


Reged: 01/28/09
Posts: 267
Loc: Canberra
Donate a user defined function - GetROProperties [Re: AnandTambey]
      #683805 - 08/31/11 06:31 PM

The functions/Subs here create a GetROProperties (plural) function in QTP. This is sometimes convenient when you would like to list all the runtime properties of an object so you know what you are dealing with. I am suprised that QTP does not already have such a thing. It has one for Test Object properties (GetTOProperties) but not run time properties.
I also include a PrintObjectsRuntimeProperties function that is conventient for printing the data to QTPs print log
So here it is.

Code:

' There is no GetROProperties (plural) function in QTP
' There is a GetTOProperties function that returns a collection of Test Object properties
' This function sort of does what you would like GetROProperties to do. It prints to the Print Log a list of the RO properties and their values

Public Sub PrintObjectsRuntimeProperties (pObject, pIncludeBlanks)
Dim propCollection, propX
print "Properties for object '" & pObject.ToString & "'"
Set propCollection = GetRuntimeObjectProperties (pObject) ' another ttguy function - see below
For each propX in propCollection
If (not pIncludeBlanks and propX.PropValue <>"" ) or pIncludeBlanks Then
print propX.PropName & " = " & propX.PropValue
end if
Next
End Sub


' GetRuntimeObjectProperties (pObject)
' There is no Built in GetROProperties (plural) function in QTP
' There is a GetTOProperties function that returns a collection of Test Object properties
' This function does what you would like GetROProperties to do.
' It Returns an System.Collections.ArrayList containing a collection of ROProperty objects
' ROProperty objects have a PropName and a PropValue


Public Function GetRuntimeObjectProperties (pObject)
Dim Props, PropsCount, PropName, PropValue, i, propCollection, prop


Set propCollection =CreateObject ("System.Collections.ArrayList") '
If pObject.exist(1) Then
'http://www.robvanderwoude.com/vbstech_data_arraylist.php

Props = GetRuntimeObjectPropertiesNames(pObject) ' another ttguy function - see below
PropsCount =ubound( Props)
For i = 0 To PropsCount
PropName = Props(i)
PropValue =pObject.GetROProperty(PropName)
Set prop = New ROProperty ' This is a User defined Class defined at the begining of my function lib. See code below
prop. PropName= PropName
prop. PropValue=PropValue
propCollection.Add prop

Next

else
Print pObject.ToString & " does not exist"
Set prop = New ROProperty
prop. PropName= pObject.ToString & " does not exist"
prop. PropValue= pObject.ToString & " does not exist"
propCollection.Add prop

End If
set GetRuntimeObjectProperties=propCollection ' returning an System.Collections.ArrayList containing a collection of ROProperty objects
' ROProperty objects have a PropName and a PropValue

end function



' GetRuntimeObjectPropertiesNames - gets the names of the properties for a given Run Time object pObject
' For Win* type objects the registry for those objects are empty
' eg SOFTWARE\Mercury Interactive\QuickTest Professional\MicTest\Test Objects\WinObject\Properties
' has no entries
' So for these types it uses a hard coded list of properties that ttguy pulled of a WinObject
' So this should work for WinObjects at least

Private Function GetRuntimeObjectPropertiesNames (pObject)
' code adapted from
' http://motevich.blogspot.com/2008/11/qtp-object-indentification-properties.html
' A blog by Dmitry Motevich
' It goes to the registry to find the list of Rutime Object properties an object of a given class has

Dim oReg, sKeyPath, arrNames, vClassName
vClassName = pObject.GetTOProperty ("Class Name")
'vvvv StringRegX - another ttguy function. see below
If not StringRegX (vClassName , "Win.*") and not vClassName="Static" and not StringRegX (vClassName , "Vb.*") Then ' Class names not matching these criteria have the property types available stored in the registry
' So I use this registry reading functionality to pull the values out

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

' see also http://www.serverwatch.com/tutorials/print.php/1476861 for stuff on "Managing Windows Registry with Scripting "
sKeyPath = "SOFTWARE\Mercury Interactive\QuickTest Professional\MicTest\Test Objects\" & pObject.GetTOProperty ("Class Name") & "\Properties"
oReg.EnumValues HKEY_LOCAL_MACHINE, sKeyPath, arrNames ' 'HKEY_LOCAL_MACHINE - a constant globally declared in my function library. See below


elseif StringRegX (vClassName , "Vb.*") Then ' classes begining with Vb I know have a certain list of properties available - that ttguy determined by looking at an object of this type in QTP object spy
' This array is the same as below but with the addition of vbname, location and vbname path
arrNames = Array("vbname", "location","vbname path","abs_x" , "abs_y" , "attached text" , "enabled" , "focused" , "hashscroll" , "hasvscroll" , "height" , "hscrollpagesize" , "hscrollposition" , "hwnd" , "leftscrollbar" , "maxhscrollpos" , "maxvscrollpos" , "minhscrollpos" , "minvscrollpos" , "nativeclass" , "object class" , "regexpwndclass" , "regexpwndtitle" , "rightaligned" , "righttoleftlayout" , "righttoleftreading" , "text" , "visible" , "vscrollpagesize" , "vscrollposition" , "width" , "window id" , "windowextendedstyle" , "windowstyle" , "x" , "y" )
else ' Resistry does not list properties of objects with Class Names begining with Win or for Class Name Static. So hard code these
' This list of properties RLM pull off a WinObject object. So this should work for WinObjects at least
arrNames = Array( "abs_x" , "abs_y" , "attached text" , "enabled" , "focused" , "hashscroll" , "hasvscroll" , "height" , "hscrollpagesize" , "hscrollposition" , "hwnd" , "leftscrollbar" , "maxhscrollpos" , "maxvscrollpos" , "minhscrollpos" , "minvscrollpos" , "nativeclass" , "object class" , "regexpwndclass" , "regexpwndtitle" , "rightaligned" , "righttoleftlayout" , "righttoleftreading" , "text" , "visible" , "vscrollpagesize" , "vscrollposition" , "width" , "window id" , "windowextendedstyle" , "windowstyle" , "x" , "y", "checked" )

End If
redim preserve arrNames (ubound(arrNames) + 1)
arrNames (ubound(arrNames)) ="micclass"
GetRuntimeObjectPropertiesNames =arrNames
End Function


' StringRegX - returns true if string matches the regular expression
' Don't for get to excape characters that have special meaining if you want to literally match them
' eg To match parentheses characters ( ), use "\(" or "\)".
' to match literal full stop use "\."

Public Function StringRegX (pString , pValueRegX)

Dim regEx ' Create variable.
Set regEx = New RegExp ' Create regular expression.
regEx.Pattern = pValueRegX ' Set pattern.
regEx.IgnoreCase = TRUE ' Set case sensitivity.


StringRegX= regEx.Test(pString)
end function


' Class ROProperty used by GetRuntimeObjectPropertiesNames
Class ROProperty
' Properties and methods go here.
public PropName, PropValue

End Class

' QTP thinks the next line is a syntax error but it is not. And QTP will run even though QTP complains about it when you save this library
Const HKEY_LOCAL_MACHINE = &H80000002 ' a Hexa decimal number




Post Extras: Print Post   Remind Me!   Notify Moderator  
ttguy
Member


Reged: 01/28/09
Posts: 267
Loc: Canberra
Donate a user defined function - XMLFileCompare [Re: ttguy]
      #683807 - 08/31/11 06:55 PM

Gurvinder_Singh (this post) wanted to know how to compare XPS files. I have never heard of them until then. But now I know they are
XML Paper Specification files. So my guess is that they contain XML data. And thus you might be able to compare them using
QTPs XMLUtil object. So here is my XMLFileCompare function



Code:


' XMLFileCompare.
' Returns true if the two XML files pFile1 and pFile2 are the same.
' Returns false if the two XML files are different. If they are different it writes an XML file showing the differences to pDifferencesFile
'
'

Public Function XMLFileCompare(pFile1, pFile2, pDifferencesFile)
' Taken from http://www.onestopsoftwaretesting.com/2008/11/xml-validations-in-qtp-compare-xml.html and modified
' This link is now dead however
Dim doc1, doc2, resultDoc, res
Set doc1 = XMLUtil.CreateXML() ' creates an XMLData object

doc1.LoadFile pFile1 ' Initializes an XMLData object using the specified XML file

Set doc2 =XMLUtil.CreateXML() ' creates an XMLData object

doc2.LoadFile pFile2 ' Initializes an XMLData object using the specified XML file

' doco on XMLData.Compare pulled from some help document ?
' Compares the specified XML document with the current XMLData object and creates a new XMLData object containing the differences.
' This method returns a boolean value indicating whether or not the two files are equal.
' XMLData.Compare(XMLDocument, ResultXMLDocument [, Filter])
' ResultXMLDocument XMLData An XMLData object containing the differences between the XMLData object and the XML document specified
' in the XMLDocument argument, according to the specified Filter argument (if any).
' Filter Number or pre-defined constant Optional. The XML DOM node information to be compared:
' 0 or micXMLNone: Compares the elements and document type declaration of the specified XML documents.
' 1 or micXMLAttributes: Compares the attributes of the specified XML documents, in addition to their elements and document type declaration.
' 2 or micXMLCDataSections: Compares the CDATA sections of the specified XML documents, in addition to their elements and document type declaration.
' 4 or micXMLValues: Compares the #text nodes of the specified XML documents, in addition to their elements and document type declaration.
' Note: If you do not use this parameter, the Document Type Declaration, Elements, Attributes, #text nodes, and CDATA sections are all compared.
' You can specify more than one filter, separated by a plus (+) symbol. For example, micXMLValues+micXMLAttributes.


res = doc1.Compare(doc2,resultDoc,micXMLValues+micXMLCDataSections)

if res then

XMLFileCompare = TRUE

else

XMLFileCompare=FALSE
resultDoc.SaveFile pDifferencesFile
end if
Set doc1 = nothing
set doc2 = nothing
set resultDoc = nothing
End Function



Post Extras: Print Post   Remind Me!   Notify Moderator  
avinash_sqa_frms
Member


Reged: 05/27/09
Posts: 155
Impersonation in QTP [Re: IanFraser]
      #700264 - 03/03/12 12:33 AM Attachment (430 downloads)

Sharing multiple approaches to achieve Impersonation in QTP

Post Extras: Print Post   Remind Me!   Notify Moderator  
indiranis
Member


Reged: 03/05/12
Posts: 85
Re: Donate a user defined function to this topic [Re: IanFraser]
      #703946 - 04/11/12 03:42 AM

Calling my Sql Server 2008 Procedure through QTP.

Call RunStoredProcedure()

Function RunStoredProcedure()

Dim Conn, Cmd, oRs

Set Conn = CreateObject("ADODB.Connection")
Conn.CursorLocation = 3
Set Cmd = CreateObject("ADODB.Command")

Conn.Open "Provider =SQLNCLI10; Data Source=;Initial Catalog=eip;User ID=testingteam;Password=password;"

MsgBox "Connection Opened"

Cmd.ActiveConnection = Conn

' Set the command type to Stored Procedures
Cmd.CommandText = "authorized_users_fortesting"
Cmd.CommandType = &H0004

''Add Input Parameters
'Cmd.Parameters("@staff_name")=staff_name1
'Cmd.Parameters("@Dept_code")=job


Cmd.Parameters.Refresh()
Cmd.Parameters("@staff_name") =user_name
Cmd.Parameters("@Dept_code") =job_code

Set oRs=Cmd.Execute()

Dim RecordSetCounter, TotalNumberofRecords
TotalNumberofRecords = oRs.RecordCount
msgbox TotalNumberofRecords
msgbox Cmd.Parameters("@staff_name").Value

msgbox Cmd.Parameters("@Dept_code").Value

'msgbox oRs.fields(0).value
'msgbox oRs.fields(1).value

Dim username, pwd

username=oRs.fields(0).value
password=oRs.fields(1).value

Conn.Close
Set Conn=Nothing


Regards,
Indra


Post Extras: Print Post   Remind Me!   Notify Moderator  
avinash_sqa_frms
Member


Reged: 05/27/09
Posts: 155
DotNet based sftp Solution for private key auth [Re: IanFraser]
      #705067 - 04/24/12 09:28 PM

DotNet based sftp Solution for private key authentication
Code:

'Steps
' Download poratble winscp.exe from winscp download page http://winscp.net/eng/download.php. ( Direct link: http://winscp.net/download/winscp506.zip)
' Download NET assembly/COM library corresponding to same version of winscp.exe (Direct link : http://winscp.net/download/winscp506automation.zip)
' Extract both files to c:\temp\ ('change the path as required)

'QTP code to perform sftp based on private key based authentication
Environment.Value("WinSCPDir") = "c:\temp\winscp\winscp.dll"

'Create instance of sFtpClass
Dim oSftp
Set oSftp = New sFtp

With oSftp

'Add FTP parameters in defined dictonary object inside oSftp
.oDictFTPConfig.Add "Server", "yourservername"
.oDictFTPConfig.Add "UserName", "username"
.oDictFTPConfig.Add "Password", ""
.oDictFTPConfig.Add "HostAuthKey", "ssh-rsa 1024 xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx"
.oDictFTPConfig.Add "ValidationKeyFile", "c:\temp\winscp\keyFiles\f1.ppk"

bCommandResult = oSftp.ConnectToServer

'If connection was succesfull then
If bCommandResult = true Then
Reporter.ReportEvent micPass, "Step: Connect to ftp server" , "Connection successfull"
strLocalFilePath = "c:\temp\toupload\file1.txt"
strRemotePath = "/"

'Perform transfer
bCommandResult = oSftp.PutFile( strLocalFilePath, strRemotePath)
Else
'Report the issue with connection
Reporter.ReportEvent micFail, "Step: Connect to ftp server" , "Connection failed due to error " & Err.description
End If

End with

Set oSftp = Nothing


'FTP to server
Class Sftp
Private oWinSCPSessionOptions
Private oWinSCPSessionProtocol
Private oWinSCPSession
Private oWinSCPTransferOptions
Private oWinSCPTransferMode
Private oWinSCPTransferOperationResult
Public oDictFTPConfig

Private Sub Class_Initialize()
strWinSCPDllPath = Environment.Value("WinSCPDir") ' "C:\TEMP\WinSCP\winscp.dll"
Set oWinSCPSessionOptions = DotNetFactory.CreateInstance("WinSCP.SessionOptions", strWinSCPDllPath )
Set oWinSCPSessionProtocol = DotNetFactory.CreateInstance("WinSCP.Protocol", strWinSCPDllPath)
Set oWinSCPSession = DotNetFactory.CreateInstance("WinSCP.Session", strWinSCPDllPath)
Set oWinSCPTransferOptions = DotNetFactory.CreateInstance("WinSCP.TransferOptions",strWinSCPDllPath)
Set oWinSCPTransferMode = DotNetFactory.CreateInstance("WinSCP.TransferMode",strWinSCPDllPath)
Set oDictFTPConfig = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate
oWinSCPSession.Dispose()
Set oWinSCPSessionOptions = Nothing
Set oWinSCPSessionProtocol = Nothing
Set oWinSCPSession = Nothing
Set oWinSCPTransferOptions = Nothing
Set oWinSCPTransferMode = Nothing
End Sub

Public Function ConnectToServer()


With oWinSCPSessionOptions
.Protocol = oWinSCPSessionProtocol.Sftp
.HostName = oDictFTPConfig("Server")
.UserName = oDictFTPConfig("UserName")
.Password = oDictFTPConfig("Password")
.SshHostKey = oDictFTPConfig("HostAuthKey")
.SshPrivateKey = oDictFTPConfig("ValidationKeyFile")
End with

oWinSCPSession.Open(oWinSCPSessionOptions)
oWinSCPTransferOptions.TransferMode = oWinSCPTransferMode.Automatic

If Err.Number <> 0 Then
ConnectToServer = False
Else
ConnectToServer = True
End If
End Function


Public Function PutFile (strLocalFile , strRemotePath)

Set oWinSCPTransferOperationResult = oWinSCPSession.PutFiles(strLocalFile , strRemotePath, false, oWinSCPTransferOptions)

If Err.Number <> 0 Then
PutFile = False
Reporter.ReportEvent micFail, "Step: Transfer file <local: " & strLocalFile & " > to < remote: " & strRemotePath & " > " , "Transfer failed due to error " & Err.description
Else
Reporter.ReportEvent micPass, "Step: Transfer file <local: " & strLocalFile & " > to < remote: " & strRemotePath & " > " , "Transfer Successful"
End If

End Function
End Class




Post Extras: Print Post   Remind Me!   Notify Moderator  
Pages: 1 | 2 | 3 | 4 | 5 | 6 | 7 | >> (show all)



Extra information
0 registered and 68 anonymous users are browsing this forum.

Moderator:  IanFraser, Rajkumar_Rajangam, thorwath, TReddy, AJ, Tarun Lalwani, mwsrosso 

Print Topic

Forum Permissions
      You cannot start new topics
      You cannot reply to topics
      HTML is disabled
      UBBCode is enabled

Rating: *****
Topic views: 69327

Rate this topic

Jump to

Contact Us | Privacy statement SQAForums

Powered by UBB.threads™ 6.5.5