vbs - Invert Mouse wheel

 Invert Mouse wheel

Call test()
msgbox("Done!! Please restart to take effect")


Sub test()
  Set objShell = CreateObject("Wscript.Shell")
 'objShell.Run ("powershell.exe -noexit write-host Hello world -exit")
 'objShell.Run ("powershell.exe -noexit Get-ItemProperty HKLM:\SYSTEM\CurrentControlSet\Enum\HID\*\*\Device` Parameters FlipFlopWheel -EA 0")
 objShell.Run ("powershell.exe -noexit Get-ItemProperty HKLM:\SYSTEM\CurrentControlSet\Enum\HID\*\*\Device` Parameters FlipFlopWheel -EA 0 | ForEach-Object { Set-

ItemProperty $_.PSPath FlipFlopWheel 1 }")
End Sub

'View registry path
'Get-ItemProperty HKLM:\SYSTEM\CurrentControlSet\Enum\HID\*\*\Device` Parameters FlipFlopWheel -EA 0

'Change registry settings
'Get-ItemProperty HKLM:\SYSTEM\CurrentControlSet\Enum\HID\*\*\Device` Parameters FlipFlopWheel -EA 0 | ForEach-Object { Set-ItemProperty $_.PSPath FlipFlopWheel 1 }

'Restore
'Get-ItemProperty HKLM:\SYSTEM\CurrentControlSet\Enum\HID\*\*\Device` Parameters FlipFlopWheel -EA 1 | ForEach-Object { Set-ItemProperty $_.PSPath FlipFlopWheel 0 }

Vbs: Reflection in vbs or Converting String into Function Name

  Reflection in vbs or Converting String into Function Name

Output:
tc1
tc2

QTP : Excel As DataBase

 Excel As DataBase

Create an excel book in "c:\1.xlsx" and  name any sheet as "Sheet1" (Default name). In  Sheet 1 , the 1st row is the column names , the rest of the rows forms the data .


CODE BELOW:

Dim objCon, objRecordSet, strExlFile, colCount, row, i

Set objCon = CreateObject("ADODB.Connection")

Set objRecordSet = CreateObject("ADODB.Recordset")

sPath="c:\1.xlsx"

sSheetname="Sheet1"

objCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="& sPath &";Extended Properties=Excel 12.0;Persist Security Info=False"

strSQLStatement = "SELECT * FROM ["& sSheetname &"$]"

objRecordSet.Open strSQLStatement, objCon 'create recordset

colCount = objRecordSet.Fields.count 'Number of columns in the table

While objRecordSet.EOF=false

row=""

For i=0 to colCount-1

row=row &" "& objRecordSet.fields(i)

Next

'Print row 'If you are running this in Qtp you can uncomment this line

msgbox row

objRecordSet.moveNext

Wend

Set objRecordSet = Nothing

objCon.Close

Set objCon = Nothing

VBS :Sorting using built in function

Sorting using built in function

Program to sort an array using built-in function
set a =createobject("system.collections.arraylist")
a.add "5"
a.add "1"
a.add "2"
a.sort
for each i in a
 b=b&i&vbnewline
next
msgbox b

VBS: Regular Expression

 VBS: Regular Expression

Example 1 :
set regex=new regexp
regex.pattern="((9|8)[0-9]{9})"

a=inputbox("enter data")
if regex.test(a) = true and len(a)=10 then
 msgbox "valid"
else
 msgbox "invalid"
end if

Example 2 :

set regex=new regexp
regex.pattern="www\..*\.(com|in|jp)$"
n=inputbox("validate any website address starting from --www")
if regex.test(n) then
 msgbox "valid"
else
 msgbox "invalid"
End if

VBS :Redim Example

VBS :Redim

Example :

 Program to illustrate used of redim and preserve mechanism

a=array("data in 0th index ","data in 1st index" ,"data in 2nd index" )
redim preserve a(3)
a(3)="This is adding some data to 4th inded "
msgbox ubound(a)&"  "&a(3)

VBS : Instr Example

VBS : Instr Example

Example 1
Program to find the character no "id=" in a sentence

