'-----------------------------------------------------------------------------
'- Threads.vbs - Display DB2 Thread Information
'-----------------------------------------------------------------------------
'- Arguments .....: DBName - Database Name
'-                  DBUser - Authorized User ID
'-                  DBPsw  - Users Password
'- Calls .........: notepad to display data
'-----------------------------------------------------------------------------
'- Requires ......: - Windows Scripting Shell 5.6 or higher
'-                  - IBM DB2 ADO Support 2.8 or higher
'-                  - IBM DB2 Run Time Client V8.2 or higher
'-                  - IBM DB2 Database Server V8.2 FixPak 9 or higher
'- Changes .......: First release 27.07.2005/GR
'- 29.07.2005/GR  : - V1.1. writes output to notepad, registers link on desktop
'-----------------------------------------------------------------------------

Option Explicit  
'On Error Resume Next

'--- Constants ---------------------------------------------------------------
Const conScriptVersion = "1.1"

'--- Variables ---------------------------------------------------------------
Dim objShell'Object Shell
Dim objExec'Object Exec external program
Dim objRun'Object Run external program
Dim objArgs'Object Arguments
Dim strWSHVersion'WSH Version
Dim strScriptName'Script Name
Dim strScriptFullName'Full Script Name
Dim strCurrDir'Current Directory

Dim strDBName'Database
Dim strDBUser'User
Dim strDBPsw'Password

Dim objCon 'connection-Objekt
Dim strSQLStmt'SQL Statement
Dim arrData'Output Data
Dim datTimestamp'current date/time

Dim intWork
Dim strWork

'--- Retrieve Script Information ---------------------------------------------
Set objShell = WScript.CreateObject("Wscript.Shell")
strWSHVersion = Wscript.Version
strScriptName = Wscript.ScriptName
strScriptFullName =WScript.ScriptFullname
strCurrDir= objShell.CurrentDirectory

'Wscript.Echo strWSHVersion, strScriptName, strScriptFullName, strCurrDir

if strWSHVersion <> "5.6" then
MsgBox "This script requires WSH Version 5. or higher!" , _
16, _
"Display DB2 Threads - " & strScriptFullName
Wscript.Quit
end if

'--- Set Link on Desktop  ----------------------------------------------------
SetLink

'--- Check Arguments ---------------------------------------------------------
Set objArgs = WScript.Arguments
If objArgs.Count < 2 then
intWork = MsgBox("No or invalid arguments passed!" & Chr(10) & Chr(10) & _
"Usage: (on command prompt) <" & strScriptName & " dbname userid password>" & _
chr(10) & chr(10) & _
"Do you want to specify parameter right now?", _
33, _
"Display DB2 Threads - " & strScriptFullName)
if intWork = 1 then 'OK Button pressed
strDBName = InputBox("Enter Database name (e.g. DB5STAR):")
strDBUser = InputBox("Enter User name for Database " & strDBName & " (e.g. dwhadmin):")
strDBPsw = InputBox("Enter User's " & strDBUser & " Password:")
if strDBName = "" or strDBUser = "" or strDBPsw = "" then
MsgBox "No or invalid arguments passed - script abends now!" & _
Chr(10) & Chr(10) & _
"Usage: <" & strScriptName & " dbname userid password>" , _
16, _
"Display DB2 Threads - " & strScriptFullName
Wscript.Quit
end if
else'CANCEL button pressed
Wscript.Quit
end if
else
'Assign positional arguments
strDBName=objArgs(0)
strDBUser=objArgs(1)
strDBPsw=objArgs(2)
end if

strDBName = UCase(strDBName)

'--- build SQL statements ----------------------------------------------------
'SELECT *
'--FROM TABLE(ENV_GET_SYS_INFO()) as T
'--FROM TABLE(ENV_GET_INST_INFO()) as T
'--FROM TABLE(ENV_GET_PROD_INFO()) as T
'--FROM TABLE (SNAPSHOT_TBS_CFG ( '' , - 1)) AS T
'--FROM TABLE(snapshot_agent('',-1)) as T
'--FROM TABLE(snapshot_appl('',-1)) as T
'FROM TABLE(snapshot_appl_info('',-1)) as T
'strSQLStmt = "SELECT * FROM TABLE(snapshot_appl_info('',-1)) as T"

'--- Connect to Database -----------------------------------------------------
objShell.Popup "This may take some seconds ...", 3, "Please Wait!", 0 + 64
DB2Connect()'Connect to database

'--- Open NOTEPAD to write collected information on --------------------------
'set objExec = objShell.Exec("notepad.exe")
objShell.Run "%windir%\notepad",1
WScript.Sleep 100
objShell.AppActivate "Editor"
WScript.Sleep 100

'--- Provide DB2 Server Information ------------------------------------------
DB2InfoBlock(1)

'--- Write collected Information to NOTEPAD ----------------------------------
arrData= DB2Select("SELECT * FROM TABLE(snapshot_appl_info('',-1)) as T")

datTimestamp = now
objShell.Sendkeys "{Enter}"
objShell.Sendkeys "Database Threads attached to " & strDBName & ": {Enter}"
objShell.Sendkeys "====================================== {Enter}{Enter}"

'--- Write data and Disconnect from Database ---------------------------------
ProcessRS arrData'process data
objShell.Sendkeys "Generated at "& datTimestamp & " by " & strScriptName & _
" Version " & conScriptVersion & "{Enter}"
objShell.Sendkeys "*** end of file ***"

