WaitThroughCaptureBitmap

Function WaitThroughCaptureBitmap(objRef, intWait)
    WaitThroughCaptureBitmap = false
    Dim strOldScreenshot, strNewScreenshot, blnFlag, intWaits
    blnFlag = False
    intWaits = 0

    Do While Not blnFlag = True
    ''@Define file names
    strOldScreenshot = Environment.Value("SystemTempDir") & Replace(Date,"/","") & Replace(Time,":","") & ".bmp"
    iWait (1)
    strNewScreenshot = Environment.Value("SystemTempDir") & Replace(Date,"/","") & Replace(Time,":","") & ".bmp"
    ''@Take a screenshot
        objRef.CaptureBitmap strOldScreenshot,True
        iWait (2)
        objRef.CaptureBitmap strNewScreenshot,True

        Set objFcomapre = CreateObject("Mercury.FileCompare")

        If objFcomapre.isequalbin(strOldScreenshot, strNewScreenshot, 0, 1) Then
            blnFlag = True
        End If

        If Cint(intWaits) = Cint(intWait) Then
            Exit Do
        End If
        intWaits = intWaits + 1
    Loop
    If blnFlag Then
        WaitThroughCaptureBitmap = true
    Else
        WaitThroughCaptureBitmap = false
    End If
    DeleteFilesFromDirectory Split(Environment.Value("SystemTempDir"), "\Temp") (0), "bmp"
End Function


Function DeleteFilesFromDirectory(strDirectory,strExtensionsToDelete)
    Dim objFolder, objSubFolder, objFile, strExt
    Set objFSO = createobject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDirectory)

    For each objFile in objFolder.Files
        For each strExt in SPLIT(UCASE(strExtensionsToDelete),",")
            If RIGHT(UCASE(objFile.Path),LEN(strExt)+1) = "." & strExt Then
                objFile.Delete
                Exit For
            End If
        Next
    Next
    Set objFSO = Nothing
    Set objFolder = Nothing
End Function

Kill/Terminate running Process

''@ Example Call KillProcess("Iexplore.exe")
''---------------------------------------------------------------------------------------------------------------------------
Sub KillProcess(strProcessName)
    strComputer=environment.Value("LocalHostName")
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    strQuery="Select * from Win32_Process Where Name ='"&strProcessName&"'"
    Set colProcesses = objWMIService.ExecQuery (strQuery)
    For Each objProcess in colProcesses
        objProcess.Terminate()
    Next
End Sub

Synchronization in QTP and Mouse Operations

HomeBrowserPage.Link(LogoutBtnVar, "index:=0").ExistCheck
HomeBrowserPage.Link(AdminLnkVar, "index:=0").WaitforObj 5



Public Function CheckIfExist(ByRef test_object, iWaitTime)
    CheckIfExist = False
    If isObjectLoaded(test_object, iWaitTime) Then
        reporter.ReportEvent micPass, test_object.GetRoProperty("name"), test_object.GetRoProperty("name") & " exists."
        CheckIfExist = True
    Else
        CheckIfExist = False
        Reporter.ReportEvent micWarning, "The Object: "& test_object & "doesn't exist", "The Object: "& test_object & "doesn't exist"
    End If
End Function
RegisterUserFunc "WebArea", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebEdit", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebCheckBox", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebElement", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebRadioGroup", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebList", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebButton", "ExistCheck", "CheckIfExist"
RegisterUserFunc "Link", "ExistCheck", "CheckIfExist"
RegisterUserFunc "Image", "ExistCheck", "CheckIfExist"
RegisterUserFunc "WebTable", "ExistCheck", "CheckIfExist"
RegisterUserFunc "Page", "ExistCheck", "CheckIfExist"
RegisterUserFunc "Browser", "ExistCheck", "CheckIfExist"
RegisterUserFunc "Frame", "ExistCheck", "CheckIfExist"



isObjectLoaded= isObjectLoaded
Function isObjectLoaded(sObjName, iWaitTime)
    isObjectLoaded = False
    Cnt = 0
    Do
        If sObjName.Exist(2) Then           
            If StrComp(Lcase(Trim(sObjName.Object.readyState)), "complete",1) = 0 or StrComp(CStr(sObjName.Object.readyState), "4",1) = 0 Then           
                isObjectLoaded = True
                Exit Do
            Elseif Cnt  = sWaitTime Then
                Exit Do
            End If
        Elseif Cnt  = sWaitTime Then
            Exit Do
        End If      
        Cnt = Cnt + 1
    Loop Until isObjectLoaded = True
End Function



