VBScripts

I have to say, I expect much more from VBScript. Or I expect there to be something usable and standard all the way back to Win2000 and maybe NT. Looking at the standard offerings though, it is a common and better than the built-in alternatives.

Here you will find our collection, or maybe just MY collection:

• VBScript Databases
• VBScript Processes

RestorePLCCheck.vbs

AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=ConfigDB.mdb"


' Try to:
' Update MechanismControllers Set Register01=-1 Where MechanismName='CTLR0001'


' Initialize Connection and RecordSet
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")

' Query and display the field before we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "Before:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close

' Change the value
Conn.Execute("Update MechanismControllers Set Register01 = null Where MechanismName = 'CTLR0001'")

' Query and display the field after we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "After:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close


Conn.Close

RemovePLCCheck.vbs

AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=ConfigDB.mdb"

' Try to:
' Update MechanismControllers Set Register01=-1 Where MechanismName='CTLR0001'

' Initialize Connection and RecordSet
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")

' Query and display the field before we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "Before:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close

' Change the value
Conn.Execute("Update MechanismControllers Set Register01 = -1 Where MechanismName = 'CTLR0001'")

' Query and display the field after we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "After:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close


Conn.Close

CreateShortCut.vbs

Set WshShell = CreateObject("Wscript.shell")
strDesktop = WshShell.SpecialFolders("Desktop")
Set oMyShortcut = WshShell.CreateShortcut(strDesktop + "\Sample.lnk")
'oMyShortcut.WindowStyle = 3
OMyShortcut.TargetPath = "%windir%\notepad.exe"
oMyShortCut.Save

DefeatPLCCheck.vbs

AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=ConfigDB.mdb"

' Try to:
' Update MechanismControllers Set Register01=-1 Where MechanismName='CTLR0001'

' Initialize Connection and RecordSet
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")

' Query and display the field before we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "Before:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close

' Change the value
Conn.Execute("Update MechanismControllers Set Register01 = -1 Where MechanismName = 'CTLR0001'")

' Query and display the field after we modify
Set Rs = Conn.Execute("Select * from MechanismControllers Where MechanismName='CTLR0001'")
WScript.Echo "After:  MechanismName=" & Rs("MechanismName") & "  Register01=" & Rs("Register01")
Rs.Close

Conn.Close

rbas_old.vbs

Set WshShell = WScript.CreateObject("WScript.Shell")
Set colProcessList = GetObject("Winmgmts:").ExecQuery("Select * from Win32_Process")

For Each objProcess in colProcessList
  If objProcess.name = "rbas.exe" then
    vFound = True
  End if
Next

If vFound = True then
  MsgBox "RBAS is already running!!!",vbExclamation,"What are you doing?"
Else
  WshShell.Run("C:\Temp\rbas.exe")
End If  

sendkeys.vbs

set oShell = WScript.CreateObject("WScript.Shell")
REM oShell.Run "calc"
rem WScript.Sleep 100

oShell.AppActivate "*culator"
oShell.SendKeys "(% )R"
rem oShell.SendKeys "(% )X"

launch_scw.vbs

'
' Author: Scott Serr
' Date: 3/9/2010
'
' Purpose:
'   To not allow a second instance of a program (SCW.exe) to start if a 
'   first instance is already running.
' General Operation:
'   Instead of excuting the executable (SCW.exe) directly, execute this
'   .vbs.  This vbscript will check if the executable is running.
'   If it is already running:
'        - it will not execute a new instance of the .exe
'        - it will maximize/restore the SCW that is already running
'        - it will popup a message box explaining that RBAS is already running
'   If it is NOT running:
'        - it will execute SCW.EXE
'
' Original execution method:
'   A shortcut launches the .exe.
' New execution method:
'   A shortcut launches this .vbs which then launches the .exe.
'
'

Set oAutoIt = WScript.CreateObject("AutoItX3.Control")
oldval = oAutoIt.Opt("WinTitleMatchMode", 2)