'--- Disconnect from Database ------------------------------------------------
DB2Disconnect

objShell.Popup strScriptName & " ended normally, please see Output in NOTEPAD application!", 3, strScriptName, 0 + 64

'#############################################################################
'# DB2Select: Access DB2 object using SQL SELECT statement
'#############################################################################
Function DB2Select(strSel)
   Dim arrD()
   Dim rsData'Recordset with data
   Dim strTemp
   Dim objFeld
   Dim lngI
   Dim lngZ
   set rsData=WScript.CreateObject("ADODB.Recordset")
   rsData.Open strSel, objCon  

   Redim arrD (rsData.RecordCount, rsData.Fields.Count-1)
'get column names
If rsData.recordcount>0 Then
rsData.MoveFirst
   for lngI=0 to rsData.fields.count-1
arrD(0,lngI)= rsData.fields(lngI).name
 next
End If
'get column data
lngZ=1
Do While rsData.eof=false
   for lngI=0 to rsData.fields.count-1
arrD(lngZ,lngI)= rsData.fields(lngI).value
 next  
lngZ=lngZ+1
rsData.MoveNext
Loop
   rsData.Close
set rsData=nothing
DB2Select=arrD
End Function

'#############################################################################
'# ProcessRS: Process Result Set
'#############################################################################
Sub ProcessRS(arrD)
   Dim lngZeile
   Dim strAusgabe
   Dim lngSpalte

'Row 1 contains column names
For lngZeile=lbound(arrD,1)+1 to ubound(arrD,1)
objShell.Sendkeys "Thread #" & lngZeile & ":{Enter}"
for lngSpalte=lbound(arrD,2) to ubound(arrD,2)
objShell.Sendkeys left(arrD(0,lngspalte)&"..........................",26) _
& ": " & arrD(lngZeile,lngspalte) & "{Enter}"
'strAusgabe=strAusgabe & arrD(lngZeile,lngspalte) & vbTab
next
'objShell.Sendkeys strAusgabe
'WScript.Sleep 100
objShell.Sendkeys "{Enter}"
'WScript.Sleep 100
WScript.Sleep 300'strAusgabe=strAusgabe & vbcrlf
Next
'If strAusgabe="" Then
'strAusgabe="No data prcessed!"
'End If
'MsgBox strAusgabe
End Sub

'#############################################################################
'# DB2Select: Zugriff auf Objekt
'#############################################################################
Sub DB2Connect()
   Dim strCon
   Dim strVersion
On Error Resume Next
      strCon="Provider=IBMDADB2;DSN=" & strDBName & _
      ";User Id=" & strDBUser & _
";Password=" & strDBPsw
      'Wscript.Echo strCon
      set objCon=WScript.CreateObject("ADODB.Connection")
      strVersion=objCon.Version
'Wscript.Echo "ADO Version " & strVersion
objCon.ConnectionString=strCon
      objCon.CursorLocation=3
      objCon.Open
      If Err.Number <>0 Then
          MsgBox "Connection to Database " & strDBName & _
   " using User " & strDBUser & " not possible" , vbInformation
   Wscript.Quit
      End If
      set objFSO=nothing
End Sub

'#############################################################################
'# DB2Select: Disconnect from DB2 Database
'#############################################################################
Sub DB2Disconnect()
      On Error Resume Next
      objCon.Close
      set objCon=nothing
End Sub

'#############################################################################
'# SetLink: Sets link to this script on Desktop
'#############################################################################
Sub SetLink()
   Dim strDesktop
   Dim oShellLink
  
strDesktop = objShell.SpecialFolders("Desktop")
        set oShellLink = objShell.CreateShortcut(strDesktop & "\Display DB2 Threads.lnk")
        oShellLink.TargetPath = left(strScriptFullName,len(strScriptFullName)-3) & "wsh"
        oShellLink.WindowStyle = 1
        oShellLink.Hotkey = "CTRL+SHIFT+T"
        oShellLink.IconLocation = "wscript.exe, 0"
        oShellLink.Description = "threads.vbs - Display DB2 Threads"
        oShellLink.WorkingDirectory = strDesktop
        oShellLink.Save

End Sub

'#############################################################################
'# DB2InfoBlock: Provide Information about DB2 Server
'#############################################################################
Function DB2InfoBlock(intType)'0=echo 1=send
  
   arrData= DB2Select("SELECT * FROM TABLE(ENV_GET_SYS_INFO()) as T")
   If intType = 1 then
objShell.Sendkeys "---------------------------------------------------------------{Enter}"
objShell.Sendkeys "-- Server..: " & left(arrData(1,3),8) & " " & _
arrData(1,0) & " Ver. " & arrData(1,2) & _
", " & trim(arrData(1,4)) & " CPU's, " & _
trim(arrData(1,6)) & " MB Memory {Enter}"
end if

   arrData= DB2Select("SELECT * FROM TABLE(ENV_GET_INST_INFO()) as T")
   If intType = 1 then
objShell.Sendkeys "-- Instance: " & left(arrData(1,0),8) & " " & _
arrData(1,5) & " FixPak " & arrData(1,8) & "{Enter}"
objShell.Sendkeys "---------------------------------------------------------------{Enter}"
end if

End Function