'step1= Browser("Login").Page("Login").Image("BC-Logo").MouseOpr (1, 1, "rightclk")
'step1=Browser("collaborative sourcing").Page("collaborative sourcing").Frame("fraLeftFrame").Link("Page Settings").MouseOpr (3,5, "mousemove")
Public Function MouseOprations(ByRef objRef, intX, intY, strOpr)
   MouseOprations=False
   If isObject(objRef) Then
'        objRef.waitForObj 10
       objRef.Highlight   
       wait 1      
       x=objRef.getROProperty("abs_x")
       y=objRef.getROProperty("abs_y")
       Set objMouse=CreateObject("Mercury.DeviceReplay")
       Select Case LCase(Trim(strOpr))
       Case "clk"
           objMouse.MouseClick x+Cint(intX), y+CInt(intY), Left_Mouse_Button
           MouseOprations=True
        Case "rightclk"
            objMouse.MouseMove x+Cint(intX), y+CInt(intY)
            objMouse.MouseClick x+Cint(intX), y+CInt(intY), Right_Mouse_Button
            MouseOprations=True
        Case "dblclk"
            objMouse.MouseDblClick  x+Cint(intX), y+CInt(intY), Left_Mouse_Button
            MouseOprations=True
        Case "mousemove"
            objMouse.MouseMove x+Cint(intX), y+CInt(intY)
            wait 1
            MouseOprations=True
       End Select
    Set objMouse=Nothing
   End If     
End Function
RegisterUserFunc "WebButton", "MouseOpr", "MouseOprations"
RegisterUserFunc "Image", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebEdit", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebCheckBox", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebElement", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebRadioGroup", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebList", "MouseOpr", "MouseOprations"
RegisterUserFunc "Link", "MouseOpr", "MouseOprations"
RegisterUserFunc "WebElement", "MouseOpr", "MouseOprations"




'' To Maximize Browser
Function MaxBrowser()
   Set objWS = CreateObject("WScript.Shell")
   objWS.SendKeys "% "
   wait 1
   objWS.SendKeys "x"  
   Set objWS=Nothing
End Function


Function MaximizeBrowser(objBrowser)
    Dim hWnd
    objBrowser.Sync
    hWnd = objBrowser.GetROProperty("hwnd")
     On Error Resume Next
        Window("hwnd:=" & hWnd).Activate
         If Err.Number <> 0 Then
            hWnd = Browser("hwnd:=" & hWnd).Object.hWnd
            Window("hwnd:=" & hWnd).Activate
            Err.Clear
        End If
         Window("hwnd:=" & hWnd).Maximize
    On Error Goto 0
End Function
RegisterUserFunc "Browser", "MaximizeBrowser", "MaximizeBrowser"

'eg: strSendKey("{Enter}")
Function strSendKey(strKeys)
    Set objWS=CreateObject("WScript.Shell")
        objWS.SendKeys strKeys
    Set objWS=Nothing
End Function


'' eg: MouseClickAbsValues(Browser("").Page("").WebElement(""), int2, int2)
Function MouseClickAbsValues(objRef, intX, intY)
   MouseClickAbsValues=false
'   objRef.Highlight   
    If objRef.Exist(2) Then
        x=objRef.GetROProperty("abs_x")
        y=objRef.GetROProperty("abs_y")
        Set mo=CreateObject("Mercury.DeviceReplay")
            mo.MouseClick x+intX, y+intY, micLeftBtn
            MouseClickAbsValues=True
        Set mo=Nothing
    End If
End Function

Function KillProcessesBeforeExec()
    ProcessNames = "iexplore.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objNetwork = CreateObject("Wscript.Network")
    currUser = objNetwork.UserName
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    KillProcess = Split(ProcessNames,"|")
    For x = 0 to  Ubound(KillProcess)
        Set colProcessList = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_Process WHERE Name ='"& KillProcess(x) &"'")
        For Each objProcess in colProcessList
            If objProcess.GetOwner ( User, Domain ) = 0 Then
                If UCase(User) = UCase(currUser) Then
                    objProcess.Terminate()
                    KillProcessesBeforeExec = true
                end if
            end if
        Next
    Next
    Set objFSO = Nothing
    Set objNetwork = Nothing
    Set objWMIService = Nothing
End Function


