Showing posts with label VB Script. Show all posts
Showing posts with label VB Script. Show all posts

Wednesday, June 27, 2012

Example if Bank Table: Insert Query in VBScript


'=================================================================
Create a Bank Table with following fields,
a.       Sr No
b.      Name
c.       Account No
d.      Address
e.      Debit
f.        Credit
g.       Total

Write a script to perform below task.
a.       Write a function to insert a new entry for Debit and it should update total field also.
b.      Write a function to insert a new entry for credit and it should update total field also.
Write a function to update address of user choice Account
'=================================================================

Dim MyConn,cmd,rs
set MyConn= CreateObject("ADODB.Connection")

connectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _
& "data source=D:\bankDB.accdb;Persist Security Info=False;"

MyConn.Open connectionString
Set adx = CreateObject("ADOX.Catalog")
set adx.ActiveConnection = MyConn

initialdebitVal = 0
initialTotalVal = 0
initialCreditVal = 0
userAcctNo = 0
user_exists=false

id=Inputbox ("Enter your Choice 1:debit amount 2:credit amount 3: Change Address 4: New Entry")
Select Case id
case 1: call debitAmt
case 2: call creditAmt
case 3: call changeAddr
case 4: call newEntry
End Select
MyConn.close

function getAmtVals
sInsData = "select * from Bank where Account = " & userAcctNo
MyConn.Execute(sInsData)
Set RS = MyConn.Execute(sInsData)

WHILE NOT RS.EOF
initialdebitVal =  RS("Debit")
initialCreditVal = RS("Credit")
initialTotalVal = RS("Total")

user_exists=true
RS.MoveNext
WEND

RS.Close
set RS = nothing
end function


'function to debit amount from the account entered
function debitAmt

userAcctNo = Inputbox ("Enter the Account number")
call getAmtVals
'validating account exists or not
if user_exists=false  then
msgbox "Account not found"
exit function
end if

debitVal=Inputbox ("Enter the debit amount")

totalVal =   initialTotalVal - debitVal
sInsData = "update Bank  set Debit = " & debitVal & " where account=" & userAcctNo
MyConn.Execute(sInsData)
sInsData = "update Bank  set Total = " & totalVal & " where account=" & userAcctNo
MyConn.Execute(sInsData)
msgbox "Debited Successfully"

end function


'function to credit amount to the account entered
function creditAmt

userAcctNo = Inputbox ("Enter the Account number")
call getAmtVals
'validating account exists or not
if user_exists=false  then
msgbox "Account not found"
exit function
end if

creditVal=Inputbox ("Enter the credit amount")
totalVal =   initialTotalVal + creditVal
sInsData = "update Bank  set Credit = " & creditVal & " where account=" & userAcctNo
MyConn.Execute(sInsData)
sInsData = "update Bank  set Total = " & totalVal & " where account=" & userAcctNo
MyConn.Execute(sInsData)
msgbox "Credited Successfully"

end function


'function to update date to the account entered
function changeAddr

userAcctNo = Inputbox ("Enter the Account number")
call getAmtVals
'validating account exists or not
if user_exists=false  then
msgbox "Account not found"
exit function
end if

address=Inputbox ("Enter the new address value")
sInsData = "update Bank  set address = '" & address & "'" & " where account=" & userAcctNo
MyConn.Execute(sInsData)
msgbox "Address Updated Successfully"

end function


'function to add new entry
function newEntry

hName=Inputbox ("Enter the Account Holder Name")
hAccount=Inputbox ("Enter the Account number")
hAddress=Inputbox ("Enter the Address")
sql = "insert into Bank(HName,Account,address,debit,credit,total) values('" & hName & "',"& hAccount & ",'" & hAddress & "',0,0,0);"
MyConn.Execute(sql)
msgbox "User Added Successfully!!!!"
end function

Example Student table: Update Query in VBScript



''================================================================= 
            Create a new table in MS Access called Student and perform given task.

        Student Table Structure
           1.       RollNo
           2.       Name
           3.       Address
           4.       Subject
           5.       Mark1
           6.       Mark2
           7.       Mark3
           8.       Avg Marks
           9.       Total

Write a script to perform below task:
1.       Function to calculate Avg Marks of all subjects and update in Avg Marks column.(for all subject)
2.       Function to calculate total marks and update in the total column.
3.       Function to update the address of particular student ( Take input from user)
''================================================================= 


