Adodb Scripts And Some Sample Scripts[1]

Option explicit
Dim comobj, conobj
Set conobj=createobject("ADODB.Connection")
conobj.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:Documents
and SettingsSai SarvaniDesktopsample.mdb" Set
comobj=createobject ("ADODB.Command")
comobj.activeconnection = conobj
comobj.commandtext = "Insert into emp values ('Appa Rao', 101, 10000)"
comobj.execute
conobj.close
Set comobj = nothing
Set conobj = nothing
How to set multiple records into database table by taking the data from Excel file
Option explicit
Dim comobj,conobj,rcount,i,ename,eno,esal
Set conobj=createobject("ADODB.Connection")
conobj.open "PRovider=Microsoft.jet.oledb.4.0;
data Source = C:Documents and SettingsSai SarvaniDesktopsample.mdb"
Set comobj=createobject("ADODB.Command")
comobj.activeconnection=conobj
datatable.AddSheet ("data")
datatable.ImportSheet "C:Documents and SettingsSai SarvaniDesktop
testdata.xls",1,"data"
rcount=datatable.GetSheet("data").getrowcount For
i=1 to rcount step 1

datatable.SetCurrentRow (i)
ename=datatable.Value (1, "data")
eno=datatable.Value (2, "data")
esal=datatable.Value (3, "data")
comobj.commandtext = "insert into emp values ('"&ename&"', "&eno&", "&esal&")"
comobj.execute
Next conobj.close
Set conobj=Nothing
SetComobj=nothing
How to get data from database table?
Option explicit Dim conobj,rsobj,username,password
Set conobj=createobject("ADODB.connection")
conobj.open "PRovider=Microsoft.jet.oledb.4.0;
data Source = C:Documents and SettingsSai SarvaniDesktopsample.mdb"
Set rsobj=Createobject("ADODB.recordset")
rsobj.open "select * from login", conobj
rsobj.movefirst
While not rsobj.eof
username=rsobj("uid")
password=rsobj("pwd")
SystemUtil.Run "C:Program FilesMercury InteractiveQuickTest
Professionalsamplesflightappflight4a.exe"
Dialog("Login").WinEdit("Agent Name:").Set username
Dialog("Login").WinEdit("Password:").SetSecure crypt.Encrypt (password)
Dialog("Login").WinButton("OK").Click
If window("Flight Reservation").Exist Then
reporter.ReportEvent micPass, "Login success", "Test is Pass" Window("Flight

Reservation").WinMenu("Menu").Select "File;Exit"
else
reporter.ReportEvent micFail, "Login Fail", "Test is fail"
Dialog("Login").Dialog("Flight Reservations").WinButton("OK").Click
Dialog("Login").WinButton("Cancel").Click
End If
rsobj.movenext
Wend
rsobj.close
conobj.close
Set rsobj=nothing
Set Conobj=nothing
QTP- Execute the bat file , dos command from QTP
dim appset app=createobject("wscript.shell")
SystemUtil.run "cmd.exe"
app.sendkeys "cd C:Documents and Settings'<>"
app.sendkeys "~"
app.sendkeys "MyDosFile.bat"
app.sendkeys "~" app.sendkeys "~"
wait(5)
'In bat file you can give and save
Date
echo "hello World"
pause
‘*****************************************************************************
****
QTP/QC - Schedule the testset in QC by VBS
'User must Admin at the machine where he want to run the testset
'This can run manual as well as Automated test suite
' It can be schedule at any partcular future time
' User need not to open the QC
Public Sub RunTestSet(otdc,tsFolderName,tSetName,HostName,runWhere)

Dim TSetFact, tsList
Dim theTestSet
Dim tsTreeMgr
Dim tsFolder
Dim Scheduler
Dim nPath
Dim execStatus
' Get the test set tree manager from the test set factory
'tdc is the global TDConnection object.
Set TSetFact = otdc.TestSetFactory
Set tsTreeMgr = otdc.TestSetTreeManager
' Get the test set folder passed as an argument to the example code
nPath = "Root" & Trim(tsFolderName)
Set tsFolder = tsTreeMgr.NodeByPath(nPath)
If tsFolder Is Nothing Then
err.Raise vbObjectError + 1, "RunTestSet", "Could not find folder " & nPath
End If
' Search for the test set passed as an argument to the example code
Set tsList = tsFolder.FindTestSets(tSetName)
If tsList Is Nothing Then
err.Raise vbObjectError + 1, "RunTestSet", "Could not find test set in the " & nPath
End If
If tsList.Count > 1 Then
MsgBox "FindTestSets found more than one test set: refine search"
Exit Sub
ElseIf tsList.Count < 1 Then
MsgBox "FindTestSets: test set not found"
Exit Sub
End If
Set theTestSet = tsList.Item(1)
Debug.Print theTestSet.ID
'Start the scheduler on the local machine
Set Scheduler = theTestSet.StartExecution(HostName)
'msgbox "pass"
'Set up for the run depending on where the test instances
' are to execute.
Select Case runWhere

Case "RUN_LOCAL"
'Run all tests on the local machine
Scheduler.RunAllLocally = True
Case "RUN_REMOTE"
'Set Scheduler = theTestSet.StartExecution(HostName)
'Run tests on a specified remote machine
Scheduler.TdHostName = HostName
'Scheduler.TdHostName=runWhere
' RunAllLocally must not be set for
' remote invocation of tests.
' Do not do this:
' Scheduler.RunAllLocally = False
Case "RUN_PLANNED_HOST"
'Run on the hosts as planned in the test set
Dim TSTestFact, TestList
Dim tsFilter
Dim TSTst
'Get the test instances from the test set
Set TSTestFact = theTestSet.TSTestFactory
Set tsFilter = TSTestFact.Filter
tsFilter.Filter("TC_CYCLE_ID") = theTestSet.ID
Set TestList = TSTestFact.NewList(tsFilter.Text)
Scheduler.RunAllLocally = False
End Select
'Run the tests
Scheduler.run
Set execStatus = Scheduler.ExecutionStatus
While (RunFinished = False)
execStatus.RefreshExecStatusInfo "all", True
RunFinished = execStatus.Finished
Wend
End Sub
'================================
Const qcHostName = "GiveQChost:8080"
Const qcDomain = "GiveDomain name"
Const qcProject = "GiveProject" 'Please define here the name of the project
Const qcUser = "User ID" 'Please define here the username
Const qcPassword = "Give Password HGBGH%3&42" 'Please define here the password
Dim tdc
Dim qcServer

Dim objArgs
Dim strArg
Dim strTestSet
Dim bRunCode
'======GETTING ARGUMENTS==============
set objArgs = WScript.Arguments
If WScript.Arguments.Count<1>2 Then
WScript.Echo "Remote_Scheduler"
bRunCode = False
Else
For Each strArg in objArgs
WScript.Echo strArg&" is starting…"
strTestSet = strArg
bRunCode = True
Next
End If
'===========================================================
If bRunCode Then
qcServer = "http://" & qcHostName
qcServer = qcServer & "/qcbin"
Set tdc = CreateObject("tdapiole80.tdconnection")
If (tdc Is Nothing) Then
MsgBox "tdc object is empty"
End If
tdc.InitConnectionEx qcServer
tdc.Login qcUser, qcPassword
tdc.Connect qcDomain, qcProject
RunTestSet tdc, "GiveFolder Name of Test Set","GiveTestSet name ","Givemachinename",
"RUN_REMOTE"
'Disconnect from the project
If tdc.Connected Then
tdc.Disconnect
End If
'Log off the server
If tdc.LoggedIn Then
tdc.Logout
End If
'Release the TDConnection object.
tdc.ReleaseConnection
'"Check status (For illustrative purposes.)

Set tdc = Nothing
End IF
‘*****************************************************************************
********************************
QTP/QC - Running bat file from QC
Povide the bat file 'Driverbat.bat' remove ' sign and put bat under folder C:QTP_Resource.
'cd C:QTP_Resource
'DriverScript_QTP
'C:QTP_ResourceUtility2.exe auto some other utility
'Exit
In QC > Create a VAPI-XP test > in test script put the code
Dim objShell
Set objShell = CreateObject("WScript.Shell")
'objShell.Run "CMD.exe"
objShell .Run "%comspec% /k c: & cd C:QTP_Resource Driverbat.bat"
BR>
'objShell.Run "%comspec% /k c: & cd C:QTP_ResourceDriverbat.bat"
BR>
'qtAppWin.sendkeys "~"
‘*****************************************************************************
******************************************************************************
******************************************************************************
*******
'Get all the items from FlyFrom Combobox and set into textfile
Dim objTxt, objFile,Items_Count,i
Set objTxt=CreateObject("Scripting.Filesystemobject")
objTxt.CreateFolder ("D:Flight_Items")
set objFile=objTxt.CreateTextFile("D:Flight_ItemsList_Items.txt")
Items_Count = Window("Flight Reservation").WinComboBox("Fly From:").GetItemsCount()
For i=0 to Items_Count-1 step 1

objFile.WriteLine Window("Flight Reservation").WinComboBox("Fly From:").GetItem(i)
Next
objFile.Close
Set objTxt=Nothing
'*****************************************************************************
***************************************
'How to set data from file into another text file
Dim objTxt,objFile1,objFile2,arr,i,x
Set objTxt=Createobject("Scripting.Filesystemobject")
set objFile1=objTxt.OpenTextFile("D:abc.txt",1)
Set objFile2=objTxt.OpenTextFile("D:abcd.txt",2)
While not objFile1.AtEndOfStream
x=objFile1.ReadLine
arr=split(x," ")
For i=0 to Ubound(arr)
objFile2.WriteLine arr(i)
Next
Wend
objFile1.Close
objFile2.Close
Set objTxt=Nothing
'***************************************************************************

' How to set data from one text file into another text file as peramid(
'1
'12
'123
'1234
'*****************************************************************************
******
'Working with text file
FirstfilePath="D:abc.txt"
SecondfilePath="D:abcd.txt"
Set ObjText = CreateObject("Scripting.FileSystemObject")
Set File1=ObjText.OpenTextFile(FirstfilePath,1)
Set File2=ObjText.OpenTextFile(SecondfilePath,2)
'Getting data from first file path which is in vertical
While not File1.AtEndOfStream
'To get the line
x=File1.ReadLine
s=s&x
File2.WriteLine s
Wend
'*****************************************************************************
********
' How to close all the browsers
Set objDesc=Description.Create

objDesc("micclass").value="Browser"
set objBr=Desktop.ChildObjects(objDesc)
'msgbox objBr.count
For i=0 to objBr.count-1 step 1
objBr(i).close
Next
'***************************************************************************
' How to close all the browsers except our specified browser
objDesc("micclass").value="Browser"
set objBr=Desktop.ChildObjects(objDesc)
'msgbox objBr.count
For i=0 to objBr.count-1 step 1
BrName=objBr(i).GetRoProperty("name")
If BrName <> "Real Estate Listings, Homes for Sale and Rental Property
Listings – REALTOR.com®" Then
objBr(i).close
End If
Next
'***************************************************************************
' How to delete specified mails from the INBOX

Dim RowCount,i,StrData,objCi
RowCount = Browser("Gmail - Inbox (537) -").Page("Gmail - Inbox (537)
-").Frame("c1ds2cindlqxf2").WebTable("HDFC BANK").RowCount()
msgbox RowCount
For i=1 to RowCount step 1
StrData = Browser("Gmail - Inbox (537) -").Page("Gmail - Inbox (537)
-").Frame("c1ds2cindlqxf2").WebTable("HDFC BANK").GetCellData(i, 3)
If StrData="NageshQTP" Then
set objCi=Browser("Gmail - Inbox (537) -").Page("Gmail - Inbox (537)
-").Frame("c1ds2cindlqxf2").WebTable("HDFC BANK").ChildItem (i,1,"WebCheckBox",0)
objCi.set "ON"
End If
Next
'*****************************************************************************
******************************************************************************
*****************************
'Prepare descriptive programming for login functionality"
Set objDia=Description.Create
objDia.Add "text","Login"
objDia.Add "window id","0"
Set objUid=Description.Create
objUid.Add "attached text","Agent Name:"
Set objPwd=Description.Create
objPwd.Add "attached text","Password:"

Set objBut=Description.Create
objBut.Add "text","OK"
Dialog(objDia).Activate
Dialog(objDia).winedit(objUid).Set "nagesh"
Dialog(objDia).winedit(objPwd).Set "mercury"
Dialog(objDia).winbutton(objBut).Click
'****************************************************
'Prepare descriptive programming for gmail login 2nd method --B
Set objBr= Description.Create
objBr.Add "name","Gmail: Email from Google"
Set objpage= Description.Create
objpage.Add "title", "Gmail: Email from Google"
Set objuid= Description.Create
objuid.Add "name","Email"
Set objpwd=Description.Create
objpwd.Add "name","Passwd"
Set objsgn=Description.Create
objsgn.Add "name","Sign in"

Browser(objBr).page(objpage).webedit(objuid).set "chenna"
Browser(objBr).page(objpage).webedit(objpwd).Setsecure"4cd631e45d907d79a503c02cdc57c2
59721e1112"
Browser(objBr).page(objpage).webbutton(objsgn).click
'***************************************************************
2nd method --A
Set objBr= Description.Create
objBr("name").value="Gmail: Email from Google"
Set objpage= Description.Create
objpage("title").value= "Gmail: Email from Google"
Set objuid= Description.Create
objuid("name").value="Email"
Set objpwd=Description.Create
objpwd("name").Value="Passwd"
Set objsgn=Description.Create
objsgn("name").value="Sign in"

Browser(objBr).page(objpage).webedit(objuid).set "chenna"
Browser(objBr).page(objpage).webedit(objpwd).Setsecure"4cd631e45d907d79a503c02cdc57c2
59721e1112"
Browser(objBr).page(objpage).webbutton(objsgn).click
'***************************************************************
'How to get google search items
Dim x,y,objDev,objShell,objDesc,objColl,i,strName
x=Browser("Google").Page("Google").WebEdit("q").GetROProperty("abs_x")
y=Browser("Google").Page("Google").WebEdit("q").GetROProperty("abs_y")
Set objDev=Createobject("mercury.devicereplay")
objDev.MouseClick x,y,LEFT_MOUSE_BUTTON
Set objShell=Createobject("wscript.shell")
objShell.SendKeys "Testing"
wait(5)
objDesc("micclass").value="WebElement"
objDesc("name").value="Google Search"
set objColl=Browser("Google").Page("Google").WebTable("quotes").ChildObjects(objDesc)
msgbox objColl.count

For i=0 to objColl.count-1 step 1
objShell.SendKeys "{DOWN}"
strName=objColl(i).getroproperty("innertext")
Reporter.ReportEvent micDone,"Google Search Item "&strName,"Item
captured"
Next
Set objDev=Nothing
Set objShell=Nothing
‘**********************************************************************
How to connect to sql server
Option Explicit
Dim objCon,objCom
Set objCon=Createobject("ADODB.connection")
objCon.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial
Catalog=Testdata;Data Source=."
Set objCom=CreateObject("ADODB.command")
objCom.ActiveConnection=objCon
objCom.CommandText="Insert into EmpDetails values('Srinivas',102,1000)"
objCom.Execute
objCon.Close
Set objCom=Nothing
Set objCon=Nothing

‘*************************************************************************
' Verify Login functionality with multiple UID;s and PWd's by passing data from excel
Option explicit
Dim intRowcount,i,strUid,strPwd
datatable.AddSheet("input")
datatable.ImportSheet "D:Login.xls",1,"input"
intRowcount=Datatable.GetSheet("input").GetRowCount
For i=1 to intRowcount step 1
datatable.SetCurrentRow(i)
strUid=Datatable.Value(1,"input")
strPwd=Datatable.Value(2,"input")
systemutil.Run "C:Program FilesHPQuickTest
Professionalsamplesflightappflight4a.exe"
Dialog("Login").Activate
Dialog("Login").WinEdit("Agent Name:").Set strUid
Dialog("Login").WinEdit("Password:").SetSecure crypt.Encrypt(strPwd)
Dialog("Login").WinButton("OK").Click
wait(7)
If Window("Flight Reservation").Exist Then
Reporter.ReportEvent micPass,"Login suc","Test is Pass"
Window("Flight Reservation").WinMenu("Menu").Select
"File;Exit"
Else
Reporter.ReportEvent micFail,"Login Unsuc","Test is Fail"
Dialog("Login").Dialog("Flight
Reservations").WinButton("OK").Click
Dialog("Login").WinButton("Cancel").Click

End if
Next
‘*****************************************************************
Examples on Functions(Web Applications)
‘****************************************************
' Functio Name:Clear_Cookies
'Function Descrition:It is used to clear the cookies
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function Clear_Cookies()
Systemutil.Run "iexplore","www.realtor.com"
webutil.DeleteCookies
systemutil.CloseDescendentProcesses
End Function
'*********************************************************************
' Functio Name:Application_Launch
'Function Descrition:It is used to launch the application
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function Application_Launch(strUrl)

systemutil.Run "iexplore",strUrl
If Browser("Real Estate Listings,").Page("Real Estate
Listings,").WebElement("FIND HOMES").Exist Then
Reporter.ReportEvent micPass,"Step 1","Application Launched"
Application_Launch="Application Launched"
Else
Reporter.ReportEvent micFail,"Step 1","Application is not Launched"
Application_Launch="Application is not Launched"
End if
End Function
'***********************************************************
' Functio Name:Close_App()
'Function Descrition:It is used to close the application
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function Close_App()
If Browser("Real Estate Listings,").Exist(10) Then
Browser("Real Estate Listings,").Close
Close_App="Application Closed"
Else
Close_App="Application not Closed"
End if

End Function
'*************************************************************
' Functio Name:SignUp
'Function Descrition:It is used to register the new user
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function SignUp(strEmail,strPwd,strGen,strYOB)
If Browser("Real Estate Listings,").Page("Real Estate Listings,").Link("Sign Up").Exist(10) Then
Browser("Real Estate Listings,").Page("Real Estate Listings,").Link("Sign
Up").Click
Browser("Real Estate Listings,").Page("Real Estate
Listings,").WebEdit("Email").Set strEmail
Listings,").WebEdit("Pwd").Set strPwd
Listings,").WebEdit("Cpwd").Set strPwd
Listings,").WebList("Gender").Select strGen
Listings,").WebEdit("YOB").Set strYOB
Browser("Real Estate Listings,").Page("Real Estate Listings,").WebElement("Sign
Up").Click

wait(5)
Listings,").WebElement("innertext:=THANK YOU","index:=1").Exist Then
Listings,").WebElement("CLOSE").Click
End if
strMsg=Browser("Real Estate Listings,").Page("Real Estate
Listings,").WebElement("Welcome").GetROProperty("innertext")
arr=split(strMsg,", ")
If instr(strEmail,arr(1))>0 Then
Reporter.ReportEvent micPass,"Step 1","SignedUp Successfull"
SignUp="SignedUp Successfull"
Else
Reporter.ReportEvent micFail,"Step 1","SignedUp Fail"
SignUp="SignedUp Fail"
End If
End If
End Function
'**********************************************************************
' Functio Name:SignOut
'Function Descrition:It is used to Signout from the application
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function SignOut()

Browser("Real Estate Listings,").Page("Real Estate Listings,").Link("Sign Out").Click
Listings,").WebElement("Welcome | Sign In | Sign").Exist Then
Reporter.ReportEvent micPass,"Step 1","SignOut SuccessFull"
SignOut="SignOut SuccessFull"
Else
Reporter.ReportEvent micPass,"Step 1","SignOut unSuccessFull"
SignOut="SignOut UnSuccessFull"
End If
End Function
'*************************************************************************
' Functio Name:SignIn
'Function Descrition:It is used to login to the application
'Authour:=Nagesh
'Created:=09082010
'*****************************************************************************
*********************
Function SignIn(strEmail,strPwd)
If Browser("Real Estate Listings,").Page("Real Estate Listings,").Link("Sign
In").Exist Then
Listings,").Link("Sign In").Click

Listings,").WebEdit("EmailID").Set strEmail
Listings,").WebEdit("Password").Set strPwd
Listings,").WebElement("Sign In").Click
wait(4)
strMsg=Browser("Real Estate Listings,").Page("Real Estate
Listings,").WebElement("Welcome").GetROProperty("innertext")
arr=Split(strMsg,", ")
If instr(strEmail,arr(1))>0 Then
Reporter.ReportEvent micPass,"Step 1","SignIn
SuccessFull"
SignIn="SignIn SuccessFull"
Else
Reporter.ReportEvent micFail,"Step 1","SignIn
Unsucessfull"
SignIn="SignIn Unsucessfull"
End If
End If
End Function
'************************************************************************

Adodb Scripts And Some Sample Scripts[1]

Recommended

More Related Content

What's hot (19)

Viewers also liked (20)

Similar to Adodb Scripts And Some Sample Scripts[1] (20)

Adodb Scripts And Some Sample Scripts[1]