q="select * from xxx where id=123"

r=instr(1,q,"id=")

msgbox r

Example 3:

msgbox instr(1,"ab","a")

VBS :Text File

Text File

Example :

set fso=createobject("scripting.filesystemobject")

fso.createtextfile"D:\1.txt"
set ctrl=fso.getfile("1.txt")
set mode=ctrl.openastextstream(8)
'1-read
'2-write
'8-append

mode.writeline "hi"
mode.writeblanklines 5
mode.writeline "end"

msgbox "over"

VBS :Dictionary

 

VBS :Dictionary

Example :

Set hash = CreateObject ("Scripting.Dictionary")
hash.add "A", "Apple" 'Inserting values into dictionary
hash.add "B", "Ball"  'Inserting valuesinto Dictionary

hash.item("b") = "Case Sensitive" 'The dictionary's "item" method can be used to do the same job as "add "

'hash.CompareMode = 1
'This must be places immediately after the CreateObject statement and before any items are added.
'If that's done then the keys will no longer be case sensitive.
msgbox "A for "& hash.item("A")

keys = hash.Keys   'Keys - returns an array containing the key words
items = hash.Items 'Items - returns an array containing the values

for i = 0 to hash.Count - 1
 msgbox Keys(i) & " for  " & Items(i)
next

hash.Remove("A") 'To remove individual values from dictionary
hash.RemoveAll   'To remove all values into Dictionary

VBS : ERRORS

VBS : ERRORS

Program to Raise , lear and Ignore Error

Example

on error resume next
Err.Raise 6  ' Raise an overflow error.
MsgBox ("Error # " & CStr(Err.Number) & " " & Err.Description)
Err.Clear    ' Clear the error.
MsgBox ("Error # " & CStr(Err.Number) & " " & Err.Description)

Vbs :Count no of Commas in a string

Vbs :Count no of Commas in a string

Program to count no of commas in a string

n=inputbox("enetr a string containing commas")

for i=1 to len(n)
 k=mid(n,i,1)

 if k="," then
  RES=RES+1
 END IF
next

msgbox "no of commas="& RES

VBS :Classes

VBS :Classes

Program on classes in Vbs

Example :

call a2()

Class a1

  private Function add2()
    msgbox 2+3
 End Function

 Function add1()
  Call add2()     'inturn call the above function
  End Function

End Class

Function a2()
   Set a2=new a1
   a2.add1

End Function

VBS: Arrays and Functions

VBS:Arrays

Simple programs on sending Array to Function

Example 1 :

'----------"a" is an array

'----------notice the way I'm sending it to the function

'----------notice how array is received at the function definition

'Moral of the story ,
'-------you can use paranthesis at function header in the function definition

'***************************************
        a=array(4,23,1,2)

 res=fn(a)

 msgbox res

function fn(x())    'function fn(x)
 fn=ubound(x)

end function

Example 2 :

dim a(4)
a(0)=1
a(1)=2
res= fn(a) 'fn call
msgbox res

function fn(a())    'fn definition

 for i=0 to ubound(a)
  res=res&a(i)&vbnewline
  NEXT
 fn=res

end function

QTP: Create New Excel File

Create New Excel File

Program to create a new Excel workBook

set xl=createobject("excel.application")

set wb=xl.workbooks.Add

Set ws=wb.worksheets(1)

ws.Name="New Name"

ws.cells(1,1).value="Completed creation of new excel file"

wb.saveas ("C:\1.xlsx")

wb.close

xl.quit

QTP : Program to Display 1st Column Data in Database through QTP

 Program to Display 1st Column Data in Database through QTP

Set oConnection=createobject("adodb.connection")
Set oRecordSet=createobject("adodb.recordset")

oConnection.Open "Connection String for the Server"
oRecordSet.Open "Query" ,oConnection

Do while not oRecordSet.EOF
        sData=sData &vblf & oRecordSet.Fields.Item(1)
        oRecordSet.MoveNext
Loop

msgbox oRecordSet
oConnection.Close
Set oConnection=Nothing
Set oRecordSet=Nothing

VB & QTP : Fetching Data from DB and putting it into a 2D array