Dim a,b,Avg, TOtal,Address
f = False

Call Avg_Marks

Function Avg_Marks
Set a=CreateObject("adodb.connection")
a.Open "Data Source=E:\Student.mdb;Provider=Microsoft.jet.oledb.4.0"
Set b=a.Execute("select * from student ")
RNo=Cint(inputbox("Enter the RollNo"))

WHILE NOT b.EOF
count = count + 1
if RNo = b("RollNo") then
sm1 = b("Mark1")
sm2 = b("Mark2")
sm3 = b("Mark3")
msgbox "Roll No:" & RNo & " sm1:" &sm1 & " sm2:" &sm2 & " sm3:" &sm3

end if
b.MoveNext
    WEND
if Rno > count then
msgbox "record no found"
else
Avg=(sm1+sm2+sm3)/3
Msgbox "Avg:" & Avg
sql="update student set AvgMarks="&Avg&" where RollNo =" & RNo
'msgbox sql
a.Execute (sql)
Call Total_Marks(RNo,sm1,sm2,sm3,Avg)
end if
End Function

Function Total_Marks(RNo,sm1,sm2,sm3,Avg)
Total=sm1+sm2+sm3
msgbox "Total:" & Total
sql="update student set Total="&Total&" where RollNo="&RNo
'msgbox sql
a.Execute (sql)
Call Address_value(RNo,sm1,sm2,sm3,Avg,Total)
End Function

Function Address_Value(RNo,sm1,sm2,sm3,Avg,Total)
    Address=inputbox("Enter the address")
  msgbox "Address:" & Address
  sql="update student set AvgMarks="&Avg&",Total="&Total&",Address='"&Address&"' where RollNo="&RNo
msgbox sql
a.Execute (sql)
a.Close
End Function

Friday, June 15, 2012

Reverse String without using any String function


Dim str1,regExpObj,x,result
Dim ArrString
str1="Neeraj"

Set regExpObj = new regexp
regExpObj.pattern="[a-z A-Z]"
regExpObj.global=true
set ArrString=regExpObj.execute(str1)
For each x in ArrString
result = x.value & result
Next
msgbox result

Search entered text from inside of the text file.



set fso=CreateObject("Scripting.FileSystemObject")
set f=fso.OpenTextFile("Path_of_the_text_file.txt",1, False)
val=Inputbox("enter the word to be searched")
flag = false
do until f.AtEndOfStream
str1=f.readLine
if inStr(str1,val) then
flag = True
exit do
else
flag = false
End if
Loop
if flag = True then
msgbox val & " found"
else
Msgbox val & " not Found"
f.close
set f=nothing
set fso=nothing

Thursday, June 14, 2012

Find no is Prime or not from range in vbscript



Function primeNumber()
flag=1
primeNo=inputbox("Enter a number")
For n=2 to primeNo
flag=1
For j=2 to n/2
If n mod j=0 Then
flag=0
End If
Next
If flag=1 Then
msgbox "prime no is:" & n
End If
Next
End Function

check enter string or number is Palindrome or not in Vbscript



Function CheckPalindrom2StringFunction()

MyStr=Ucase(inputbox("Enter the String:"))
RevStr=strreverse(MyStr)

if strcomp(MyStr,RevStr)=0 then
  msgbox "It is a Palindrome"
else
  msgbox "It is not a Palindrome"
end if
End Function

Function CheckPalindromeString()
Word = Ucase(inputbox("Enter the String:"))
length = Len(Word)
For i = 1 To length
Str1 = Str1 + Mid(Word, i, 1)
Next
For i = length To 1 Step -1
Str2 = Str2 + Mid(Word, i, 1)
Next

If Str1 = Str2 Then
MsgBox "given word is palindrome"
Else
MsgBox "given word is not palindrome "
End If
End Function

Function CheckPalindromeInt()
     n = InputBox(" Enter a number=")
     temp = n
     rev = 0
      Do While temp > 0
         r = temp Mod 10
         rev = rev * 10 + r
         temp = Int(temp / 10)
      Loop
     If Int(n) = rev Then
        MsgBox "The palindrom number is=" & rev
     Else
       MsgBox "Please enter correct palindrom number"
     End If
End Function

Find the Factorial without and with recursive