Set WshShell = WScript.CreateObject("WScript.Shell")
Set colProcessList = GetObject("Winmgmts:").ExecQuery("Select * from Win32_Process")

For Each objProcess in colProcessList

  If UCase(objProcess.Name) = "SCW.EXE" then
    oAutoIt.WinSetState "Special Case Waste Packet Assay Monitor", "", oAutoIt.SW_SHOW
    oAutoIt.WinClose "Attention!  SCW is already running.", ""
    WScript.sleep 400
    MsgBox "Only one instance of SCW is allowed to run at one time.  SCW has been maximized for your convenience.", _
	vbExclamation, "Attention!  SCW is already running."
    WScript.Quit
  End if

Next

WshShell.Run("SCW.EXE")

SetArchiveonSequence.vbs

' Try to:
' Update CountInfo Set ArchivedFlag=-1 Where ItemId=?


' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=ItemInfoDB.mdb"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")


Set ArgObj = WScript.Arguments 


If (Wscript.Arguments.Count < 2) Then  
  Wscript.Echo "Required Parameter missing, entering GUI mode"
  seq = InputBox("Enter drum sequence number (8 digits)") 

  ' Query and display the field before we modify
  Set Rs = Conn.Execute("Select * from CountInfo Where MasterCountDBFile LIKE '%" & seq & "_CNTR0001.mdb'")

  result = MsgBox ("ItemId:  " & seq & "   ArchivedFlag Now:  " & Rs("ArchivedFlag") & Chr(13) & Chr(13) & _
			"Click OK to toggle/flip value" & Chr(13) & _
			"Click Cancel to abort", 1, _
			"Toggle Archive Flag on " & Rs("ItemId"))

  If result = 2 Then 
    Wscript.Quit  
  End If

  archivedflag = Rs("ArchivedFlag")
  If archivedflag = 0 Then
    archivedflag = -1
  Else
    archivedflag = 0
  End If

  Rs.Close
Else
  'First parameter
  seq = ArgObj(0) 
  'Second parameter
  archivedflag = ArgObj(1) 
End If

If Len(seq) <> 8 Then
  WScript.Echo "Drum sequence number is not 8 digits, aborting..."
End If

' Change the value
Conn.Execute("Update CountInfo Set ArchivedFlag = " & archivedflag & " Where MasterCountDBFile LIKE '%" & seq & "_CNTR0001.mdb'")

If (Wscript.Arguments.Count < 2) Then  
  ' Query and display the field after we modify
  Set Rs = Conn.Execute("Select * from CountInfo Where MasterCountDBFile LIKE '%" & seq & "_CNTR0001.mdb'")
  WScript.Echo "Sequence#: " & seq & "   ArchivedFlag After: " & Rs("ArchivedFlag")
  Rs.Close
End If

Conn.Close

dumper.vbs

Const adSchemaTables = 20
Const adSchemaColumns = 4

Set filesys = CreateObject("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")

Set thisfolder = filesys.GetFolder(".") 
Set fs = thisfolder.Files 
For Each f in fs
  If Ucase(Right(f,4)) = ".MDB" Then
    mdb = f
    txt = thisfolder & "\" & filesys.getBaseName(f) & ".txt"
    Wscript.Echo "mdb: " & mdb
    Wscript.Echo "txt: " & txt
    DumpMdbToTxt mdb, txt
  End If    
Next 