Fetching Data from DB and putting it into a 2D array

http://www.gcreddy.com/2010/03/database-connections.html

http://www.qtpschool.com/2011/05/database-connection-using-qtp.html

http://qtpvbs.blogspot.in/2010/06/function-to-retrieve-query-result-into.html 

Public Function Func_GetQueryResult(sQuery)

Dim con,rs ,loopCounter,var,counter

counter=0

Dim resArr()

Set con=CreateObject("ADODB.Connection")

Set rs=CreateObject("ADODB.recordset")

con.open"provider=SQLOLEDB;Server=servername;Databae=dbname;Userid= ;Password= :"

rs.open sQuery,con

While not rs.EOF 'Count no of rows in your result

 loopCounter=loopCounter+1

 rs.MoveNext

Wend

If loopCounter = 0 Then

 Reporter.ReportEvent micWarning,"Empty Result Set","Query is: " & sQuery

 Func_GetQueryResult=False

 Exit Function

End If

rs.MoveFirst 'move the recordset object to first row again

ReDim resArr(loopCounter,rs.fields.count-1)

Do until rs.EOF 'Rows

  For var=0 to rs.fields.count-1 'cols

    If counter=0 Then

     resArr(counter,var) =rs.fields(var).name

     else

     resArr(counter,var) =rs.fields(var).value

    end if

  Next

 rs.MoveNext

 counter=counter+1

Loop

rs.Close

con.Close

Func_GetQueryResult=resArr

End Function

'////Connection string can also be -"DRIVER=SQL Server; DATABASE=" & DBName & ";APP=QuickTest Professional;SERVER=" & DBServer &";Description=Testconnection"

VBS :Ubound

Ubound

[http://www.qtpschool.com/2011/05/database-connection-using-qtp.html]

ubound method is used to count the length of array. It returns the highest index number of the array.
But remember, the actual size of the array is highest index number plus one!! 

Eg : Dim myArray(4)

       msgbox ubound(myArray)   '4

       msgbox "size="&ubound(myArray)+1      'size=5

Eg: Dim myArray(4,6)
msgbox ubound(myArray, 1) ' highest index of the first dimension - 4
msgbox ubound(myArray, 2) ' highest index of the second dimension - 6

Creating Dictionary in VBS

Simple example to show the usage of Dictionary in VBS

Set hash = CreateObject ("Scripting.Dictionary")
hash.add "A", "Apple" 'Inserting values into dictionary
hash.add "B", "Ball"  'Inserting valuesinto Dictionary

hash.item("b") = "Note Dictionary is Case Sensitive" 'The dictionary's "item" method can be used to do the same job as "add "

'hash.CompareMode = 1
'This must be places immediately after the CreateObject statement and before any items are added.
'If that's done then the keys will no longer be case sensitive.
msgbox "A for "& hash.item("A")

keys = hash.Keys   'Keys - returns an array containing the key words
items = hash.Items 'Items - returns an array containing the values
for i = 0 to hash.Count - 1
 msgbox Keys(i) & " for  " & Items(i)
next

hash.Remove("A") 'To remove individual values from dictionary
hash.RemoveAll   'To remove all values into Dictionary

Converting Decimal to Whole Number 2 methods : -

1)

x=inputbox("enter a number with decimal")
whole=mid(x,1,instr(1,x,".")-1)
deci=mid(x,instr(1,x,".")+1,len(x))
if mid(deci,1,1) >=5 then whole=whole+1
msgbox whole


2)

x=inputbox("enter a decimal no with 1 digit after the decimal point")
whole=x*10
deci=whole mod 10
whole=whole-deci
whole=whole/10
if deci>=5 then
  whole=whole+1
end if
msgbox whole

Excel Creation using VBS

Example

set xl=createobject("excel.application")

sPath=InputBox("enter path where you want to save the file")

set wb=xl.workbooks.Add

Set ws=wb.worksheets(1) 'sheetname

ws.Name="New Name"

ws.cells(1,1).value="Completed creation of new excel file"

wb.saveas (sPath)

wb.close

xl.quit

Set xl=nothing