Function Fact()
n = int(InputBox(" Enter a number="))
' Coding for normal execution
f = 1
for i = 1 to n
f = f * i
next
msgbox f
'--------------------

' Coding for recursive logic
REM if n < 0 then
REM msgbox "Invalid input"
REM else
REM f = FactNumber(n)
REM msgbox "Factorial of " & n & " is " & f
REM end if

End Function

'------------------------------
' Recursive Function
Function FactNumber(n)

if n = 0 then
FactNumber = 1
else
FactNumber = n * FactNumber(n-1)
end if
End Function

Print * triangle in VBscript


Function printStar()
maxLen = int(InputBox(" Enter a number="))

REM for i = 0 to n
REM print Space(n - i) + String(i, "*") + vbNewLine
REM next

For lineLen = 1 To maxLen
iSpaces = (maxLen - lineLen)
If iSpaces > 0 Then
padSpace = Space(iSpaces / 2)
x = x & padSpace & Replace(Space(lineLen), Space(1), "*") & padSpace & VbCrLf
Else
x = x &  Replace(Space(lineLen), Space(1), "*") & VbCrLf
End If
Next
msgbox x
End Function

O/P: n=5
 
       *
      **
     ***
    ****
   *****

Program to find Fibonacci series



Function Fibonacci()
dim a,b,c
        n = 20
a=0
b=1
do while c<=n
x = x & b
c=a+b
a=b
b=c
loop
msgbox x
end Function

Program that reverses the order of words (not characters) in a sentence. e.g: “Good Morning Everybody” to “Everybody Morning Good”


 
    X = 0
    inString = "Good Morning Everybody"
    inStringArr = Split(inString)
    inStringArrLen = UBound(inStringArr)
    ReDim strArr(inStringArrLen)
    For i = 0 To Len(inString)
        aChar = Mid(inString, i + 1, 1)
        If aChar = " " Or i = Len(inString) Then
            strArr(X) = tempStr + " "
            tempStr = Empty
            X = X + 1
        Else
            tempStr = tempStr + aChar
        End If
     
    Next
    ReDim revArr(inStringArrLen)
    i = 0
    For j = UBound(strArr) To 0 Step -1
        revArr(i) = strArr(j)
        i = i + 1
    Next
    MsgBox Join(revArr)

Thursday, May 24, 2012

Find the processes are running in remote desktop

 strComputer = "IPAddres or Computer Name"  
 strDomain = "DomainName" 
 strUser = "UserName"
 strPassword = "Password"
 Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
 Set objSWbemServices = objSWbemLocator.ConnectServer(strComputer,"root\cimv2",strUser,strPassword,,"ntlmdomain:" + strDomain)
 Set colSwbemObjectSet = _
     objSWbemServices.ExecQuery("Select * From Win32_Process")
 For Each objProcess in colSWbemObjectSet
     Wscript.Echo "Process Name: " & objProcess.Name
Next

Create a process in remote desktop


strComputer = "IPAddres or Computer Name"
strCommand = "notepad.exe"

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer 
                                    & "\root\cimv2")
Set objProcess = objWMIService.Get("Win32_Process")

errReturn = objProcess.Create(strCommand, null, null, intProcessID)

If errReturn = 0 Then
  Wscript.Echo "notepad.exe was started with a process ID: " & intProcessID
Else
  Wscript.Echo "notepad.exe could not be started due to error: " & errReturn
End If

Thursday, February 17, 2011

How to write in Excel Sheet


set xlapp = createobject("Excel.Application")
set wb = xlapp.workbooks.open("D:\test.xls")
set sh = xlapp.worksheets(1)
rc = sh.usedrange.rows.count
for j = 2 to rc

     ' write must be bases on condition
     sh.cells(j,2) = "pass"

Next

xlapp.Visible = True
wb.close
xlapp.quit
set xlapp = nothing

Thursday, February 10, 2011

How to use sendkey in QTP script


Definition:
Sends one or more keystrokes to the active window (as if typed on the keyboard).

Syntax:
object.SendKeys(string)

Special character

plus sign       "+",
caret             "^",
percent sign "%",
and tilde       "~"

Send these characters by enclosing them within braces "{}".
For example, to send the plus sign, send the string argument "{+}". Brackets "[ ]" have no special meaning
when used with SendKeys, but you must enclose them within braces to accommodate applications that
do give them a special meaning (for dynamic data exchange (DDE) for example).