'''******************************************************************
'' Here wait for the object
HomeBrowserPage.Link(LogoutBtnVar, "index:=0").WaitforObject(ByRef objRef, 200)
Public Function WaitforObject(ByRef objRef, intWaitSecs)
   WaitforObject= False
    blnFlag= False
    intCount=1
    If ISObject(objRef) Then
        For iWaitSecs = 1 to intWaitSecs
            blnFlag = objRef.Exist(2)
            If blnFlag Then                        
                Do While (LCase(Trim(objRef.getROProperty("attribute/readyState")))<>"complete") or (Trim(objRef.getROProperty("attribute/readyState"))<>"4" )
                    If intCount= intWaitSecs Then
                        WaitforObject = True
                        Exit Do
                    End If
                    intCount=intCount+1
                Loop
                Exit For
            End If          
        Next
         If Not blnFlag Then
                wait 2
                WaitforObject = True
        End If
    End If 
End Function
RegisterUserFunc "Browser", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebEdit", "WaitforObj", "WaitforObject"
RegisterUserFunc "Frame", "WaitforObj", "WaitforObject"
RegisterUserFunc "Page", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebArea", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebButton", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebCheckBox", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebElement", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebFile", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebList", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebRadioGroup", "WaitforObj", "WaitforObject"
RegisterUserFunc "WebTable", "WaitforObj", "WaitforObject"
RegisterUserFunc "Link", "WaitforObj", "WaitforObject"
RegisterUserFunc "Image", "WaitforObj", "WaitforObject"





'' Wait until object disapear
Public Function waitforObjDisappear(ByRef objRef, intWaitSecs)
    waitforObjDisappear= False   
    blnFlag=False
        If ISObject(objRef) Then
            objName=objRef.getROProperty("name")
            For iWaitSecs = 1 to intWaitSecs
                If objRef.Exist(1) Then
                    If iWaitSecs = intWaitSecs Then
                        Reporter.ReportEvent micDone, "Wait till the objects remains available: " & objName, "The object: "& objName & " is still displayed."
                        Exit For
                    End If
                else   
                    blnFlag=True
                    waitforObjDisappear= True  
                    Reporter.ReportEvent micDone, "Wait till the objects remains available: " & objName, "The object: "& objName & " is no longer displayed."
                    Exit For
                End If
            Next
        End If
        If Not blnFlag Then
            wait 2           
        End If       
End Function
RegisterUserFunc "Image", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebButton", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "Link", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebElement", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebTable", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebCheckBox", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebList", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebRadioGroup", "waitforObjDisappear", "waitforObjDisappear"
RegisterUserFunc "WebEdit", "waitforObjDisappear", "waitforObjDisappear"

Gmail Login using VBScript

This script is used to automate gmail login with just a dbl click on the file.
'Configure ur script: Enter your email id and password in the script and save it on your desktop as "Gmail_Login.vbs".

'USERNAME = "yrmailid@gmail.com"
'PASSWORD = "urpassword"

'********************************* Prog begins******************

Dim IE
Dim uSERNAME
Dim PASSWORD
Dim crtScreen
Set IE = CreateObject("InternetExplorer.Application")

' Replace your email_id and password here... 
USERNAME = "yrmailid@gmail.com"
PASSWORD = "urpassword"

With IE
.navigate "http://www.gmail.com"
.visible=1
End With

On error resume next

'wait a while until IE as finished to load
Do while IE.busy
loop
set WshShell = WScript.CreateObject("WScript.Shell")
Do While UCase(IE.Document.readyState) <> "COMPLETE"
    WScript.Sleep 100
    DoEvents
Loop
set WshShell=nothing

IE.document.all.Item("Email").value = USERNAME      ' OR
'IE.document.gaia_loginform.Email.value=USERNAME
IE.document.all.Item("pASSWD").value = PASSWORD     
IE.document.all.item("signIn").click

Set IE = Nothing

if err.number<>0 then
    msgbox "error description: " &err.description & vbnewline  & "error source: " &err.source
end if
on error goto 0

WScript.Quit(0)

'*********************** Ends here***********************

Working with Excel: add sheets, delete sheets, sort worksheets by name, worksheet count, create workbook..

'' Working with Excel: add sheets, delete sheets, sort worksheets by name, worksheet count, create workbook..

'1. Create Excel and save it 
'2. Add worksheets 3
'3. sort worksheets
'4. Delete specific sheet
'5. Count Total number of sheets
spath="C:\Users\gvenu\Desktop\rngtones\v.xls"
ch=InputBox("Please enter your choice: "_
    & vbNewLine &"1. CreateExcel"_
    & vbNewLine &"2. AddWorksheets"_
    & vbNewLine &"3. SortWorksheets"_
    & vbNewLine &"4. DeleteSheets")
        
Set oex=CreateObject("Excel.Application")
Set fso=CreateObject("Scripting.FileSystemObject")
oex.Application.Visible= True
Select Case ch
Case "1"        '' Create a new workbook
    on error resume next
    if not fso.FileExists(spath) then
        oex.Application.Visible= True
        oex.Workbooks.Add()
        oex.ActiveWorkbook.SaveAs(spath)
    Else
        msgbox "File already exist"
    End If
    on error goto 0
Case "2"        '' Add 5 worksheets 
    oex.Application.Visible= True
    Set wb=oex.Workbooks.Open(spath)
    set ws=wb.Worksheets(3)
    set ads=wb.Sheets
    ads.Add ws, , 5
    set wb=Nothing
Case "3"        '3. sort worksheets
    Set wb=oex.Workbooks.Open(spath)
    MsgBox "Worksheets count: "& oex.Worksheets.Count
    Dim sht()    
    i=0
    '' Get the sheet names
    For Each sh In wb.Sheets
        ReDim Preserve sht(i)
        sht(i)=sh.Name        
        i=i+1
    Next
    MsgBox "Sheet names before sorting:" & Join(sht)
    
    '' Array of sheet names sorting..
    MaxShName=sht(0)
    for i=UBound(sht) To 0 Step -1
        For j=0 To i-1
            If sht(j)>sht(j+1) Then
                temp=sht(j)
                sht(j)=sht(j+1)
                sht(j+1)=temp
            End If
        Next
    Next
    MsgBox "Sheet names after sorting:" & Join(sht) &vbNewLine & "Sheets sorted successfully!!"
    
    For i = UBound(sht) to 1 Step -1
        Set objSheet1 = oex.Sheets(sht(i))
        Set objSheet2 = oex.Sheets(sht(i-1))
        objSheet2.Move objSheet1
       Next
Case "4"        '4. Delete specific sheet
    Set wb=oex.Workbooks.Open(spath)
    MsgBox "Worksheets count: "& oex.Worksheets.Count
    MsgBox wb.Sheets(1).name        '' another way to access sheetname
    For i=1 To oex.Worksheets.Count
        If StrComp(wb.Sheets(i).name, "sheet3", 1)=0 Then  '' Here "sheet3" is the sheet name
            wb.Worksheets(i).Delete            '' Worksheet deleted successfully!!
            Exit For
        End If 
    Next
            
'    Dim sht()    
'    i=0
'    For Each sh In wb.Sheets
'        ReDim Preserve sht(i)
'        sht(i)=sh.Name        
'        i=i+1
'    Next
End Select
oex.Quit
Set oex= Nothing

=================================

'' To create a workbook with total 12 worksheets:
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(3)
Set colSheets = objWorkbook.Sheets
colSheets.Add objWorksheet,,9
============================

'' To delete all the worksheets except one:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\gvenu\Desktop\rngtones\test3.xlsx")
i = objWorkbook.Worksheets.Count
Do Until i = 1 
  objWorkbook.Worksheets(i).Delete
  i = i - 1
Loop
=============================
Function GetAbsolutePath()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    vBaseDir = objFSO.GetAbsolutePathName(".")
    GetAbsolutePath = vBaseDir
    Set objFSO = Nothing
End Function
'MsgBox  GetAbsolutePath()
==============================
'' Array Sorting

a=Array("venu", "g", "K", "G")
MsgBox Join(a)
ub=UBound(a)
For i=ub To 0 Step -1
    For j=0 To i-1
        If a(j)> a(j+1) Then
            temp= a(j)
            a(j)=a(j+1)
            a(j+1)=temp
        End If
    Next
Next
MsgBox Join(a)

Scroll Down and Focus methods in Webpage:

msgbox Browser("MSN.com").Page("MSN.com").WebEdit("q").GetROProperty("focus")
Returns 1 when the webfield is selected else returns 0

Browser("MSN.com").Page("MSN.com").WebEdit("q").Object.Focus 
is used to set focus(or place cursor) in the webfield

Browser(“Google”).Page(“testeverything – Google”).Link(“Next”).Object.scrollIntoView
This is used to scroll down til the end of the page where this link "Next" is displayed on screen.

Change the case of a given string elements

Change the case of a given string elements

str2= "abC**&^dF"
strc=""
For i =1 to len(str2)
    Set ex=New RegExp   
    ex.global= False
    ex.ignoreCase = False
    c=mid(str2, i, 1)
    ex.pattern="[a-z]"
    If ex.test(c) Then
        strc=strc & UCase(c)
    else
        strc=strc & LCase(c)
    End If
Next

msgbox strc

We can also use ASCII Values to change the case..
msgbox chr(65)