Function DumpMdbToTxt(mdb,txt)
  Set txtfile = filesys.CreateTextFile(txt, True)
  ' Initialize Connection and RecordSet
  AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & mdb
  conn.Open AccessConnect

  Set table_rs = conn.OpenSchema(adSchemaTables)
  Do Until table_rs.EOF
    strTableName = table_rs("Table_Name")
    If Left(strTableName,4) <> "MSys" Then 
      Set column_rs = conn.OpenSchema(adSchemaColumns, _
          Array(Null, Null, strTableName))

      txtfile.Write "TABLE: " & strTableName & "    ("
      Do While Not column_rs.EOF
        txtfile.Write column_rs("Column_Name") & ","
        column_rs.MoveNext
      Loop
      txtfile.WriteLine ")"

      Set row_rs = conn.Execute("Select * from " & strTableName )
      Do While Not row_rs.eof
        txtfile.Write "  "
        column_rs.MoveFirst
        Do While Not column_rs.EOF
          str = column_rs("Column_Name")
          txtfile.Write row_rs(str) & Chr(9)
          column_rs.MoveNext
        Loop
        row_rs.MoveNext
        txtfile.WriteLine
      Loop
    End If
    table_rs.MoveNext
  Loop

  txtfile.Close
  Set txtfile = nothing
  Set table_rs = nothing
  Set row_rs = nothing
  Set column_rs = nothing
  conn.Close
End Function

SetArchivedFromList.vbs

' After review, you can pump the file that is output from this script
' into the "force archive" script
'   cscript SetArchivedFromList.vbs //B < badunarchived.log
'
' Author: Scott Serr
'

ItemInfoDB_Location="C:\Temp\Test\ItemInfoDB.mdb"


' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & ItemInfoDB_Location
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect

Set StdOut = WScript.StdOut
Set StdIn  = WScript.StdIn

Do Until StdIn.AtEndOfStream
  seq = StdIn.ReadLine
  StdOut.Write "Updating " & seq & " ..."
  Conn.Execute("Update CountInfo Set ArchivedFlag = -1 Where MasterCountDBFile LIKE '%" & seq & "_CNTR0001.mdb'")
  StdOut.WriteLine " OK"
Loop

Conn.Close

OrphanFileList.vbs

' Run this at the command line like this:
'   cscript OrphanFileList.vbs //B > orphan.log
' You may then edit the badunarchived.log file.  
'
' Note: //B above is required to suppress interpreter banner output
'
' Author: Scott Serr
'


ItemInfoDB_Location="C:\Temp\Test\ItemInfoDB.mdb"
AssayData_Directory="C:\Temp\Test\AssayData"


Dim StdOut, StdIn

Set StdOut = WScript.StdOut
Set StdIn  = WScript.StdIn



' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & ItemInfoDB_Location
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")
Set filesys = CreateObject("Scripting.FileSystemObject") 