To send bracket characters, send the string argument "{[}" for the left bracket and "{]}" for the right one.
To send brace characters, send the string argument "{{}" for the left brace and "{}}" for the right one.
Some keystrokes do not generate characters (such as ENTER and TAB).
Some keystrokes represent actions (such as BACKSPACE and BREAK).
To send these kinds of keystrokes, send the arguments shown in the following table:


Key                                 Argument
BACKSPACE                  {BACKSPACE}, {BS}, or {BKSP}
BREAK                          {BREAK}
CAPS LOCK                  {CAPSLOCK}
DEL or DELETE          {DELETE} or {DEL}
DOWN ARROW          {DOWN}
END                          {END}
ENTER                          {ENTER} or ~
ESC                                  {ESC}
HELP                          {HELP}
HOME                          {HOME}
INS or INSERT          {INSERT} or {INS}
LEFT ARROW          {LEFT}
NUM LOCK                  {NUMLOCK}
PAGE DOWN                  {PGDN}
PAGE UP                  {PGUP}
PRINT SCREEN          {PRTSC}
RIGHT ARROW           {RIGHT}
SCROLL LOCK          {SCROLLLOCK}
TAB                                  {TAB}
UP ARROW                   {UP}
F1 {F1}
F2 {F2}
F3 {F3}
F4 {F4}
F5 {F5}
F6 {F6}
F7 {F7}
F8 {F8}
F9 {F9}
F10 {F10}
F11 {F11}
F12 {F12}
F13 {F13}
F14 {F14}
F15 {F15}
F16 {F16}

Example



Const iNormalFocus = 1
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "mmc.exe",iNormalFocus

Wscript.Sleep 300

objShell.AppActivate "Console1"
Wscript.Sleep 100
objShell.SendKeys "^m"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
Wscript.Sleep 100
objShell.SendKeys "{TAB}"
Wscript.Sleep 100
objShell.SendKeys "{ENTER}"



Wednesday, February 9, 2011

Script to get local drive utilization

'get local drive utilization
dim objFSO,collDrv
dim fs,d

set objFSO=wscript.CreateObject("Scripting.FileSystemObject")
set collDrv=objFSO.Drives

  for each drv in collDrv
        if drv.DriveType=2 then  'check fixed drives only
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set d = fs.GetDrive(fs.GetDriveName(drv))
                 t = FormatNumber(d.TotalSize/(1024*1024), 0)
                 f = FormatNumber(d.FreeSpace/(1024*1024), 0)
                 u = 100-FormatNumber(f/t,2)*100
                 s= s & drv & "  " & drv.VolumeName & " (" & drv.FileSystem & ")" & vbtab & t & " MB 
                      Total"& vbtab & f & " MB Free" & vbtab &  u & "% Utilized" & vblf
       end if
  next

wscript.echo s

set objFSO=Nothing
set collDrv=Nothing
set fs=Nothing
set d=Nothing
wscript.quit

Script to Get Folder Properties

'Get Folder Properties
On Error Resume Next
dim objFSO
dim objFldr

'Specify folder you want information about
strFldr="c:\Neeraj"

set objFSO=CreateObject("Scripting.FileSystemObject")

'get a reference to the folder
set objFldr=objFSO.GetFolder(strFldr)

'list out properties
wscript.Echo "Folder Name:" & vbtab & objFldr.Name
wscript.Echo "Short Folder Name:" & vbtab & objFldr.ShortName
wscript.Echo "Folder Path:" & vbtab & objFldr.Path
wscript.Echo "Date Created:" & vbtab & objFldr.DateCreated
wscript.Echo "Date Last Accessed:" & vbtab & objFldr.DateLastAccessed
wscript.Echo "Date Last Modified:" & vbtab & objFldr.DateLastModified
wscript.Echo "Folder Size (bytes):" & vbtab & objFldr.Size
wscript.Echo "Folder Attributes:"

if objFldr.Attributes AND 0 then wscript.Echo " Normal"
if objFldr.Attributes AND 1 then wscript.Echo " Read-only"
if objFldr.Attributes AND 2 then wscript.Echo " Hidden"
if objFldr.Attributes AND 4 then wscript.Echo " System"
if objFldr.Attributes AND 8 then wscript.Echo " Volume"
if objFldr.Attributes AND 16 then wscript.Echo " Directory"
if objFldr.Attributes AND 32 then wscript.Echo " Archive Bit is set"
if objFldr.Attributes AND 1024 then wscript.Echo " Alias"
if objFldr.Attributes AND 2048 then wscript.Echo " Compressed"

set objFldr=Nothing
set objFSO=Nothing

Scrip to Get File Properties

'Get File Properties
On Error Resume Next
dim objFSO
dim objFile

strFile="c:\file.txt"

set objFSO=CreateObject("Scripting.FileSystemObject")
set objFile=objFSO.GetFile(strFile)

wscript.Echo "File Name:" & vbtab & objFile.Name
wscript.Echo "Short File Name:" & vbtab & objFile.ShortName
wscript.Echo "File Path:" & vbtab & objFile.Path
wscript.Echo "Date Created:" & vbtab & objFile.DateCreated
wscript.Echo "Date Last Accessed:" & vbtab & objFile.DateLastAccessed
wscript.Echo "Date Last Modified:" & vbtab & objFile.DateLastModified
wscript.Echo "File Size:" & vbtab & objFile.Size
wscript.Echo "File Attributes:"

if objFile.Attributes AND 0 then wscript.Echo " Normal"
if objFile.Attributes AND 1 then wscript.Echo " Read-only"
if objFile.Attributes AND 2 then wscript.Echo " Hidden"
if objFile.Attributes AND 4 then wscript.Echo " System"
if objFile.Attributes AND 8 then wscript.Echo " Volume"
if objFile.Attributes AND 16 then wscript.Echo " Directory"
if objFile.Attributes AND 32 then wscript.Echo " Archive Bit is set"
if objFile.Attributes AND 1024 then wscript.Echo " Alias"
if objFile.Attributes AND 2048 then wscript.Echo " Compressed"

set objFile=Nothing
set objFSO=Nothing

Script to get Drive Properties

'Get Drive Properties
On Error Resume Next
dim objFSO
dim objDrv
'drive we want to know about
strDrv="c:\"
set objFSO=CreateObject("Scripting.FileSystemObject")
'get reference to drive
set objDrv=objFSO.GetDrive(strDrv)
'list properties
'if volume name isn't defined then state that
if objDrv.VolumeName="" then
 wscript.Echo "Volume Name:" & vbtab & "NOT DEFINED"
else
 wscript.Echo "Volume Name:" & vbtab & objDrv.VolumeName
end if
wscript.Echo "Serial Number:" & vbtab & objDrv.SerialNumber
Select Case objDrv.DriveType
 Case 0  strType="Unknown"
 Case 1  strType="Removable"
 Case 2  strType="Fixed"
 Case 3  strType="Remote"
 Case 4  strType="CDROM"
 Case 5  strType="RamDisk"
 Case Else strType="Unknown"
end Select
wscript.Echo "Drive Type:" & vbtab  & strType
wscript.Echo "Is Ready:" & vbtab & objDrv.IsReady
wscript.Echo "File System:" & vbtab & objDrv.FileSystem
wscript.Echo "Total Size (bytes):" & vbtab & objDrv.TotalSize
wscript.Echo "Available Space (bytes):" & vbtab & objDrv.AvailableSpace
wscript.Echo "Free Space (bytes):" & vbtab & objDrv.FreeSpace

set objFSO=Nothing
set objDrv=Nothing

Script to Create a folder and delete a folder

'Create FolderOn Error Resume Next
dim objFSO

'new folder to create.  The parent folder must already exists
strFldr="C:\Neeraj"

set objFSO=CreateObject("Scripting.FileSystemObject")
objFSO.CreateFolder(strFldr)

set objFSO=Nothing

'Delete folder
'ANY FILES OR SUBDIRECTORIES WILL ALSO BE DELETED

On Error Resume Next
dim objFSO
'folder to delete
strFldr="C:\Neeraj"

set objFSO=CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder(strFldr)

set objFSO=Nothing

Script to Write a text in a file

'Write to existing text file
On Error Resume Next
dim objFSO
dim objFile

Const ForWriting=2
'specify filename and path for file to open
strFile="c:\file.txt"

set objFSO=CreateObject("Scripting.FileSystemObject")
'if file already exists, value of TRUE forces overwriting file
set objFile=objFSO.OpenTextFile(strFile,ForWriting)
objFile.WriteLine Now & " this is a new line"

objFile.Close

set objFile=Nothing
set objFSO=Nothing