Set thisfolder = filesys.GetFolder(AssayData_Directory) 
Set fs = thisfolder.Files 
For Each f in fs
  If UCase(Right(f,3)) = "MDB" Then
    seq=Left(filesys.getBaseName(f),8)
    Set rs = Conn.Execute("Select MasterCountDBFile from CountInfo " & _
             "Where MasterCountDBFile LIKE '%\" & seq & "_%'")
    If rs.Eof Then
      StdOut.WriteLine f
    End If
    rs.Close
  End If
Next 

Conn.Close

HowMany?.vbs

ItemInfoDB_Location="C:\Temp\Test\ItemInfoDB.mdb"

Dim StdOut, StdIn

Set StdOut = WScript.StdOut
Set StdIn  = WScript.StdIn



' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & ItemInfoDB_Location
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")

Set rs = Conn.Execute("Select Count(*) from CountInfo " & _
             "Where ArchivedFlag=0")

StdOut.WriteLine rs(0)

rs.Close
Conn.Close

MASandDB-properties.vbs

Const adSchemaTables = 20
Const adSchemaColumns = 4

Set StdOut = WScript.StdOut
Set StdIn  = WScript.StdIn
Set filesys = CreateObject("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")
Set objShell = WScript.CreateObject("WScript.Shell")

ItemInfoDB_Location="C:\Temp\Test\ItemInfoDB.mdb"
AssayData_Directory="C:\Temp\Test\AssayData"
table="CountInfo"
seq=WScript.Arguments(0)
parsstr="SURSTRING1,SURSTRING5,SURSTRING6,SURSTRING7,SURINT1,SURINT2," & _
     "SURINT3,SURINT4,SURINT5,SURINT6,SURINT7,SURFLAG0,SIDENT," & _
     "SDESC1,SDESC2,SLOCTN,SDESC3,SWCONTSHAPE,NSPRTITLE," & _
     "SWCONTMATRIX,SWCONTGW,SWCONTNW,SCWT,SWCONTFULL,SHZFEFRAC," & _
     "SHZPBFRAC,SSURVENT,SCTRDESC,ISOCSFILE,SGEOMTRY,WACQCOLPOS," & _
     "WACQNSEG,WACQSKIPSEG,WACQOFFSET,WACQDELTA,WACQPASSMODE,SASID," & _
     "WACTRANSRC,WACQSEGMENT,ACQOPNAME,SANALNAME,SGRPDESC"

pars = Split(parsstr, ",")

StdOut.WriteLine seq

' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & ItemInfoDB_Location
conn.Open AccessConnect

Set column_rs = conn.OpenSchema(adSchemaColumns, _
          Array(Null, Null, table))

Set row_rs = conn.Execute("Select * from " & table & " Where MasterCountlistFile LIKE '%\" & seq & "%'" )

Do While Not row_rs.Eof
  
  column_rs.MoveFirst
  Do While Not column_rs.EOF
    str = column_rs("Column_Name")
    StdOut.WriteLine "Field: " & str & "   Value: " & row_rs(str)
    column_rs.MoveNext
  Loop

  countfile = AssayData_Directory & "\" & filesys.getBaseName(row_rs("MasterCountlistFile")) & ".mas"
  StdOut.WriteLine "Handle---> " & countfile

  For i = LBound(pars) to UBound(pars)
    pname = pars(i)
    StdOut.Write pname & "   "
    Set objExecObject = objShell.Exec("cmd /c getpars.exe " & countfile & " /" & pname)
    Do While Not objExecObject.StdOut.AtEndOfStream
     strText = objExecObject.StdOut.ReadLine()
     StdOut.Write strText    
    Loop
    StdOut.WriteLine

  Next

  row_rs.MoveNext
Loop

column_rs.Close
row_rs.Close
conn.Close

ChangeLastSequenceNumber.vbs

' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=ConfigDB.mdb"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")

' Query and display the field before we modify
Set Rs = Conn.Execute("Select * from Counters")
If Rs.Eof Then
  WScript.Echo "Can't get db record, aborting."
  WScript.Quit
End If
ns=Rs("NextCountSequenceNumber")
Rs.Close

seq = InputBox("NextCountSequenceNumber is: " & ns & Chr(13) & _
	"Enter a new value.")

If seq <> "" Then
  Conn.Execute("Update Counters Set NextCountSequenceNumber=" & seq)

  Set Rs = Conn.Execute("Select * from Counters")
  ns=Rs("NextCountSequenceNumber")
  Rs.Close
  WScript.Echo "Your new NextCountSequenceNumber is: " & ns
End If

Conn.Close

UnarchivedList.vbs

' Run this at the command line like this:
'   cscript UnarchivedList.vbs //B > badunarchived.log
' You may then edit the badunarchived.log file.  
'
' Note: //B above is required to suppress interpreter banner output
'
' After review, you can pump the file that is output from this script
' into the "force archive" script
'   cscript SetArchivedFromList //B < badunarchived.log
'
' Author: Scott Serr
'

ItemInfoDB_Location="C:\Temp\Test\ItemInfoDB.mdb"
AssayData_Directory="C:\Temp\Test\AssayData"

Dim StdOut, StdIn

Set StdOut = WScript.StdOut
Set StdIn  = WScript.StdIn

' Initialize Connection and RecordSet
AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
                     "Dbq=" & ItemInfoDB_Location
Set Conn = CreateObject("ADODB.Connection")
Conn.Open AccessConnect
Set Rs = CreateObject("ADODB.Recordset")
Set filesys = CreateObject("Scripting.FileSystemObject") 

' Query and display the field after we modify
Set rs = Conn.Execute("Select MasterCountDBFile from CountInfo Where ArchivedFlag=0")

while not rs.eof
  mc = rs("MasterCountDBFile")

  Set thisfolder = filesys.GetFolder(AssayData_Directory) 
  Set fs = thisfolder.Files 

  For Each f in fs
    If Left(filesys.getBaseName(f),8) = Left(filesys.getBaseName(mc),8) Then
      found = True
      Exit For   
    End If
    found = False
  Next 

  If Not found Then
    StdOut.WriteLine Left(filesys.getBaseName(mc),8)
  End If

  rs.movenext
wend

rs.Close
Conn.Close

Misc usage of TASKLIST

C:\Documents and Settings\serrsm>tasklist /nh /fi "IMAGENAME eq Notepad.exe"
notepad.exe                 2980 Console                 0      2,816 K

C:\Documents and Settings\serrsm>START "do something window" dir
C:\Documents and Settings\serrsm>FOR /F "tokens=2" %I in ('TASKLIST /NH /FI "WIN
DOWTITLE eq do something window"' ) DO SET PID=%I
C:\Documents and Settings\serrsm>SET PID=2460
C:\Documents and Settings\serrsm>ECHO %PID%

You drop a Genie2k .CNF file on this VBS script and it shows you info in a notepad window.

' Initialization
Const camFile=5
Const camReadWrite=512
Const outfile="C:\Temp\outfile.txt"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set StdIn = WScript.StdIn
Set StdOut = WScript.StdOut


' Bailout if they didn't drop a file on this script
If Wscript.Arguments.Count = 0 Then
    WScript.Echo "Drag a CNF file on me."
    WScript.Quit
End If

filename=WScript.Arguments(0)

' Debug
'WScript.Echo filename

Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile(outfile, True)


Dim objDS
Set objDS = CreateObject("Canberra.CamDatasource")
objDS.Open filename,camReadWrite,camFile


tf.WriteLine("Date:    " & objDS.Parameter(CAM_X_ASTIME))
tf.WriteLine()

tf.WriteLine("Totals:    " & _
	objDS.Parameter(CAM_F_NACQMEANBCT) & "   " & objDS.Parameter(CAM_F_NACQMEANBCTE) )
tf.WriteLine("Reals:    " & _
	objDS.Parameter(CAM_F_NACQMEANBCR) & "   " & objDS.Parameter(CAM_F_NACQMEANBCRE) )
tf.WriteLine()

tf.WriteLine("Singles:    " & _
	objDS.Parameter(CAM_F_NACQAVGCSGL) & "   " & objDS.Parameter(CAM_F_NACQAVGCSER) )
tf.WriteLine("Doubles:    " & _
	objDS.Parameter(CAM_F_NACQAVGCDBL) & "   " & objDS.Parameter(CAM_F_NACQAVGCDER) )
tf.WriteLine("Triples:    " & _
	objDS.Parameter(CAM_F_NACQAVGCTPL) & "   " & objDS.Parameter(CAM_F_NACQAVGCTER) )
tf.WriteLine()

tf.WriteLine("Truncated Singles:    " & _
	objDS.Parameter(CAM_F_NACQAVGTRNS) & "   " & objDS.Parameter(CAM_F_NACQAVGTRNSE) )
tf.WriteLine("Truncated Doubles:    " & _
	objDS.Parameter(CAM_F_NACQAVGTRND) & "   " & objDS.Parameter(CAM_F_NACQAVGTRNDE) )
tf.WriteLine("Truncated Triples:    " & _
	objDS.Parameter(CAM_F_NACQAVGTRNT) & "   " & objDS.Parameter(CAM_F_NACQAVGTRNTE) )
tf.WriteLine()

tf.WriteLine("Ones:    " & _
	objDS.Parameter(CAM_F_NACQAVGCONE) & "   " & objDS.Parameter(CAM_F_NACQAVGCOER) )


tf.Close
WshShell.Run("notepad " & outfile)
WScript.Quit